Move towards removing renderStrategy data

src/Dodge/Data.hs

@@ -77,6 +77,7 @@ data World = World
     , _sounds               :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
     , _foregroundDecorations :: [Polyhedra]
+    , _foregroundEdgeVerx   :: [Point3]
     , _corpses              :: IM.IntMap (IM.IntMap [Corpse])
     , _clickMousePos        :: (Float,Float)
     , _pathGraph            :: ~(Gr Point2 Float)

src/Dodge/Default/World.hs

@@ -79,6 +79,7 @@ defaultWorld = World
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
     , _foregroundDecorations = []
+    , _foregroundEdgeVerx = []
     , _radDistortion = []
     }
 defaultDebugFlags :: DebugFlags

src/Dodge/Layout.hs

@@ -13,11 +13,14 @@ import Dodge.Room.Data
 import Dodge.Room.AddTile
 import Dodge.Default.Wall
 import Geometry
+import Geometry.Data
 import Dodge.Room.Link
 import qualified IntMapHelp as IM
 --import Dodge.Debug.LinkDecoration
 import Picture.Data
 import Tile
+import Polyhedra
+import Polyhedra.Data
 
 import Control.Monad.State
 import Control.Lens
@@ -32,6 +35,7 @@ import Data.Foldable
 generateLevelFromRoomList :: State StdGen [Room] -> World -> World
 generateLevelFromRoomList gr w = updateWallZoning 
 --    . initializeStaticWalls
+    . setupForegroundEdgeVerxs
     . placeSpots plmnts
 --    . addRoomPolyDecorations rs
 --    . addRoomLinkDecorations rs
@@ -44,6 +48,12 @@ generateLevelFromRoomList gr w = updateWallZoning
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
     rs' = evalState gr $ _randGen w
 
+setupForegroundEdgeVerxs :: World -> World
+setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w)
+
+polyhedrasToEdges :: [Polyhedra] -> [Point3]
+polyhedrasToEdges = concatMap flat4 . concatMap polyToEdges
+
 -- | connects a collection (tree) of rooms together
 generateFromTree :: State StdGen (Tree Room) -> World -> World
 generateFromTree t w = updateWallZoning $ placeSpots plmnts 

src/Dodge/Render.hs

@@ -53,15 +53,27 @@ doDrawing pdata w = do
         pic = worldPictures w
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
-    nWalls <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
+    -- _ <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
+    --pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) $ wallsToList wallPointsCol
+    --let nWalls = length wallPointsCol
+    nWalls <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) wallPointsCol
+    --poke
+
     -- poke silhouette vertex data
-    nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) 
-                (concatMap polyToRender (foregroundPics w))
+    -- nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) 
+    --             (concatMap polyToRender (foregroundPics w))
+    nSils <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingLineShadowShader pdata) 
+                (_foregroundEdgeVerx w)
+
     -- poke foreground geometry and floor
     let addC (xx,yy) = (xx,yy,0)
-    nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
-        $ Render3 (polyToTris $ map addC $ screenPolygon w)
-        : concatMap polyToGeoRender (foregroundPics w)
+    nsurfVs <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingSurfaceShader pdata)
+        $ (polyToTris $ map addC $ screenPolygon w)
+        ++ concatMap polyToGeoRender' (foregroundPics w)
+    --nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
+    --    $ Render3 (polyToTris $ map addC $ screenPolygon w)
+    --    : concatMap polyToGeoRender (foregroundPics w)
+
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)
@@ -208,7 +220,8 @@ renderWindows
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
     -> IO ()
 renderWindows pdata wps = do
-    n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
+    --n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
+    n <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallBlankShader pdata) wps
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
     cullFace $= Just Back

src/Dodge/Render/Picture.hs

@@ -19,6 +19,8 @@ import Control.Lens
 import Data.Maybe
 import Data.List (partition)
 import qualified Data.IntMap.Lazy as IM
+import Foreign.Ptr
+import Foreign.Storable
 
 worldPictures :: World -> Picture
 worldPictures w = 
@@ -209,6 +211,38 @@ wallsAndWindows w
     f wl = (_wlLine wl, _wlColor wl)
     (wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w
 
+wallsToList :: [((Point2,Point2),Point4)] -> [Float]
+wallsToList = concatMap (\(((a,b),(c,d)),(e,f,g,h)) -> [a,b,c,d,e,f,g,h])
+
+pokePoint3s :: Ptr Float -> [Point3] -> IO Int
+pokePoint3s ptr vals0 = go vals0 0
+  where
+    go [] n = return n
+    go ( (a,b,c):vals) n = do
+        pokeElemOff ptr (off 0) a
+        pokeElemOff ptr (off 1) b
+        pokeElemOff ptr (off 2) c
+        go vals (n+1)
+      where
+        off i = n*3 + i
+
+pokeWalls :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
+pokeWalls ptr vals0 = go vals0 0
+  where
+    go [] n = return n
+    go ( (((a,b),(c,d)),(e,f,g,h)):vals) n = do
+        pokeElemOff ptr (off 0) a
+        pokeElemOff ptr (off 1) b
+        pokeElemOff ptr (off 2) c
+        pokeElemOff ptr (off 3) d
+        pokeElemOff ptr (off 4) e
+        pokeElemOff ptr (off 5) f
+        pokeElemOff ptr (off 6) g
+        pokeElemOff ptr (off 7) h
+        go vals (n+1)
+      where
+        off i = n*8 + i
+
 lightsForGloom :: World -> [(Point3,Float,Float)]
 lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
   where 

src/Polyhedra.hs

@@ -102,3 +102,6 @@ polyToRender = map (Render3 . flat4) . polyToEdges
 -- rendering for shape
 polyToGeoRender :: Polyhedra -> [RenderType]
 polyToGeoRender = map (Render3 . polyToTris . map fst) . _pyFaces
+
+polyToGeoRender' :: Polyhedra -> [Point3]
+polyToGeoRender' = concatMap (polyToTris . map fst) . _pyFaces