Commit before placement refactor

src/Dodge/Room/LongDoor.hs

@@ -24,6 +24,7 @@ import Control.Lens
 import Control.Monad.State
 import Data.Tree
 import qualified Data.Map as M
+import qualified Data.IntMap as IM
 
 twinSlowDoorRoom 
     :: Int      -- ^ Door id
@@ -49,12 +50,13 @@ twinSlowDoorRoom drid w h x = defaultRoom
             (worldState %~ M.insert (DoorNumOpen drid) True )
             (worldState %~ M.insert (DoorNumOpen drid) False)
         , sPS (V2 0 (h-1)) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight)
-        , sPS (V2 0 (h-1)) 0 $ PutProp $ lampCover lampHeight
+        , sPS (V2 0 (h-1)) 0 $ PutProp $ lampCoverWhen drmoving lampHeight
         ]
     , _rmBound  = ps
     , _rmName   = "twinSlowDoorRoom"
     }
   where
+    drmoving w' = True -- DoorHalfway == _drStatus (_doors w' IM.! drid)
     lampHeight = 41
     ps = 
         [rectNSWE h    0 (-w) w

src/Dodge/Room/Placement.hs

@@ -30,7 +30,7 @@ Places a line of blocks between two points.
 Width 9, also extends out from each point by 9.
  -}
 blockLine :: Point2 -> Point2 -> Placement
-blockLine a b = SinglePlacement $ PS
+blockLine a b = SimplePlacement $ PS
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutLineBlock baseBlockPane 9 9 a b
@@ -41,7 +41,7 @@ Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a b = SinglePlacement $ PS 
+windowLine a b = SimplePlacement $ PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutLineBlock baseWindowPane 8 8 a b
@@ -52,7 +52,7 @@ Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
 crystalLine :: Point2 -> Point2 -> Placement
-crystalLine a b = SinglePlacement $ PS 
+crystalLine a b = SimplePlacement $ PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutWall ps defaultCrystalWall
@@ -70,7 +70,7 @@ crystalLine a b = SinglePlacement $ PS
 Depth 15, does not extend wider than points.
  -}
 wallLine :: Point2 -> Point2 -> Placement
-wallLine a b = SinglePlacement $ PS 
+wallLine a b = SimplePlacement $ PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutWall ps defaultWall

src/Dodge/Room/Procedural.hs

@@ -180,7 +180,7 @@ fillNothingPlacement :: PSType -> Room -> Room
 fillNothingPlacement pst r =
     r & rmPS %~ replaceNothingWith pst
   where
-    replaceNothingWith x (SinglePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss
+    replaceNothingWith x (SimplePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss
     replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
     replaceNothingWith _ [] = []
 {- | Successively fill 'PutNothing' placements with a list of given 'PSType's.