From a4afe05478d2ae058b42a54107188e8eee761082 Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 29 Mar 2021 13:36:03 +0200 Subject: [PATCH] Stop inanimate objects from opening walls --- src/Dodge/Creature/Inanimate.hs | 8 +++-- src/Dodge/Creature/LookupStatus.hs | 14 -------- src/Dodge/Creature/Property.hs | 20 ++++++++++++ src/Dodge/Data.hs | 34 +++++++++++--------- src/Dodge/Default.hs | 1 + src/Dodge/Item/Weapon/Bullet.hs | 6 ++-- src/Dodge/LevelGen/AutoDoor.hs | 51 ++++++++++++++++-------------- src/Geometry.hs | 1 + 8 files changed, 76 insertions(+), 59 deletions(-) delete mode 100644 src/Dodge/Creature/LookupStatus.hs create mode 100644 src/Dodge/Creature/Property.hs diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index d291025bf..058840b30 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -15,8 +15,10 @@ import Picture import qualified Data.IntMap.Strict as IM import Control.Lens +defaultInanimate = defaultCreature & crIsAnimate .~ False + lamp :: Creature -lamp = defaultCreature +lamp = defaultInanimate { _crUpdate = initialiseLamp , _crHP = 500 , _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 10 @@ -40,7 +42,7 @@ updateLamp i = unrandUpdate handleLS internalUpdate barrel :: Creature -barrel = defaultCreature +barrel = defaultInanimate { _crUpdate = updateBarrel , _crHP = 500 , _crPict = \ _ -> onLayer CrLayer $ pictures @@ -56,7 +58,7 @@ barrel = defaultCreature } explosiveBarrel :: Creature -explosiveBarrel = defaultCreature +explosiveBarrel = defaultInanimate { _crUpdate = updateExpBarrel , _crHP = 400 , _crPict = \ _ -> onLayer CrLayer $ pictures [ color orange $ circleSolid 10 diff --git a/src/Dodge/Creature/LookupStatus.hs b/src/Dodge/Creature/LookupStatus.hs deleted file mode 100644 index f07579c11..000000000 --- a/src/Dodge/Creature/LookupStatus.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Dodge.Creature.LookupStatus - where -import Dodge.Data - -import Geometry - -import Control.Lens - -isArmouredFrom :: Point2 -> Creature -> Bool -isArmouredFrom p cr - = p /= _crPos cr - && any (\it -> it ^? itIdentity == Just FrontArmour) (_crInv cr) - && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2 --- even though angleVV can generate NaN, the comparison seems to deal with it diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs new file mode 100644 index 000000000..c3c1c0196 --- /dev/null +++ b/src/Dodge/Creature/Property.hs @@ -0,0 +1,20 @@ +module Dodge.Creature.Property + where +import Dodge.Data + +import Geometry + +import Control.Lens + +crIsArmouredFrom :: Point2 -> Creature -> Bool +crIsArmouredFrom p cr + = p /= _crPos cr + && any (\it -> it ^? itIdentity == Just FrontArmour) (_crInv cr) + && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2 +-- even though angleVV can generate NaN, the comparison seems to deal with it + +crOnSeg :: Point2 -> Point2 -> Creature -> Bool +crOnSeg p1 p2 cr = circOnLine p1 p2 (_crPos cr) (_crRad cr) + +crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool +crNearSeg d p1 p2 cr = circOnLine p1 p2 (_crPos cr) (_crRad cr + d) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 39ba76d6f..d9e44bfb2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -126,21 +126,25 @@ data TempLightSource = TLS } data Creature = Creature - { _crPos :: Point2 - , _crOldPos :: Point2 - , _crDir :: Float - , _crID :: Int - , _crPict :: Creature -> Picture - , _crUpdate :: World -> (World -> World,StdGen) -> Creature - -> ((World -> World,StdGen), Maybe Creature) - , _crRad :: Float - , _crMass :: Float - , _crHP :: Int - , _crMaxHP :: Int - , _crInv :: IM.IntMap Item - , _crInvSel :: Int - , _crState :: CreatureState - , _crCorpse :: Picture + { _crPos :: Point2 + , _crOldPos :: Point2 + , _crDir :: Float + , _crID :: Int + , _crPict :: Creature -> Picture + , _crUpdate + :: World + -> (World -> World,StdGen) + -> Creature + -> ((World -> World,StdGen), Maybe Creature) + , _crRad :: Float + , _crMass :: Float + , _crHP :: Int + , _crMaxHP :: Int + , _crInv :: IM.IntMap Item + , _crInvSel :: Int + , _crState :: CreatureState + , _crCorpse :: Picture + , _crIsAnimate :: Bool } data CreatureState = CrSt diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 10b2ed9c8..ba9092d69 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -64,6 +64,7 @@ defaultCreature = Creature , _crInvSel = 0 , _crState = defaultState , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10 + , _crIsAnimate = True } defaultState = CrSt { _goals = [] , _stance = Stance {_carriage=Walking 0 0,_posture=AtEase} diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 82b18ef2a..5e68943fc 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -6,7 +6,7 @@ import Dodge.WorldEvent import Dodge.SoundLogic import Dodge.RandomHelp -import Dodge.Creature.LookupStatus +import Dodge.Creature.Property import Geometry @@ -22,7 +22,7 @@ import Picture -- bullet effects bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World bulHitCr' bt p cr w - | isArmouredFrom p cr + | crIsArmouredFrom p cr = createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w | otherwise @@ -43,7 +43,7 @@ bulHitCr' bt p cr w bulBounceArmCr' :: Particle' -> Point2 -> Creature -> World -> World bulBounceArmCr' bt p cr w - | isArmouredFrom p cr + | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w | otherwise = addDamage . hitSound . flashEff $ w diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs index f5f27757d..c74bfd545 100644 --- a/src/Dodge/LevelGen/AutoDoor.hs +++ b/src/Dodge/LevelGen/AutoDoor.hs @@ -5,6 +5,8 @@ import Dodge.Data import Dodge.Base import Dodge.SoundLogic +import Dodge.Creature.Property + import Geometry import Picture @@ -24,7 +26,7 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is is = [i..] mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall] -mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr]) +mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane (pl,pr)) xs (lDoorClosed ++ rDoorClosed) (map shiftL lDoorClosed ++ map shiftR rDoorClosed) @@ -55,8 +57,8 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr]) | otherwise = dm w where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1 -autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall -autoDoorPane trigL n closedPos openPos = Door +autoDoorPane :: (Point2,Point2) -> Int -> [Point2] -> [Point2] -> Wall +autoDoorPane (trigx,trigy) n closedPos openPos = Door { _wlLine = closedPos , _wlID = n , _doorMech = dm @@ -66,24 +68,25 @@ autoDoorPane trigL n closedPos openPos = Door , _wlIsSeeThrough = False , _doorPathable = True } - where - a = closedPos !! 0 - b = closedPos !! 1 - dm w | crsNearLine 40 trigL w - = flip (foldr changeZonedWall) zoneps - $ over walls (IM.adjust openDoor n) w - | otherwise = flip (foldr changeZonedWall') zoneps - $ over walls (IM.adjust closeDoor n) w - mvP !ep !p = mvPointTowardAtSpeed 2 ep p - moveToward :: [Point2] -> Wall -> Wall - moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w - in deepseq newPs $ w {_wlLine = newPs} - --deepseq ps $ w & wlLine %~ zipWith mvP ps - openDoor = moveToward openPos - closeDoor = moveToward closedPos - zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b] - | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b - changeZonedWall (!x,!y) - = over wallsZone $ adjustIMZone openDoor x y n - changeZonedWall' (!x,!y) - = over wallsZone $ adjustIMZone closeDoor x y n + where + a = closedPos !! 0 + b = closedPos !! 1 + dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate) $ _creatures w +-- crsNearLine 40 trigL w + = flip (foldr changeZonedWall) zoneps + $ over walls (IM.adjust openDoor n) w + | otherwise = flip (foldr changeZonedWall') zoneps + $ over walls (IM.adjust closeDoor n) w + mvP !ep !p = mvPointTowardAtSpeed 2 ep p + moveToward :: [Point2] -> Wall -> Wall + moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w + in deepseq newPs $ w {_wlLine = newPs} + --deepseq ps $ w & wlLine %~ zipWith mvP ps + openDoor = moveToward openPos + closeDoor = moveToward closedPos + zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b] + | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b + changeZonedWall (!x,!y) + = over wallsZone $ adjustIMZone openDoor x y n + changeZonedWall' (!x,!y) + = over wallsZone $ adjustIMZone closeDoor x y n diff --git a/src/Geometry.hs b/src/Geometry.hs index d4df0464b..666cfab39 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -150,6 +150,7 @@ circOnLine' !p1 !p2 !c !rad = isJustTrue (fmap (\p -> magV (p -.- c) < rad) y) isJustTrue (Just True) = True isJustTrue _ = False +-- this should probably be circOnSeg circOnLine :: Point2 -> Point2 -> Point2 -> Float -> Bool circOnLine !p1 !p2 !c !rad = magV (p1 -.- c) <= rad || magV (p2 -.- c) <= rad || isJustTrue (fmap (\p -> magV (p -.- c) < rad) y)