Revert to foldMap-ing worldSPic

This commit is contained in:
2022-07-10 09:59:19 +01:00
parent a5730014c8
commit 2a70dcc9a6
3 changed files with 36 additions and 19 deletions
+19 -6
View File
@@ -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
+16 -13
View File
@@ -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
+1
View File
@@ -5,6 +5,7 @@ module Shader.Poke
, pokeArrayOff
-- , pokePoint33s
, pokeShape
, pokeShape'
, pokeWallsWindowsFloor
) where
import Shader.Data