Simplify doors somewhat, unsure what to do about edge obstacles

src/Dodge/Block/Debris.hs

@@ -7,6 +7,7 @@ module Dodge.Block.Debris (
     makeDebrisDirected,
 ) where
 
+import qualified Data.IntMap.Strict as IM
 import Dodge.ShiftPoint
 import Color
 import Data.Foldable
@@ -28,8 +29,8 @@ makeDoorDebris dr w = w & makeDebris mt col p
     p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
     p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
     (mt, col) = fromMaybe (Stone, greyN 0.5) $ do
-        wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drWallIDs
-        (wlid, _) <- IS.minView wlids
+        wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
+        ((wlid,_),_) <- IM.minViewWithKey wlids 
         wl <- w ^? cWorld . lWorld . walls . ix wlid
         return (_wlMaterial wl, _wlColor wl)
 

src/Dodge/Data/Door.hs

@@ -11,7 +11,6 @@ module Dodge.Data.Door (
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import qualified Data.IntSet as IS
 import Dodge.Data.MountedObject
 import Dodge.Data.PathGraph
 import Dodge.Data.WorldEffect
@@ -29,7 +28,6 @@ data PushSource
 
 data Door = Door
     { _drID :: Int
-    , _drWallIDs :: IS.IntSet
     , _drTrigger :: WdBl
     , _drMech :: DrWdWd
     , _drZeroPos :: (Point2,Float)
@@ -41,8 +39,6 @@ data Door = Door
     , _drPushedBy :: PushSource
     , _drPushes :: Maybe Int
     , _drMounts :: [MountedObject]
---    , _drObstructs :: [(Int,Int)]
-    , _drObstacleType :: EdgeObstacle
     }
 
 makeLenses ''Door

src/Dodge/Default/Door.hs

@@ -30,7 +30,7 @@ defaultDoor :: Door
 defaultDoor =
     Door
         { _drID = 0
-        , _drWallIDs = mempty
+--        , _drWallIDs = mempty
 --        , _drStatus = DoorClosed
         , _drTrigger = WdBlConst False
         , _drMech = DrWdId
@@ -46,6 +46,4 @@ defaultDoor =
         , _drPushedBy = PushesItself
         , _drPushes = Nothing
         , _drMounts = mempty
---        , _drObstructs = mempty
-        , _drObstacleType = DoorObstacle
         }

src/Dodge/DrWdWd.hs

@@ -26,7 +26,7 @@ updateDoor dr w
 doorLerp :: Door -> World -> (S.Set Int2,World)
 doorLerp dr w = fromMaybe (mempty,w) $ do
     x <- newlerp
-    let ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
+    let ps = wlposs x
         is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
     -- it seems possible that this will miss some paths: we add zones for the
     -- old footprint. Seems unlikely, but a possible cause of pathfinding bugs
@@ -36,8 +36,7 @@ doorLerp dr w = fromMaybe (mempty,w) $ do
             & cWorld . lWorld . doors . ix drid . drLerp .~ x)
   where
     f = ifoldl' (flip . moveWallID) w . wlposs
-    p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos)
-    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
+    wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr x)
     clerp = dr ^. drLerp
     newlerp
         | toOpen && clerp < 1 = Just . min 1 $ clerp + speed
@@ -48,9 +47,12 @@ doorLerp dr w = fromMaybe (mempty,w) $ do
     drid = _drID dr
     playSound x
         | _drPushedBy dr == PushesItself =
-            soundContinue (WallSound drid) (fst $ p2a x) slideDoorS (Just 1)
+            soundContinue (WallSound drid) (fst $ doDoorLerp dr x) slideDoorS (Just 1)
         | otherwise = id
 
+doDoorLerp :: Door -> Float -> Point2A
+doDoorLerp dr = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos)
+
 destroyDoor :: Door -> World -> (S.Set Int2, World)
 destroyDoor dr w =
     (is,w
@@ -62,14 +64,9 @@ destroyDoor dr w =
         & stopPushing (_drPushes dr)
         & destroyMounts (_drMounts dr))
   where
-    p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
-    ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
     is = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) ps
-    wlids = _drWallIDs dr
-    --awl = _walls (_cWorld w) IM.! IS.findMin wlids
---    awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
---    pos = fst . _wlLine $ awl
---    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
+    ps = (dr ^. drFootPrint) & each . each %~ shiftPointBy (doDoorLerp dr (dr ^. drLerp))
+    wlids = IM.keysSet $ _drFootPrint dr
 
 destroyMounts :: [MountedObject] -> World -> World
 destroyMounts mos w = foldl' (flip destroyMount) w mos

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -7,7 +7,6 @@ module Dodge.Placement.PlaceSpot.TriggerDoor (
 import Dodge.ShiftPoint
 import Linear
 import Dodge.Data.GenWorld
-import qualified Data.IntSet as IS
 import Data.List
 import Dodge.Default.Door
 import Dodge.LevelGen.DoorPane
@@ -36,14 +35,13 @@ plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cW
         IM.insert drid $
             defaultDoor
                 { _drID = drid
-                , _drWallIDs = IS.fromList wlids
+--                , _drWallIDs = IS.fromList wlids
                 , _drTrigger = cond
                 , _drMech = DoorLerp
                 , _drZeroPos = p1
                 , _drOnePos = p2
                 , _drLerp = 0
                 , _drFootPrint = IM.fromList . zip wlids $ wlps'
-                , _drObstacleType = eo
                 , _drSpeed = 0.01
                 }
 --    nsteps = length pss - 1
@@ -96,13 +94,12 @@ plSlideDoor dr wl eo shiftOffset a b gw =
         IM.insert drid $
             dr
                 { _drID = drid
-                , _drWallIDs = IS.fromList wlids
+--                , _drWallIDs = IS.fromList wlids
                 , _drMech = DoorLerp
                 , _drZeroPos = (a, 0)
                 , _drOnePos = (shiftLeft a, 0)
                 , _drLerp = 0
                 , _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b-a)
-                , _drObstacleType = eo
                 , _drSpeed = 1 / distance a (shiftLeft a)
                 }
     addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs

src/Dodge/Wall/Zone.hs

@@ -22,4 +22,3 @@ insertWallInZones = over wlZoning . zoneWall
 
 deleteWallFromZones :: Wall -> World -> World
 deleteWallFromZones = over wlZoning . deZoneWall
-