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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
module Vivant.Terrain (Terrain (..), initTerrain) where
import qualified Data.Vector.Storable as V
import Foreign.Marshal.Alloc (free, malloc)
import Foreign.Ptr
import Foreign.Storable (poke)
import qualified Graphics.Rendering.OpenGL as GL
import Linear
import SDL (($=))
import Vivant.Common (uncurry3, vectorSize)
import Vivant.Renderer
data Terrain = Terrain
{ terrainWidth :: Int,
terrainHeight :: Int,
terrainGeometry :: [[Float]],
terrainRenderer :: Renderer
}
deriving (Show)
normal :: Num c => (c, c, c) -> (c, c, c) -> (c, c, c) -> (c, c, c)
normal a b c =
transform $ cross (uncurry3 V3 b ^-^ uncurry3 V3 a) (uncurry3 V3 c ^-^ uncurry3 V3 a)
where
transform (V3 a b c) = (a, b, c)
partition ::
(V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1
partition r =
V.fromList . concat . concat
. fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0 ..])
$ zip (zip r $ tail r) [0 ..]
where
generateP y (((z1, z2), (z3, z4)), x) =
let (n1x, n1y, n1z) = normal (x, y, z1) (x, y + 1, z2) (x + 1, y, z3)
(n2x, n2y, n2z) = normal (x + 1, y + 1, z4) (x, y + 1, z2) (x + 1, y, z3)
in [ x,
y,
z1,
- n1x,
- n1y,
- n1z,
x,
y + 1,
z2,
- n1x,
- n1y,
- n1z,
x + 1,
y,
z3,
- n1x,
- n1y,
- n1z,
x,
y + 1,
z2,
n2x,
n2y,
n2z,
x + 1,
y,
z3,
n2x,
n2y,
n2z,
x + 1,
y + 1,
z4,
n2x,
n2y,
n2z
]
initTerrain :: [[Float]] -> GL.Program -> IO Terrain
initTerrain g p = do
vao <- GL.genObjectName
GL.bindVertexArrayObject $= Just vao
vbo <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just vbo
let g' = partition g :: V.Vector Float
V.unsafeWith g' $ \ptr ->
GL.bufferData GL.ArrayBuffer $= (vectorSize g', castPtr ptr, GL.StaticDraw)
setVertexAttribute p "position" 3 6 0
setVertexAttribute p "normal" 3 6 3
GL.bindVertexArrayObject $= Nothing
let h = length g
w = length (head g)
modelMatrix =
mkTransformation
(axisAngle (V3 0 0 0) 0)
(V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0)
modelP <- malloc
poke modelP modelMatrix
return $ Terrain w h g (Renderer (Just p) (Just vao) modelP ((w + 2) * (h + 2) * 8))
destroyTerrain :: Terrain -> IO ()
destroyTerrain t =
destroyRenderer $ terrainRenderer t
|
