justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Attempt to stream SPics, not sure if this improves speed

Browse Source
This commit is contained in:
justin
2022-07-04 20:34:47 +01:00
parent 1e32b05406
commit 6972256751
5 changed files with 64 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render.hs
+24 -5
View File
@@ -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)
src/Dodge/Render/ShapePicture.hs
+12 -15
View File
@@ -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