Add file

src/Dodge/WorldLoad.hs

@@ -0,0 +1,17 @@
+module Dodge.WorldLoad where
+
+import Shader.Bind
+import Shader.Data
+import Shader.Poke.Floor
+import Data.Preload.Render
+import Dodge.Data.CWorld
+import Control.Monad
+import Control.Lens
+
+postWorldLoad :: RenderData -> CWorld -> IO CWorld
+postWorldLoad rdata cw = do
+    nfloorvxs <- foldM (pokeTile (rdata ^. floorVBO . vboPtr))
+        0
+        (cw ^. cwTiles)
+    bufferPokedVBO (rdata ^. floorVBO) nfloorvxs
+    return $ cw & numberFloorVerxs .~ nfloorvxs

src/Shader/Poke/Floor.hs

@@ -0,0 +1,19 @@
+module Shader.Poke.Floor where
+
+import Geometry
+import Shader.Poke.Triangulate
+import Control.Monad
+import Tile
+import Data.Tile
+import Foreign
+
+pokeTile :: Ptr Float -> Int -> Tile -> IO Int
+pokeTile ptr i t@Tile { _tilePoly = ps , _tileX = ttan } = do
+    let coords = map (calcTexCoord (_tileZero t) ttan) ps
+        coords3 = map (addZ (_tileZ t)) coords
+    foldM (pokeTileVerx ttan ptr) i $ triangulate $ zip ps coords3
+
+pokeTileVerx :: Point2 -> Ptr Float -> Int -> (Point2,Point3) -> IO Int
+pokeTileVerx (V2 t s) ptr i (V2 x y,V3 u v w) = do
+    zipWithM_ (\off -> pokeElemOff ptr (i*8 + off)) [0..] [x,y,s,t,u,v,w,1]
+    return $ i + 1

src/Shader/Poke/Triangulate.hs

@@ -0,0 +1,15 @@
+module Shader.Poke.Triangulate where
+
+import qualified Data.Vector as V
+
+triangulate :: [a] -> [a]
+{-# INLINE triangulate #-}
+triangulate is = V.toList . V.backpermute (V.fromList is) . V.fromList $ triangulateIndices (length is)
+
+triangulateIndices :: Int -> [Int]
+{-# INLINE triangulateIndices #-}
+triangulateIndices i = concatMap f [0 .. i -3]
+  where
+    f x
+        | even x = [0, x + 1, x + 2]
+        | otherwise = [0, x + 2, x + 1]