1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
coordmap (cam::Mat 4 4 Float) (p::Vec 4 Float)
= cam *. p
blendplane = -- NoBlending -- BlendLogicOp Xor
Blend (FuncAdd,FuncAdd)
((OneBF,SrcAlpha),(DstAlpha,DstAlpha))
(V4 0 0 0 0)
point :: Vec 3 Float -> Vec 4 Float
point p = V4 p%x p%y p%z 1
makeFrame (cubemap :: TextureCube)
(skybox :: PrimitiveStream Triangle ((Vec 3 Float)))
(cameraPosition :: Vec 3 Float)
(cam :: Mat 4 4 Float)
(color :: Vec 4 Float)
(texture :: Texture)
(prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
(plane :: PrimitiveStream Triangle ((Vec 4 Float)))
(pointsMax :: Int)
(pointsStart :: Int)
= imageFrame (emptyDepthImage 1, emptyColorImage (V4 0 0 0.4 1))
`overlay`
skybox
& mapPrimitives (\((p)) -> let texcoord = V3 p%x (p%y) (p%z)
p' = cam *. point (p + cameraPosition)
in (p', texcoord))
& rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth))
& mapFragments (\((d)) -> (( textureCube cubemap d )))
& accumulateWith (DepthOp Always False, ColorOp NoBlending (V4 True True True True))
`overlay`
prims
& mapPrimitives (\(p,n,uvw) -> ( coordmap cam p, V2 uvw%x (1 - uvw%y) ))
& rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) ((Smooth))
& mapFragments (\((uv)) -> ((color * texture2D (Sampler PointFilter MirroredRepeat texture) uv )))
& accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
`overlay`
plane
& mapPrimitives (\((p)) -> let p' = coordmap cam p in (p', p%xz))
& rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth))
& mapFragments (\((uv)) -> let c = mixB zero one (fract uv >= (one *! (0.95::Float)))
r = V4 1 1 1 0 *! (max c%x c%y)
in ((r + V4 0 0 0 (0.8))))
& accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True))
`overlay`
zipCount (fetch "Points" ((Attribute "position")) :: PrimitiveStream Point ((Float)))
& mapPrimitives (\(n,_) -> {- let nn = 0.2 * fromInt n :: Float
p = V4 nn nn nn 1
p' = coordmap cam p
in (p', V4 1 1 0 1 :: Vec 4 Float)) -}
let i = mod (n + pointsStart) pointsMax
t = TextureBufferSlot "PointBuffer"
p = V4 (textureBuffer t i)
(textureBuffer t (i+1))
(textureBuffer t (i+2))
1
p' = coordmap cam p
in (p', V4 1 1 0 1 :: Vec 4 Float))
& renderPoints cam
renderPoints ::
Mat 4 4 Float
-> PrimitiveStream Point (Vec 4 Float, Vec 4 Float)
-> ( (FragmentOperation Depth, FragmentOperation (Color (VecScalar 4 Float)))
, FragmentStream 1 ((Vec 4 Float)) )
renderPoints cam points =
points
& rasterizePrimitives (PointCtx (PointSize 10.0) 1.0 LowerLeft) ((Flat))
& mapFragments (\((c)) -> ((c)))
& accumulateWith (DepthOp Always False, ColorOp NoBlending (V4 True True True True))
textureCubeSlot s = TextureCubeSlot s
main :: Output
main = renderFrame $
makeFrame (textureCubeSlot "CubeMap")
(fetch "SkyCube" ((Attribute "position")))
(Uniform "CameraPosition")
(Uniform "ViewProjection")
(Uniform "diffuseColor")
(Texture2DSlot "diffuseTexture")
(fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw"))
(fetch "plane" ((Attribute "position")))
(Uniform "PointsMax")
(Uniform "PointsStart")
|
