From 72f57b6ccf8f84324e1a9045d86c412679b46362 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 29 Jul 2021 15:58:35 +0200 Subject: [PATCH] Move towards removing renderStrategy data --- src/Dodge/Data.hs | 1 + src/Dodge/Default/World.hs | 1 + src/Dodge/Layout.hs | 10 ++++++++++ src/Dodge/Render.hs | 27 ++++++++++++++++++++------- src/Dodge/Render/Picture.hs | 34 ++++++++++++++++++++++++++++++++++ src/Polyhedra.hs | 3 +++ 6 files changed, 69 insertions(+), 7 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index a9139a7ea..4644275a3 100644 --- a/src/Dodge/Data.hs +++ b/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) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 65ac47a34..ef424b340 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -79,6 +79,7 @@ defaultWorld = World , _inventoryMode = TopInventory , _lClickHammer = HammerUp , _foregroundDecorations = [] + , _foregroundEdgeVerx = [] , _radDistortion = [] } defaultDebugFlags :: DebugFlags diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index e2d974015..22f3a128f 100644 --- a/src/Dodge/Layout.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 9ec2c9f21..c665afd5a 100644 --- a/src/Dodge/Render.hs +++ b/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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index cfff5df6b..064284bab 100644 --- a/src/Dodge/Render/Picture.hs +++ b/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 diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 8d2d1980e..6451cf7c5 100644 --- a/src/Polyhedra.hs +++ b/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