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
|
module Vivant.Terrain
(Terrain(..), initTerrain)
where
import Vivant.Renderer
import qualified Data.Vector.Storable as V
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=))
import Foreign.Marshal.Alloc (free, malloc)
import Foreign.Ptr
import Vivant.Common (vectorSize)
import Foreign.Storable (poke)
import Linear
data Terrain = Terrain
{
terrainWidth :: Int,
terrainHeight :: Int,
terrainGeometry :: [[Int]],
terrainRenderer :: Renderer
} deriving (Show)
partition
:: (V.Storable a1, Integral a2, Num a1) => [[a2]] -> V.Vector a1
partition r =
V.fromList . fmap fromIntegral . 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) =
[ x, y, z1
, x, y+1, z2
, x+1, y, z3
, x, y+1, z2
, x+1, y, z3
, x+1, y+1, z4
]
initTerrain :: [[Int]] -> 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 0 0
GL.bindVertexArrayObject $= Nothing
modelP <- malloc
let modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0) (V3 (-2.5) (-2.5) 0)
poke modelP modelMatrix
let h = length g
w = length (head g)
return $ Terrain w h g (Renderer (Just p) (Just vao) modelP 72)
destroyTerrain :: Terrain -> IO ()
destroyTerrain t =
destroyRenderer $ terrainRenderer t
|
