3 files changed, 109 insertions, 7 deletions
diff --git a/src/Vivant/Common.hs b/src/Vivant/Common.hs
new file mode 100644
index 0000000..fd90233
--- /dev/null
+++ b/src/Vivant/Common.hs
@@ -0,0 +1,9 @@
+module Vivant.Common
+  (vectorSize)
+where
+
+import qualified Data.Vector.Storable as V
+import Foreign.Storable (sizeOf)
+
+vectorSize :: (Num b, V.Storable a) => V.Vector a -> b
+vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
diff --git a/src/Vivant/Renderer.hs b/src/Vivant/Renderer.hs
index ca623e7..f66b0d7 100644
--- a/src/Vivant/Renderer.hs
+++ b/src/Vivant/Renderer.hs
@@ -1,15 +1,49 @@
 module Vivant.Renderer
-  (Renderer(..))
+  (Renderer(..), getUniformLocation, destroyRenderer, render, setVertexAttribute)
 where
 
 import qualified Graphics.Rendering.OpenGL as GL
 import Linear
 import Foreign.Ptr
+import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv)
+import Graphics.Rendering.OpenGL (($=))
+import Foreign.Marshal.Alloc (free)
+import Foreign.Storable (sizeOf)
 
 data Renderer = Renderer
   { rendererProgram :: Maybe GL.Program,
     rendererVao :: Maybe GL.VertexArrayObject,
-    rendererModelP :: Ptr (M44 Float)
-  } deriving Show
+    rendererModelP :: Ptr (M44 Float),
+    rendererTriangleNum :: Int
+  } deriving (Show)
 
-draw :: Renderer -> IO ()
+getUniformLocation :: GL.UniformLocation -> GL.GLint
+getUniformLocation (GL.UniformLocation i) = i
+
+render :: Renderer -> IO ()
+render r@(Renderer {rendererProgram = Just p}) = do
+--  GL.currentProgram $= rendererProgram r
+  GL.bindVertexArrayObject $= rendererVao r
+
+  model <- getUniformLocation <$> GL.uniformLocation p "model"
+  GL.glUniformMatrix4fv model 1 1 (castPtr (rendererModelP r))
+
+  GL.drawArrays GL.Triangles 0 (fromIntegral $ rendererTriangleNum r)
+
+destroyRenderer :: Renderer -> IO ()
+destroyRenderer r =
+  free $ rendererModelP r
+
+setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO ()
+setVertexAttribute program name vertices stride offset = do
+  let floatSize = sizeOf (1.0 :: Float)
+  attrib <- GL.get $ GL.attribLocation program name
+  GL.vertexAttribPointer attrib
+    $= ( GL.ToFloat,
+         GL.VertexArrayDescriptor
+           (fromIntegral vertices)
+           GL.Float
+           (fromIntegral $ stride * floatSize)
+           (plusPtr nullPtr (offset * floatSize))
+       )
+  GL.vertexAttribArray attrib $= GL.Enabled
diff --git a/src/Vivant/Terrain.hs b/src/Vivant/Terrain.hs
index 9d5201a..3099177 100644
--- a/src/Vivant/Terrain.hs
+++ b/src/Vivant/Terrain.hs
@@ -1,6 +1,65 @@
-module Vivant.Terrain where
+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
   {
-    terrainVao ::
-  }
+    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