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

Stop inanimate objects from opening walls

Browse Source
This commit is contained in:
jgk
2021-03-29 13:36:03 +02:00
parent 502832b2b8
commit a4afe05478
8 changed files with 76 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Inanimate.hs
+5 -3
View File
@@ -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
src/Dodge/Creature/LookupStatus.hs
-14
View File
@@ -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
src/Dodge/Creature/Property.hs
+20
View File
@@ -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)
src/Dodge/Data.hs
+19 -15
View File
@@ -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
src/Dodge/Default.hs
+1
View File
@@ -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}
src/Dodge/Item/Weapon/Bullet.hs
+3 -3
View File
@@ -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
src/Dodge/LevelGen/AutoDoor.hs
+27 -24
View File
@@ -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
src/Geometry.hs
+1
View File
@@ -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)