From 27569ed8f34e93063e734a6caed8b2cef733923b Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 24 Oct 2025 11:16:30 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Block.hs | 2 - src/Dodge/CreatureEffect.hs | 2 +- src/Dodge/DrWdWd.hs | 4 +- src/Dodge/Material/Damage.hs | 34 ++++++++--------- src/Dodge/Path.hs | 4 +- src/Dodge/Placement/PlaceSpot.hs | 2 +- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 2 +- src/Dodge/Update.hs | 5 +-- src/Dodge/Update/WallDamage.hs | 40 +++++++++++--------- src/Dodge/Wall/Damage.hs | 2 +- src/Dodge/Wall/Move.hs | 2 +- 11 files changed, 50 insertions(+), 49 deletions(-) diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index f52bfe69e..cd36b1fe7 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - module Dodge.Block (destroyBlock) where import ListHelp diff --git a/src/Dodge/CreatureEffect.hs b/src/Dodge/CreatureEffect.hs index 015b94ca8..ecb17b912 100644 --- a/src/Dodge/CreatureEffect.hs +++ b/src/Dodge/CreatureEffect.hs @@ -25,7 +25,7 @@ doWdCrBl wcb = case wcb of False (\cid -> canSee (_crID cr) cid w) (_targetCr (_crIntention cr)) - WdCrSafeDistFromTarget x -> \w -> crSafeDistFromTarg w x -- currently ignores walls etc + WdCrSafeDistFromTarget x -> (`crSafeDistFromTarg` x) -- currently ignores walls etc doCrBl :: CrBl -> Creature -> Bool doCrBl cb = case cb of diff --git a/src/Dodge/DrWdWd.hs b/src/Dodge/DrWdWd.hs index 42b97db43..0d2caa273 100644 --- a/src/Dodge/DrWdWd.hs +++ b/src/Dodge/DrWdWd.hs @@ -28,9 +28,9 @@ doorLerp speed dr w = fromMaybe (mempty,w) $ do x <- newlerp let ps = wlposs x is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps - -- it seems possible that this will miss some paths: we add zones for the + -- it seems possible that this will miss some paths: we don't add zones for the -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs - return $ (is, + return (is, f x & playSound x & cWorld . lWorld . doors . ix drid . drLerp .~ x) diff --git a/src/Dodge/Material/Damage.hs b/src/Dodge/Material/Damage.hs index cdd333b9a..140b5b5f0 100644 --- a/src/Dodge/Material/Damage.hs +++ b/src/Dodge/Material/Damage.hs @@ -38,14 +38,14 @@ damageStone dm ecw w = case dm of . randsound p [slapS, slap1S] Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t)) Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t)) - Crushing{} -> f dmam $ id - Explosive{} -> f dmam $ id - Sparking{} -> f 0 $ id - Flaming{} -> f 0 $ id - Electrical{} -> f 0 $ id - Poison{} -> f 0 $ id - Enterrement{} -> f 0 $ id - Flashing{} -> f 0 $ id + Crushing{} -> f dmam id + Explosive{} -> f dmam id + Sparking{} -> f 0 id + Flaming{} -> f 0 id + Electrical{} -> f 0 id + Poison{} -> f 0 id + Enterrement{} -> f 0 id + Flashing{} -> f 0 id where f x g = (x, g w) dmam = dm ^. dmAmount @@ -69,15 +69,15 @@ damageMetal dm ecw w = case dm of Blunt _ p t -> f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t) . randsound p [clangS,clang1S,clang2S] - Shattering {} -> f dmam $ id - Crushing{} -> f dmam $ id - Explosive{} -> f dmam $ id - Sparking{} -> f 0 $ id - Flaming{} -> f 0 $ id - Electrical{} -> f 0 $ id - Poison{} -> f 0 $ id - Enterrement{} -> f 0 $ id - Flashing{} -> f 0 $ id + Shattering {} -> f dmam id + Crushing{} -> f dmam id + Explosive{} -> f dmam id + Sparking{} -> f 0 id + Flaming{} -> f 0 id + Electrical{} -> f 0 id + Poison{} -> f 0 id + Enterrement{} -> f 0 id + Flashing{} -> f 0 id where f x g = (x, g w) dmam = dm ^. dmAmount diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index af3b60fd3..d8ea5cf08 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -101,11 +101,11 @@ smallSnailInt2 = [V2 x y | x <- [-2 .. 2], y <- [-2 .. 2]] makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] -makePathBetweenPs a b w = traverse (flip getNodePos w) =<< makePathBetween a b w +makePathBetweenPs a b w = traverse (`getNodePos` w) =<< makePathBetween a b w -- assumes that pathfinding is symmetric pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 -pointTowardsImpulse a b w = (find $ flip (isWalkable a) w) =<< makePathBetweenPs b a w +pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs b a w pairsToIncGraph :: Set.Set (Point2, Point2) -> diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index f87cdee5e..85e30da65 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase #-} +--{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {- | deals with placement of objects within the world diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index 9619a857c..9b6cff5b6 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -44,7 +44,7 @@ plDoor eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cWorld wlids = take 4 [IM.newKey $ _walls (_lWorld (_cWorld $ _gwWorld gw)) ..] wlps' = rectanglePairs 9 0 (V2 l 0) --addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids - addWalls w' = foldl' (addDoorWall eo drid $ defaultSwitchWall) w' $ zip wlids + addWalls w' = foldl' (addDoorWall eo drid defaultSwitchWall) w' $ zip wlids $ wlps' & each . each %~ shiftPointBy p1 addDoorWall :: S.Set EdgeObstacle diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0ad8f1d7a..0f4323c9a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -3,8 +3,6 @@ module Dodge.Update (updateUniverse) where -import Dodge.Zoning.Base ---import Dodge.Path import Data.Foldable import qualified Data.Set as S import Color @@ -322,8 +320,7 @@ updateAimPos u = -- f x _ = S.map WallObstacle x updateDoors :: World -> World -updateDoors w = let (is,w') = foldrM updateDoor w (w ^. cWorld . lWorld . doors) - in updateEdgesWall (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w' +updateDoors w = uncurry updateEdgesWall $ foldrM updateDoor w (w ^. cWorld . lWorld . doors) updateMagnets :: LWorld -> LWorld updateMagnets lw = diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index a90e3264f..c1837c758 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -1,35 +1,41 @@ -module Dodge.Update.WallDamage (updateWallDamages,updateEdgesWall) where +module Dodge.Update.WallDamage (updateWallDamages, updateEdgesWall) where -import Dodge.WorldEvent.ThingsHit -import Dodge.Path -import Dodge.Zoning.Base +import Geometry.Data import Control.Lens -import Data.Maybe -import Dodge.Data.World -import Dodge.Wall.Damage -import qualified IntMapHelp as IM import Data.Foldable +import Data.Maybe import qualified Data.Set as S +import Dodge.Data.World +import Dodge.Path +import Dodge.Wall.Damage +import Dodge.WorldEvent.ThingsHit +import Dodge.Zoning.Base +import qualified IntMapHelp as IM updateWallDamages :: World -> World -updateWallDamages w = - let (is,w') - = IM.foldlWithKey' f (mempty,w) (w ^. cWorld . lWorld . wallDamages) - in updateEdgesWall (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w' +updateWallDamages w = + let (is, w') = + IM.foldlWithKey' f (mempty, w) (w ^. cWorld . lWorld . wallDamages) + in updateEdgesWall is + w' & cWorld . lWorld . wallDamages .~ IM.empty where f isw k dams = fromMaybe isw $ do wl <- isw ^? _2 . cWorld . lWorld . walls . ix k return $ foldl' (flip (`damageWall` wl)) isw dams -updateEdgesWall :: S.Set (Int,Int) -> World -> World -updateEdgesWall = flip $ foldl' updateEdgeWallObs +updateEdgesWall :: S.Set Int2 -> World -> World +updateEdgesWall is w = updateEdgesWall' + (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w -updateEdgeWallObs :: World -> (Int,Int) -> World -updateEdgeWallObs w (i,j) = fromMaybe w $ do +updateEdgesWall' :: S.Set (Int, Int) -> World -> World +updateEdgesWall' = flip $ foldl' updateEdgeWallObs + +updateEdgeWallObs :: World -> (Int, Int) -> World +updateEdgeWallObs w (i, j) = fromMaybe w $ do s <- getNodePos i w e <- getNodePos j w let wlflags = foldMap (^. _2 . wlPathFlag) $ wlsHitUnsorted s e w - return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j) + return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i, j) where f x _ = S.map WallObstacle x diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index aa3abc8b3..6bec31b74 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -20,7 +20,7 @@ damageWall dt wl (is,w) = case _wlStructure wl of DoorPart drid -> f $ w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam -- & maybeDestroyDoor drid - _ -> f $ w' + _ -> f w' where f = (,) is -- x = case dt of diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index c0ba64243..ea65b3ff1 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +--{-# LANGUAGE BangPatterns #-} module Dodge.Wall.Move ( moveWallID,