Add support for group placements

src/Dodge/Room/Placement.hs

@@ -15,15 +15,15 @@ import Control.Lens
 
 putLamp = PutCrit lamp
 
-singleBlock :: Point2 -> [PlacementSpot]
-singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
+singleBlock :: Point2 -> [Placement]
+singleBlock a = [sPS a 0 $ PutBlock [5,20,20] (greyN 0.5)
                                         $ reverse $ rectNSWE 10 (-10) (-10) 10]
 {-
 Places a line of blocks between two points.
 Width 9, also extends out from each point by 9.
  -}
-blockLine :: Point2 -> Point2 -> PlacementSpot
-blockLine a b = PS
+blockLine :: Point2 -> Point2 -> Placement
+blockLine a b = SinglePlacement $ PS
     { _psPos    = (0,0)
     , _psRot    = 0
     , _psType   = PutLineBlock baseBlockPane 9 9 a b
@@ -33,8 +33,8 @@ blockLine a b = PS
 Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
-windowLine :: Point2 -> Point2 -> PlacementSpot
-windowLine a b = PS 
+windowLine :: Point2 -> Point2 -> Placement
+windowLine a b = SinglePlacement $ PS 
     { _psPos    = (0,0)
     , _psRot    = 0
     , _psType   = PutLineBlock baseWindowPane 8 8 a b
@@ -44,8 +44,8 @@ windowLine a b = PS
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
-crystalLine :: Point2 -> Point2 -> PlacementSpot
-crystalLine a b = PS 
+crystalLine :: Point2 -> Point2 -> Placement
+crystalLine a b = SinglePlacement $ PS 
     { _psPos    = (0,0)
     , _psRot    = 0
     , _psType   = PutWall ps defaultCrystalWall
@@ -62,8 +62,8 @@ crystalLine a b = PS
 {- Places an unbreakable wall between two points.
 Depth 15, does not extend wider than points.
  -}
-wallLine :: Point2 -> Point2 -> PlacementSpot
-wallLine a b = PS 
+wallLine :: Point2 -> Point2 -> Placement
+wallLine a b = SinglePlacement $ PS 
     { _psPos    = (0,0)
     , _psRot    = 0
     , _psType   = PutWall ps defaultWall
@@ -114,7 +114,7 @@ replacePutID
     -> Room 
     -> Room
 replacePutID i psts r =
-    r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
+    r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & placementSpot . psType .~ pt)) psts
 {- Partition a list by a predicate, apply a zip to those elements 
 that satisfy the predicate, concatenate 
 the new zipped list and the other (unchanged) half.  -}
@@ -128,7 +128,7 @@ subZipWith f g xs ys =
     let (zs,ws) = partition f xs
     in  zipWith g zs ys ++ ws
 
-isPutID i ps = Just i == ps ^? psType . putID
+isPutID i ps = Just i == ps ^? placementSpot . psType . putID
 
 putBlockRect a x b y =  [ blockLine (a,b) (a,y)
                         , blockLine (a,y) (x,y)