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
|
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 :: Texture)
(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)))
= 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)) -> ((texture2D (Sampler PointFilter MirroredRepeat cubemap) d%xy )))
& 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))
textureCubeSlot s = Texture2DSlot s
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")))
|
