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

Allow for destruction of blocks again

Browse Source
This commit is contained in:
justin
2021-10-27 00:15:26 +01:00
parent 12d43f9cf0
commit 15fac3db6e
2 changed files with 9 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Initialisation.hs
+3 -1
View File
@@ -64,8 +64,10 @@ zonedBlockWalls = concatMap f . IM.toList . _znObjects . _wallsZone
g (y,zs) = show y g (y,zs) = show y
testStringInit :: World -> [String] testStringInit :: World -> [String]
testStringInit _ = []
--testStringInit w = map (show . _blWallIDs) . IM.elems $ _blocks w --testStringInit w = map (show . _blWallIDs) . IM.elems $ _blocks w
testStringInit w = (map (f w) . filter g . IM.elems $ _walls w) --testStringInit w = (map (f w) . filter g . IM.elems $ _walls w)
-- ++ map (show . fst) (IM.toList $ _znObjects $ _wallsZone w)
-- ++ zonedBlockWalls w -- ++ zonedBlockWalls w
where where
g Block{} = True g Block{} = True
src/Dodge/Update.hs
+6 -5
View File
@@ -85,16 +85,17 @@ updateBlocks w = foldr f w $ _blocks w
where where
f bl w' f bl w'
| head (_blHPs bl) < 1 = w' | head (_blHPs bl) < 1 = w'
& blocks %~ IM.delete (_blID bl)
& walls %~ removeIDs (_blWallIDs bl) & walls %~ removeIDs (_blWallIDs bl)
-- & flip (foldr removeFromZone) (_blWallIDs bl) & flip (foldr removeFromZone) (_blWallIDs bl)
& blocks %~ IM.delete (_blID bl)
| otherwise = w' | otherwise = w'
removeIDs is wls = foldr IM.delete wls is removeIDs is wls = foldr IM.delete wls is
--removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w' removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w'
removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y . ix (_wlID wl)) setCol w' --removeFromZone wlid w' = set (wallsZone . znObjects) IM.empty w'
--removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y . ix (_wlID wl)) setCol w'
where where
(x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl) (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
wl = _walls w' IM.! wlid wl = _walls w IM.! wlid
setCol = wlColor .~ V4 1 1 0 1 setCol = wlColor .~ V4 1 1 0 1
-- | Note the explict use of record syntax. Using lens creates a space leak. -- | Note the explict use of record syntax. Using lens creates a space leak.