Continue placement refactor

src/Dodge/Room/Data.hs

@@ -1,17 +1,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Room.Data
-    ( Room (..)
-    , rmPolys
-    , rmLinks
-    , rmPath
-    , rmPS
-    , rmBound
-    , rmFloor
-    , rmName
-    ) where
+    where
 import Dodge.LevelGen.Data
---import Geometry
 import Geometry.Data
 import Data.Tile
 
@@ -33,5 +24,6 @@ data Room = Room
     , _rmBound  :: [ [Point2] ]
     , _rmFloor  :: [Tile]
     , _rmName   :: String
+    , _rmShift  :: (Point2, Float)
     }
 makeLenses ''Room

src/Dodge/Room/Link.hs

@@ -63,14 +63,14 @@ shiftRoomToLink l r
     r
   where 
     (p,a) = last $ _rmLinks r
-
+-- NOTE placements are shifted by the room shift
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
     & rmPolys %~ fmap (map (shiftPointBy shift))
     & rmLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathPointBy shift)
-    & rmPS    %~ fmap (shiftPSBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
+    & rmShift %~ shiftLinkBy shift
     & rmFloor %~ map 
         ( (tilePoly %~ map (shiftPointBy shift))
         . (tileZero %~ shiftPointBy shift    )

src/Dodge/Room/LongDoor.hs

@@ -24,7 +24,7 @@ import Control.Lens
 import Control.Monad.State
 import Data.Tree
 import qualified Data.Map as M
-import qualified Data.IntMap as IM
+--import qualified Data.IntMap as IM
 
 twinSlowDoorRoom 
     :: Int      -- ^ Door id
@@ -56,7 +56,7 @@ twinSlowDoorRoom drid w h x = defaultRoom
     , _rmName   = "twinSlowDoorRoom"
     }
   where
-    drmoving w' = True -- DoorHalfway == _drStatus (_doors w' IM.! drid)
+    drmoving _ = True -- DoorHalfway == _drStatus (_doors w' IM.! drid)
     lampHeight = 41
     ps = 
         [rectNSWE h    0 (-w) w

src/Dodge/Room/Placement.hs

@@ -30,33 +30,33 @@ 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 = SimplePlacement $ PS
+blockLine a b = Placement PS
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutLineBlock baseBlockPane 9 9 a b
-    }
+    } (const Nothing)
 
 {-
 Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a b = SimplePlacement $ PS 
+windowLine a b = Placement PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutLineBlock baseWindowPane 8 8 a b
-    }
+    } (const Nothing)
 
 {-
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
 crystalLine :: Point2 -> Point2 -> Placement
-crystalLine a b = SimplePlacement $ PS 
+crystalLine a b = Placement PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutWall ps defaultCrystalWall
-    }
+    } (const Nothing)
   where
     ps = 
         [ a +.+ left +.+ up
@@ -70,11 +70,11 @@ crystalLine a b = SimplePlacement $ PS
 Depth 15, does not extend wider than points.
  -}
 wallLine :: Point2 -> Point2 -> Placement
-wallLine a b = SimplePlacement $ PS 
+wallLine a b = Placement PS 
     { _psPos    = V2 0 0
     , _psRot    = 0
     , _psType   = PutWall ps defaultWall
-    }
+    } (const Nothing)
   where
     ps = 
         [ a  +.+ up

src/Dodge/Room/Procedural.hs

@@ -180,7 +180,7 @@ fillNothingPlacement :: PSType -> Room -> Room
 fillNothingPlacement pst r =
     r & rmPS %~ replaceNothingWith pst
   where
-    replaceNothingWith x (SimplePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss
+    replaceNothingWith x (Placement (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.