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

Commit before attempting to remove ptDraw field

Browse Source
This commit is contained in:
justin
2022-07-10 10:49:49 +01:00
parent 2a70dcc9a6
commit 8202d12b6a
8 changed files with 59 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/ShapePicture.hs
+11 -10
View File
@@ -39,24 +39,25 @@ import qualified Streaming.Prelude as S
import qualified Data.Graph.Inductive as FGL
import qualified Data.Set as Set
import Padding
--import Data.Foldable
import Data.Foldable
singleSPic :: SPic -> SPic
singleSPic = id
worldSPic :: Configuration -> World -> SPic
worldSPic 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)
<> foldup (dbArg _prDraw) (filtOn' _prPos _props)
<> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)
<> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses)
<> foldup (dbArg _crPict) (filtOn' _crPos _creatures)
<> foldup floorItemSPic (filtOn' _flItPos _floorItems)
<> foldup btSPic (filtOn' _btPos _buttons)
<> foldup mcSPic (filtOn' _mcPos _machines)
<> singleSPic (anyTargeting cfig w)
where
f = foldMap
foldup = 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