From 69722567512f07240edde3c5885b170afd3def11 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 4 Jul 2022 20:34:47 +0100 Subject: [PATCH] Attempt to stream SPics, not sure if this improves speed --- src/Dodge/Render.hs | 29 ++++++++++++++++++++++++----- src/Dodge/Render/ShapePicture.hs | 27 ++++++++++++--------------- src/Shader/Poke.hs | 21 ++++++++++++++++++++- src/Shape/Data.hs | 1 - src/StreamingHelp.hs | 8 ++++++++ 5 files changed, 64 insertions(+), 22 deletions(-) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index b12767289..96b167b29 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -27,6 +27,7 @@ import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import qualified SDL import qualified Data.Vector.Unboxed.Mutable as UMV import Graphics.GL.Core43 +import qualified Streaming.Prelude as S doDrawing :: RenderData -> Universe -> IO Word32 doDrawing pdata u = do @@ -48,10 +49,9 @@ doDrawing pdata u = do -- count mutable vectors setup layerCounts <- UMV.replicate (numLayers*6) 0 -- attempt to poke in parallel - let (ws,wp) = wallSPics <> worldSPic cfig w +-- let (ws,wp) = wallSPics <> worldSPic cfig w ( (nWalls, nWins , nFls),(nShapeVs, nIndices, nSilIndices) ) - <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts)) - ( pokeBindFoldableLayer shadV layerCounts wp) + <- MP.bindM2 (\ wlwifl counts -> return (wlwifl,counts)) ( pokeWallsWindowsFloor (shadVBOptr $ _wallTextureShader pdata) (shadVBOptr $ _windowShader pdata) @@ -60,13 +60,32 @@ doDrawing pdata u = do windowPoints (_floorTiles w) ) - ( pokeShape + ( pokeSPics + shadV + layerCounts (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) (_eboPtr $ _shapeEBO pdata) (_eboPtr $ _silhouetteEBO pdata) - ws + (S.cons wallSPics $ worldSPic cfig w) ) +-- <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts)) +-- ( pokeBindFoldableLayer shadV layerCounts wp) +-- ( pokeWallsWindowsFloor +-- (shadVBOptr $ _wallTextureShader pdata) +-- (shadVBOptr $ _windowShader pdata) +-- (shadVBOptr $ _textureArrayShader pdata) +-- wallPointsCol +-- windowPoints +-- (_floorTiles w) +-- ) +-- ( pokeShape +-- (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) +-- (_eboPtr $ _shapeEBO pdata) +-- (_eboPtr $ _silhouetteEBO pdata) +-- ws +-- ) -- bind wall points, silhouette data, surface geometry + bindShaderLayers shadV layerCounts uncurry bindShaderBuffers $ unzip [ ( _wallTextureShader pdata, nWalls) , (_shapeShader pdata, nShapeVs) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 3abc49297..8f54db80a 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -26,9 +26,9 @@ import Picture import Sound.Data import Geometry.ConvexPoly import ShortShow -import Shape.Data --import Dodge.Base.Collide +import StreamingHelp --import Data.Foldable import qualified Data.IntMap.Strict as IM -- Lazy? import qualified Data.Map.Strict as M @@ -36,31 +36,28 @@ import qualified Data.Map.Strict as M import Control.Lens import Data.Maybe import qualified Streaming.Prelude as S -import Streaming import qualified Data.Graph.Inductive as FGL import qualified Data.Set as Set import Padding --import Data.Foldable -- TODO only filter out shapes outside the range of the furthest shown light source -worldSPic :: Configuration -> World -> SPic +worldSPic :: Configuration -> World -> Stream (Of SPic) IO () worldSPic cfig w - = ((mempty, extraPics cfig w) ) - <> (foldMap (dbArg _prDraw) (filtOn _prPos _props) ) - <> (foldMap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) ) - <> (foldMap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes) ) - <> (foldMap (dbArg _cpPict) (filtOn _cpPos _corpses) ) - <> (foldMap (dbArg _crPict) (filtOn _crPos _creatures) ) - <> (foldMap floorItemSPic (filtOn _flItPos _floorItems) ) - <> (foldMap btSPic (filtOn _btPos _buttons) ) - <> (foldMap mcSPic (filtOn _mcPos _machines) ) - <> (anyTargeting cfig w ) + = (S.yield (mempty, extraPics cfig w) ) + <> (S.each $ fmap (dbArg _prDraw) (filtOn _prPos _props) ) + <> (S.each $ fmap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) ) + <> (S.each $ fmap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes) ) + <> (S.each $ fmap (dbArg _cpPict) (filtOn _cpPos _corpses) ) + <> (S.each $ fmap (dbArg _crPict) (filtOn _crPos _creatures) ) + <> (S.each $ fmap floorItemSPic (filtOn _flItPos _floorItems) ) + <> (S.each $ fmap btSPic (filtOn _btPos _buttons) ) + <> (S.each $ fmap mcSPic (filtOn _mcPos _machines) ) + <> S.yield (anyTargeting cfig w ) where filtOn f g = IM.filter (pointIsClose . f) (g w) pointIsClose = cullPoint cfig w -type SPicStream = Stream (Of ShapeObj) (Stream (Of Verx) IO) () - anyTargeting :: Configuration -> World -> SPic anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr) where diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 4c4727980..605e32888 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,5 +1,6 @@ module Shader.Poke ( pokeVerxs + , pokeSPics , pokeLayVerxs , pokeArrayOff -- , pokePoint33s @@ -11,6 +12,7 @@ import Shader.Parameters import Picture.Data import Shape.Data import Geometry.Data +import ShapePicture import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) import Foreign @@ -27,7 +29,7 @@ import Streaming pokeVerxs :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int - -> Picture + -> Picture -> IO () pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) @@ -80,11 +82,28 @@ pokeW ptr i' ((V2 a b,V2 c d),V4 e f g h) = do pokeElemOff ptr (i + 7) h return $ i' + 1 +pokeSPics + :: MV.MVector (PrimState IO) FullShader + -> UMV.MVector (PrimState IO) Int + -> Ptr Float -> Ptr GLushort -> Ptr GLushort + -> Stream (Of SPic) IO () + -> IO (Int,Int,Int) +pokeSPics vbos counts ptr iptr ieptr = + S.foldM_ (\is (sh,pic) -> pokeLayVerxs vbos counts pic >> pokeShape' ptr iptr ieptr is sh) + (return (0,0,0)) return + + pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort -> Stream (Of ShapeObj) IO () -> IO (Int,Int,Int) pokeShape ptr iptr ieptr = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return (0,0,0)) return +pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort + -> (Int,Int,Int) + -> Stream (Of ShapeObj) IO () + -> IO (Int,Int,Int) +pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return + pokeShapeObj :: Ptr Float -> Ptr GLushort diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index 629073e68..c59f2046a 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -26,7 +26,6 @@ shVfromList = id --shVfromList = DL.fromList {-# INLINE shEfromList #-} shEfromList = id ---shEfromList = DL.fromList data ShapeObj = ShapeObj { _shType :: ShapeType diff --git a/src/StreamingHelp.hs b/src/StreamingHelp.hs index 91febca54..1becc385d 100644 --- a/src/StreamingHelp.hs +++ b/src/StreamingHelp.hs @@ -23,3 +23,11 @@ sortStreamOn :: Ord a => (b -> a) -> StreamOf b -> Stream (Of b) Identity () sortStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g where g x = (f x,x) + +--applyUnzip +-- :: (Stream (Of a) IO () -> IO r) +-- -> (Stream (Of b) IO () -> IO ()) +-- -> Stream (Of a) (Stream g IO) () +-- -> IO r +--applyUnzip f g s = h s +