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

@@ -131,7 +131,10 @@ data Creature = Creature
     , _crDir        :: Float
     , _crID         :: Int
     , _crPict       :: Creature -> Picture
-    , _crUpdate :: World -> (World -> World,StdGen) -> Creature 
+    , _crUpdate     
+        :: World 
+        -> (World -> World,StdGen) 
+        -> Creature 
         -> ((World -> World,StdGen), Maybe Creature)
     , _crRad        :: Float
     , _crMass       :: Float
@@ -141,6 +144,7 @@ data Creature = Creature
     , _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
@@ -69,7 +71,8 @@ autoDoorPane trigL n closedPos openPos = Door
   where 
     a = closedPos !! 0
     b = closedPos !! 1
-        dm w | crsNearLine 40 trigL w 
+    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

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)