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
|
cubeNormals :: [Vec 3 Float]
cubeNormals =
[ V3 0.0 1.0 0.0, V3 0.0 1.0 0.0, V3 0.0 1.0 0.0
, V3 0.0 1.0 0.0, V3 0.0 1.0 0.0, V3 0.0 1.0 0.0
, V3 0.0 (-1.0) 0.0, V3 0.0 (-1.0) 0.0, V3 0.0 (-1.0) 0.0
, V3 0.0 (-1.0) 0.0, V3 0.0 (-1.0) 0.0, V3 0.0 (-1.0) 0.0
, V3 0.0 (-0.0) 1.0, V3 0.0 (-0.0) 1.0, V3 0.0 (-0.0) 1.0
, V3 (-0.0) 0.0 1.0, V3 (-0.0) 0.0 1.0, V3 (-0.0) 0.0 1.0
, V3 (-0.0) (-0.0) (-1.0), V3 (-0.0) (-0.0) (-1.0), V3 (-0.0) (-0.0) (-1.0)
, V3 0.0 0.0 (-1.0), V3 0.0 0.0 (-1.0), V3 0.0 0.0 (-1.0)
, V3 (-1.0) 0.0 0.0, V3 (-1.0) 0.0 0.0, V3 (-1.0) 0.0 0.0
, V3 (-1.0) 0.0 0.0, V3 (-1.0) 0.0 0.0, V3 (-1.0) 0.0 0.0
, V3 1.0 0.0 0.0, V3 1.0 0.0 0.0, V3 1.0 0.0 0.0
, V3 1.0 0.0 0.0, V3 1.0 0.0 0.0, V3 1.0 0.0 0.0
]
cubeVertices :: [Vec 3 Float]
cubeVertices =
[ V3 1.0 1.0 1.0, V3 (-1.0) 1.0 1.0, V3 (-1.0) 1.0 (-1.0)
, V3 (-1.0) 1.0 (-1.0), V3 1.0 1.0 (-1.0), V3 1.0 1.0 1.0
, V3 1.0 (-1.0) (-1.0), V3 (-1.0) (-1.0) (-1.0), V3 (-1.0) (-1.0) 1.0
, V3 (-1.0) (-1.0) 1.0, V3 1.0 (-1.0) 1.0, V3 1.0 (-1.0) (-1.0)
, V3 1.0 (-1.0) 1.0, V3 (-1.0) (-1.0) 1.0, V3 (-1.0) 1.0 1.0
, V3 (-1.0) 1.0 1.0, V3 1.0 1.0 1.0, V3 1.0 (-1.0) 1.0
, V3 1.0 1.0 (-1.0), V3 (-1.0) 1.0 (-1.0), V3 (-1.0) (-1.0) (-1.0)
, V3 (-1.0) (-1.0) (-1.0), V3 1.0 (-1.0) (-1.0), V3 1.0 1.0 (-1.0)
, V3 (-1.0) (-1.0) 1.0, V3 (-1.0) (-1.0) (-1.0), V3 (-1.0) 1.0 (-1.0)
, V3 (-1.0) 1.0 (-1.0), V3 (-1.0) 1.0 1.0, V3 (-1.0) (-1.0) 1.0
, V3 1.0 (-1.0) (-1.0), V3 1.0 (-1.0) 1.0, V3 1.0 1.0 1.0
, V3 1.0 1.0 1.0, V3 1.0 1.0 (-1.0), V3 1.0 (-1.0) (-1.0)
]
cubeVertexStream = fetchArrays Triangle (cubeVertices,cubeNormals)
clear = FrameBuffer $ (DepthImage @1 1000, ColorImage @1 red) -- ...
triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
colorFragmentCtx = accumulationContext (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
rasterizeWith = rasterizePrimitives
triangles = triangleRasterCtx
mapFragments2 s fs = accumulate colorFragmentCtx ( \a -> fs a) s clear
transform s f = mapPrimitives (\(p,n) -> let v = v3FToV4F p in (f v, v)) s
rotate' v = (Uniform "MVP" :: Mat 4 4 Float) `PrimMulMatVec` v
main = cubeVertexStream -- cube vertices
`transform` (scale 0.5 . rotate') -- scale them
& rasterizeWith triangles Smooth -- rasterize
`mapFragments2` id
& ScreenOut -- draw into screen
|
