From a7e6d6f3cc42ce5740b54101fd09d971d4ee9387 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 19 Jun 2022 15:05:12 +0100 Subject: [PATCH] Move wall damages to external position --- src/Dodge/Base/Collide.hs | 4 ++++ src/Dodge/Data.hs | 5 +++-- src/Dodge/Data/Wall.hs | 5 +++++ src/Dodge/Default/Wall.hs | 2 -- src/Dodge/Default/World.hs | 1 + src/Dodge/Item/Equipment.hs | 2 +- src/Dodge/Particle/HitEffect/ExpireAndDamage.hs | 6 +++--- src/Dodge/PlacementSpot.hs | 4 ++-- src/Dodge/Room/Procedural.hs | 2 +- src/Dodge/Room/Room.hs | 4 ++-- src/Dodge/Update.hs | 3 +++ src/Dodge/Update/Camera.hs | 2 +- src/Dodge/Update/WallDamage.hs | 16 ++++++++++++++++ src/Dodge/Wall/Damage.hs | 9 +++++---- 14 files changed, 47 insertions(+), 18 deletions(-) create mode 100644 src/Dodge/Data/Wall.hs create mode 100644 src/Dodge/Update/WallDamage.hs diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 9a90872bd..cf3b8dc1a 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -22,6 +22,7 @@ module Dodge.Base.Collide , collidePointWalls , collidePointWallsNorm , collidePointWalls' + , collidePointWallsFilt' , overlapCircWallsReturnWall , collideCircCrsPoint , collideCircCreatures @@ -373,6 +374,9 @@ collidePointWalls' p1 p2 = foldl' findPoint p2 . fmap _wlLine where findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p) +collidePointWallsFilt' :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2 +collidePointWallsFilt' t p1 p2 = collidePointWalls p1 p2 . IM.filter t + -- | Looks for first collision of a circle with walls. -- If found, gives point and reflection velocity, reflection damped in normal. -- note that the "intersection" point is the center of the circle flush against the wall diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 04500210d..279dbf31d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -106,6 +106,7 @@ data World = World , _newBeams :: WorldBeams , _beams :: WorldBeams , _walls :: IM.IntMap Wall + , _wallDamages :: IM.IntMap [Damage] , _doors :: IM.IntMap Door , _machines :: IM.IntMap Machine , _terminals :: IM.IntMap Terminal @@ -1029,7 +1030,7 @@ data Wall = Wall , _wlRotateTo :: Bool , _wlStructure :: WallStructure , _wlHeight :: Float - , _wlDamageEff :: Damage -> Wall -> World -> World +-- , _wlDamageEff :: Damage -> Wall -> World -> World , _wlMaterial :: Material } data Opacity @@ -1044,7 +1045,7 @@ data WallStructure | BlockPart { _wsBlock :: Int } | CreaturePart { _wlStCreature :: Int - , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World +-- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World } data ActionPlan diff --git a/src/Dodge/Data/Wall.hs b/src/Dodge/Data/Wall.hs new file mode 100644 index 000000000..14029ab36 --- /dev/null +++ b/src/Dodge/Data/Wall.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +module Dodge.Data.Wall where diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index 9f833ccf3..335ba6430 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -22,7 +22,6 @@ defaultWall = Wall , _wlStructure = StandaloneWall , _wlWalkable = False , _wlHeight = 100 - , _wlDamageEff = defaultWallDamage , _wlMaterial = Stone } {- Indestructible see-through wall. -} @@ -55,7 +54,6 @@ defaultDirtWall = defaultWall defaultWindow :: Wall defaultWindow = defaultWall { _wlLine = (V2 0 0,V2 50 0) - , _wlDamageEff = windowWallDamage , _wlID = 0 , _wlColor = withAlpha 0.5 cyan , _wlSeen = False diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 4268decf4..e050327db 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -44,6 +44,7 @@ defaultWorld = World , _newBeams = WorldBeams [] [] [] [] , _beams = WorldBeams [] [] [] [] , _walls = IM.empty + , _wallDamages = IM.empty , _blocks = IM.empty , _machines = IM.empty , _terminals = IM.empty diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index baefaf63a..a0bab8533 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -157,7 +157,7 @@ shieldWall crid = defaultWall ,_wlReflect = True ,_wlDraw = False ,_wlRotateTo = False - ,_wlStructure = CreaturePart crid shieldWallDamage + ,_wlStructure = CreaturePart crid -- shieldWallDamage } -- TODO the reflection should be controled by the particle diff --git a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs index 0c4d2d547..7fa54f99e 100644 --- a/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs +++ b/src/Dodge/Particle/HitEffect/ExpireAndDamage.hs @@ -1,9 +1,10 @@ module Dodge.Particle.HitEffect.ExpireAndDamage where import Dodge.Data import Dodge.Particle.Update -import Dodge.Wall.Damage +--import Dodge.Wall.Damage import Geometry import LensHelp +import qualified Data.IntMap.Strict as IM expireAndDamage :: (Particle -> Point2 -> [Damage]) -> Particle @@ -21,7 +22,6 @@ doDamages :: (Particle -> Point2 -> [Damage]) -> World doDamages fdm (p,thhit) bt = case thhit of Left cr -> creatures . ix (_crID cr) . crState . crDamage .++~ dams - Right wl -> flip (foldr (`damageWall` wl)) dams + Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = fdm bt p - diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 28512edbd..f6ecd3d19 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -85,13 +85,13 @@ rpIsOffPath = any f . _rpType rpOffPathEdge :: PathEdge -> RoomPos -> Bool rpOffPathEdge pe = any f . _rpType where - f rt = maybe False (any (== pe)) (rt ^? offPathEdges) + f rt = maybe False (pe `elem`) (rt ^? offPathEdges) -- test whether a roomPos is on the path with a given from edge value rpOnPathEdge :: PathEdge -> RoomPos -> Bool rpOnPathEdge pe = any f . _rpType where - f rt = maybe False (any (== pe)) (rt ^? onPathEdges) + f rt = maybe False (pe `elem`) (rt ^? onPathEdges) resetPLUse :: PlacementSpot -> PlacementSpot resetPLUse (PSPos f g fallback) = PSPos f' g fallback diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 7b82ef65d..bb125f352 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -71,7 +71,7 @@ roomRect x y xn yn = defaultRoom , _rmHeight = y } } - where + where yd = (y - 40) / fromIntegral yn xd = (x - 40) / fromIntegral xn somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a) diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 406d5b710..ff7e3bc08 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -208,9 +208,9 @@ weaponBetweenPillars = do rpIsOnPath rp && _rpPlacementUse rp == 0 && all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r) - (fmap pure $ roomPillars 30 w h wn hn + (roomPillars 30 w h wn hn <&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [ sps wpPos (PutFlIt wp) ] - <&> cleatOnward) >>= rToOnward ("weaponBetweenPillars_"++itemString wp) + <&> cleatOnward) >>= rToOnward ("weaponBetweenPillars_"++itemString wp) . pure weaponLongCorridor :: RandomGen g => State g (Tree Room) weaponLongCorridor = do diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0dc9f84bb..c8e35f706 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -10,6 +10,7 @@ import Dodge.Block import Dodge.Distortion import Dodge.SoundLogic import Dodge.Wall.Delete +import Dodge.Update.WallDamage --import Dodge.Menu import Dodge.Base import Dodge.Zone @@ -82,6 +83,7 @@ functionalUpdate cfig w = checkEndGame . over creatures (fmap setOldPos) . updateCreatureGroups . updateBlocks + . updateWallDamages . updateSeenWalls -- . (youHammerPosition %~ moveHammerUp) . updateTerminal @@ -95,6 +97,7 @@ functionalUpdate cfig w = checkEndGame where (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl + updateBoundBox :: Configuration -> World -> World updateBoundBox cfig w = w & boundBox .~ cullBox cfig w diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 25f193319..40758a954 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -210,7 +210,7 @@ farWallDistDirection :: Point2 -> Configuration -> World -> (Float,Float,Float,F --farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps farWallDistDirection p cfig w = foldr (m . f) (0,0,0,0) vps where - f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWalls' p q (IM.filter wlIsOpaque wos) -.- p + f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilt' wlIsOpaque p q wos -.- p g (V2 x y) = (y, negate y, x, negate x) m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w') vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs new file mode 100644 index 000000000..c17273fba --- /dev/null +++ b/src/Dodge/Update/WallDamage.hs @@ -0,0 +1,16 @@ +module Dodge.Update.WallDamage where +import Dodge.Wall.Damage +import Dodge.Data + +import qualified Data.IntMap.Strict as IM +import Control.Lens +import Data.Maybe + +updateWallDamages :: World -> World +updateWallDamages w = w + & wallDamages .~ IM.empty + & flip (IM.foldrWithKey f) (_wallDamages w) + where + f k dams w' = fromMaybe w' $ do + wl <- w' ^? walls . ix k + return $ foldr (flip damageWall wl) w' dams diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 6a0e0a37c..b44c8c74f 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -7,13 +7,14 @@ module Dodge.Wall.Damage ) where import Dodge.Data import LensHelp +import Dodge.Wall.DamageEffect damageWall :: Damage -> Wall -> World -> World damageWall dt wl = case _wlStructure wl of - MachinePart mcid -> _wlDamageEff wl dt wl . (machines . ix mcid . mcDamage .:~ dt) - BlockPart blid -> _wlDamageEff wl dt wl . (blocks . ix blid %~ damageBlockWith dt) - CreaturePart crid f -> f dt wl crid - _ -> _wlDamageEff wl dt wl + MachinePart mcid -> defaultWallDamage dt wl . (machines . ix mcid . mcDamage .:~ dt) + BlockPart blid -> defaultWallDamage dt wl . (blocks . ix blid %~ damageBlockWith dt) +-- CreaturePart crid f -> f dt wl crid + _ -> defaultWallDamage dt wl damageBlockWith :: Damage -> Block -> Block damageBlockWith dm = case _dmType dm of