Stop gibbed/pitted creatures from opening doors

src/Dodge/Base/Collide.hs

@@ -106,7 +106,8 @@ collide3Chasms sp w m =
     foldl'
         (flip (collide3Chasm sp))
         m
-        (foldMap loopPairs $ w ^. cWorld . chasms)
+        --(foldMap loopPairs $ w ^. cWorld . chasms)
+        (w ^. cWorld . cliffs)
 
 collide3Chasm :: Point3 -> (Point2, Point2) -> (Point3, MPO) -> (Point3, MPO)
 collide3Chasm sp ab (ep, m) =

src/Dodge/Creature/Test.hs

@@ -22,6 +22,7 @@ module Dodge.Creature.Test (
     crHasTarget,
     crStratConMatches,
     crSafeDistFromTarg,
+    hasAutoDoorBody,
 ) where
 
 import Linear
@@ -136,3 +137,11 @@ isAnimate :: Creature -> Bool
 isAnimate cr = case _crActionPlan cr of
     Inanimate -> False
     _ -> True
+
+hasAutoDoorBody :: Creature -> Bool
+hasAutoDoorBody cr = case cr ^. crHP of
+    HP {} -> True
+    CrIsCorpse {} -> True
+    CrIsGibs -> False
+    CrIsPitted -> False
+    

src/Dodge/CreatureEffect.hs

@@ -34,6 +34,7 @@ doCrBl cb = case cb of
     CrCanShoot -> error "got rid of crCanShoot"
     CrIsAiming -> crIsAiming
     CrIsAnimate -> isAnimate
+    CrOpenAutoDoor -> \cr -> isAnimate cr && hasAutoDoorBody cr
 
 doCrAc :: CrAc -> Creature -> Action
 doCrAc ca = case ca of

src/Dodge/Data/CreatureEffect.hs

@@ -18,6 +18,7 @@ data WdCrBl
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CrBl = CrCanShoot | CrIsAiming | CrIsAnimate
+    | CrOpenAutoDoor
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data CrAc = CrTurnAround

src/Dodge/Placement/Instance/Door.hs

@@ -93,7 +93,7 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
              in Just $
                     putDoubleDoor
                         defaultAutoWall
-                        (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
+                        (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
                         a
                         b
                         3

src/Geometry/Polygon.hs

@@ -159,25 +159,12 @@ convexHull _ = error "Tried to create the convex hull of two or fewer points"
 --    | otherwise = convexPartition (y:z:xs <> [x])
 --convexPartition _ = error "unexpected shape for convexPartition"
 
--- monotone means that all lines orthogonal to the first vector 
--- must only intersect the polygon at most once
-partitionMonotonePoly :: Point2 -> [Point2] -> [[Point2]]
-partitionMonotonePoly v ps =  [qs]
-  where
-    qs = sortOn (dot v) ps
-
-monotonePolyChains :: Point2 -> [Point2] -> ([Point2],[Point2])
-monotonePolyChains v ps = undefined
-
-earClip :: [Point2] -> [[Point2]]
-earClip (x:y:z:[]) = [(x:y:z:[])]
-earClip (x:y:z:xs)
-    | isLHS x y z && not (any (`pointInPoly` (x:y:z:[])) xs) = (x:y:z:[]) : earClip (x:z:xs)
-    | otherwise = earClip (y:z:xs ++ [x])
-earClip _ = error "earClip: non-simple polygon input?"
-
-fusePolys :: [Point2] -> [Point2] -> [Point2]
-fusePolys xs ys = xs
+triangulateEarClip :: [Point2] -> [[Point2]]
+triangulateEarClip (x:y:z:[]) = [(x:y:z:[])]
+triangulateEarClip (x:y:z:xs)
+    | isLHS x y z && not (any (`pointInPoly` (x:y:z:[])) xs) = (x:y:z:[]) : triangulateEarClip (x:z:xs)
+    | otherwise = triangulateEarClip (y:z:xs ++ [x])
+triangulateEarClip _ = error "triangulateEarClip: non-simple polygon input?"
 
 {- | Creates the convex hull of a set of points.
  assumes no repetition of points: try nubbing!