Start cleanup of room in-links

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -1,7 +1,7 @@
 --{-# LANGUAGE BangPatterns #-}
 module Dodge.Placement.PlaceSpot.TriggerDoor
-    ( placeDoor
-    , placeSlideDoor
+    ( plDoor
+    , plSlideDoor
     ) where
 import Dodge.Data
 import Dodge.Default.Wall
@@ -17,14 +17,13 @@ import Data.List
 import Control.Lens
 --import Data.Graph.Inductive hiding ((&))
 import qualified Data.IntSet as IS
-placeDoor 
-    :: Color 
+plDoor :: Color 
     -> (World -> Bool)      -- ^ Opening condition
     -> [(Point2,Point2)]   -- ^ Door positions, closed to open.
                     -- Bumped out up and down by 9, not widened
     -> GenWorld 
     -> (Int,GenWorld)
-placeDoor col cond pss gw = (drid, gw & gWorld  .~ (addWalls w & doors %~ addDoor))
+plDoor col cond pss gw = (drid, gw & gWorld  .~ (addWalls w & doors %~ addDoor))
   where
     w = _gWorld gw
     drid = IM.newKey $ _doors w
@@ -38,27 +37,29 @@ placeDoor col cond pss gw = (drid, gw & gWorld  .~ (addWalls w & doors %~ addDoo
     nsteps = length pss - 1
     wlids = take 4 [IM.newKey $ _walls w ..]
     wlps' = uncurry (rectanglePairs 9) $ head pss
-    addWalls w' = foldl' addWall w' $ zip wlids wlps'
-    addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
-        { _wlLine = wlps
-        , _wlID = wlid
-        , _wlColor = col
-        , _wlSeen = False
-        , _wlOpacity = Opaque
-        , _wlPathable = False
-        }
+    addWalls w' = foldl' (addDoorWall col False) w' $ zip wlids wlps'
+
+addDoorWall :: Color -> Bool -> World -> (Int,(Point2,Point2)) -> World
+addDoorWall col pathableStatus w (wlid,wlps) = w & walls %~ IM.insert wlid defaultWall
+    { _wlLine = wlps
+    , _wlID = wlid
+    , _wlColor = col
+    , _wlSeen = False
+    , _wlOpacity = Opaque
+    , _wlPathable = pathableStatus
+    }
 -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
 -- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
 doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World
 doorMechanismStepwise nsteps drid wlids pss dr w 
     | toOpen = case _drStatus dr of
         DoorInt x | x == nsteps -> w
-        DoorInt x      -> setWalls (x+1)
-        _ -> w
+        DoorInt x               -> setWalls (x+1)
+        _                       -> w
     | otherwise = case _drStatus dr of
         DoorInt 0 -> w
         DoorInt x -> setWalls (x-1)
-        _ -> w
+        _         -> w
   where
     playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
     toOpen = _drTrigger dr w
@@ -88,9 +89,9 @@ doorMechanism drid speed wlidOpCps dr w
     doClose w' (wlid,_ ,clp) = moveWallIDToward wlid speed clp w'
 
 -- TODO cut pathing if not pathable, reset when opened
-placeSlideDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> GenWorld
+plSlideDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> GenWorld
     -> (Int, GenWorld)
-placeSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
+plSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
   where
     w = _gWorld gw
     drid = IM.newKey $ _doors w
@@ -101,15 +102,7 @@ placeSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWall
         , _drTrigger = cond
         , _drMech   = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
         }
-    addWalls w' = foldl' addWall w' $ zip wlids pairs
-    addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
-        { _wlLine = wlps
-        , _wlID = wlid
-        , _wlColor = col
-        , _wlSeen       = False
-        , _wlOpacity    = Opaque
-        , _wlPathable   = isPathable
-        }
+    addWalls w' = foldl' (addDoorWall col isPathable) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b
     shiftedPairs = map (bimap shiftLeft shiftLeft) pairs
     shiftLeft  = (+.+ (a -.- b +.+ normalizeV (b -.- a)))