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
|
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)))
(points :: PrimitiveStream Line (Vec 3 Float, Vec 3 Float))
(plane_mat :: Mat 4 4 Float)
= 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 $ plane_mat *. 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`
points
& mapPrimitives (\(p,c) -> let p' = coordmap cam $ point p
w = p'%w
yellowish = normalize c `dot` V3 1 1 0
p2 = if yellowish >= 0.9*sqrt 2
then V4 p'%x p'%y 0.1 w
else V4 p'%x p'%y 0.11 w
in (p2, point c))
& renderPoints cam
renderPoints ::
Mat 4 4 Float
-> PrimitiveStream Line (Vec 4 Float, Vec 4 Float)
-> ( (FragmentOperation Depth, FragmentOperation (Color (VecScalar 4 Float)))
, FragmentStream 1 ((Vec 4 Float)) )
renderPoints cam points =
points
& rasterizePrimitives (LineCtx 1.0 LastVertex) ((Flat))
& mapFragments (\((c)) -> ((c)))
& accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
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")))
(fetch "Points" (Attribute "position", Attribute "color"))
(Uniform "PlaneModel")
|
