Stop inanimate objects from opening walls

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

src/Dodge/Creature/LookupStatus.hs

@@ -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

@@ -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

@@ -126,21 +126,25 @@ data TempLightSource = TLS
     }
 
 data Creature = Creature
-    { _crPos :: Point2
+    { _crPos        :: Point2
-    , _crOldPos :: Point2
+    , _crOldPos     :: Point2
-    , _crDir :: Float
+    , _crDir        :: Float
-    , _crID :: Int
+    , _crID         :: Int
-    , _crPict :: Creature -> Picture
+    , _crPict       :: Creature -> Picture
-    , _crUpdate :: World -> (World -> World,StdGen) -> Creature 
+    , _crUpdate     
-                -> ((World -> World,StdGen), Maybe Creature)
+        :: World 
-    , _crRad :: Float
+        -> (World -> World,StdGen) 
-    , _crMass :: Float
+        -> Creature 
-    , _crHP :: Int
+        -> ((World -> World,StdGen), Maybe Creature)
-    , _crMaxHP :: Int
+    , _crRad        :: Float
-    , _crInv :: IM.IntMap Item
+    , _crMass       :: Float
-    , _crInvSel :: Int
+    , _crHP         :: Int
-    , _crState :: CreatureState
+    , _crMaxHP      :: Int
-    , _crCorpse :: Picture
+    , _crInv        :: IM.IntMap Item
+    , _crInvSel     :: Int
+    , _crState      :: CreatureState
+    , _crCorpse     :: Picture
+    , _crIsAnimate  :: Bool
     }
 
 data CreatureState = CrSt 

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}

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

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 :: (Point2,Point2) -> Int -> [Point2] -> [Point2] -> Wall
-autoDoorPane trigL n closedPos openPos = Door
+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 
+  where 
-        a = closedPos !! 0
+    a = closedPos !! 0
-        b = closedPos !! 1
+    b = closedPos !! 1
-        dm w | crsNearLine 40 trigL w 
+    dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate) $ _creatures w
-                         = flip (foldr changeZonedWall) zoneps
+--            crsNearLine 40 trigL w 
-                           $ over walls (IM.adjust openDoor n) w
+                     = flip (foldr changeZonedWall) zoneps
-             | otherwise = flip (foldr changeZonedWall') zoneps
+                       $ over walls (IM.adjust openDoor n) w
-                           $ over walls (IM.adjust closeDoor n) w
+         | otherwise = flip (foldr changeZonedWall') zoneps
-        mvP !ep !p = mvPointTowardAtSpeed 2 ep p
+                       $ over walls (IM.adjust closeDoor n) w
-        moveToward :: [Point2] -> Wall -> Wall
+    mvP !ep !p = mvPointTowardAtSpeed 2 ep p
-        moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
+    moveToward :: [Point2] -> Wall -> Wall
-                           in  deepseq newPs $ w {_wlLine = newPs}
+    moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
-                            --deepseq ps $ w & wlLine %~ zipWith mvP ps
+                       in  deepseq newPs $ w {_wlLine = newPs}
-        openDoor = moveToward openPos
+                        --deepseq ps $ w & wlLine %~ zipWith mvP ps
-        closeDoor = moveToward closedPos
+    openDoor = moveToward openPos
-        zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
+    closeDoor = moveToward closedPos
-               | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
+    zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
-        changeZonedWall (!x,!y) 
+           | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
-              = over wallsZone $ adjustIMZone openDoor x y n
+    changeZonedWall (!x,!y) 
-        changeZonedWall' (!x,!y) 
+          = over wallsZone $ adjustIMZone openDoor x y n
-              = over wallsZone $ adjustIMZone closeDoor x y n
+    changeZonedWall' (!x,!y) 
+          = over wallsZone $ adjustIMZone closeDoor x y n

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)