diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 335416ded..2a054d999 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -49,9 +49,15 @@ 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) ) ( (nWalls, nWins , nFls),(nShapeVs, nIndices, nSilIndices) ) - <- MP.bindM2 (curry return) + <- MP.bindM3 (\_ a b -> return (a,b)) + ( pokeLayVerxs + shadV + layerCounts + wp + ) ( pokeWallsWindowsFloor (shadVBOptr $ _wallTextureShader pdata) (shadVBOptr $ _windowShader pdata) @@ -60,14 +66,21 @@ doDrawing pdata u = do windowPoints (_floorTiles w) ) - ( pokeSPics - shadV - layerCounts + ( pokeShape' (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) (_eboPtr $ _shapeEBO pdata) (_eboPtr $ _silhouetteEBO pdata) - (S.cons wallSPics $ worldSPic cfig w) + (0,0,0) + ws ) +-- ( pokeSPics +-- shadV +-- layerCounts +-- (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) +-- (_eboPtr $ _shapeEBO pdata) +-- (_eboPtr $ _silhouetteEBO pdata) +-- (S.cons wallSPics $ worldSPic cfig w) +-- ) -- <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts)) -- ( pokeBindFoldableLayer shadV layerCounts wp) -- ( pokeWallsWindowsFloor diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index babe84fa3..d9f14fedf 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -41,21 +41,24 @@ import qualified Data.Set as Set import Padding --import Data.Foldable -worldSPic :: Configuration -> World -> Stream (Of SPic) IO () +singleSPic = id + +worldSPic :: Configuration -> World -> SPic worldSPic cfig w - = S.yield (mempty, extraPics cfig w) - <> S.map (dbArg _prDraw) (filtOn' _prPos _props) - <> S.map (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks) - <> S.map (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes) - <> S.map (dbArg _cpPict) (filtOn' _cpPos _corpses) - <> S.map (dbArg _crPict) (filtOn' _crPos _creatures) - <> S.map floorItemSPic (filtOn' _flItPos _floorItems) - <> S.map btSPic (filtOn' _btPos _buttons) - <> S.map mcSPic (filtOn' _mcPos _machines) - <> S.yield (anyTargeting cfig w) + = singleSPic (mempty, extraPics cfig w) + <> f (dbArg _prDraw) (filtOn' _prPos _props) + <> f (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks) + <> f (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes) + <> f (dbArg _cpPict) (filtOn' _cpPos _corpses) + <> f (dbArg _crPict) (filtOn' _crPos _creatures) + <> f floorItemSPic (filtOn' _flItPos _floorItems) + <> f btSPic (filtOn' _btPos _buttons) + <> f mcSPic (filtOn' _mcPos _machines) + <> singleSPic (anyTargeting cfig w) where - --filtOn f g = IM.filter (pointIsClose . f) (g w) - filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w) + f = foldMap + filtOn' f g = IM.filter (pointIsClose . f) (g w) + --filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w) pointIsClose = cullPoint cfig w anyTargeting :: Configuration -> World -> SPic diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 3c631d4ab..534a2aaf3 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -5,6 +5,7 @@ module Shader.Poke , pokeArrayOff -- , pokePoint33s , pokeShape + , pokeShape' , pokeWallsWindowsFloor ) where import Shader.Data