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

Revert to foldMap-ing worldSPic

Browse Source
This commit is contained in:
justin
2022-07-10 09:59:19 +01:00
parent a5730014c8
commit 2a70dcc9a6
3 changed files with 36 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/ShapePicture.hs
+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