Refactoring, add screen when generating level

src/Dodge/Room/Placement.hs

@@ -2,6 +2,7 @@
 module Dodge.Room.Placement
   where
 import Dodge.Data
+import Dodge.Default
 import Dodge.LevelGen.Data
 import Dodge.Room.Data
 import Dodge.Creature.Inanimate
@@ -47,7 +48,7 @@ crystalLine :: Point2 -> Point2 -> PlacementSpot
 crystalLine a b = PS 
     { _psPos    = (0,0)
     , _psRot    = 0
-    , _psType   = PutWindow ps $ withAlpha 0.5 aquamarine
+    , _psType   = PutWall ps defaultCrystalWall
     }
   where
     ps = 
@@ -58,6 +59,24 @@ crystalLine a b = PS
         ]
     left = 7 *.* normalizeV (a-.-b)
     up   = vNormal left
+{- Places an unbreakable wall between two points.
+Depth 15, does not extend wider than points.
+ -}
+wallLine :: Point2 -> Point2 -> PlacementSpot
+wallLine a b = PS 
+    { _psPos    = (0,0)
+    , _psRot    = 0
+    , _psType   = PutWall ps defaultWall
+    }
+  where
+    ps = 
+        [ a  +.+ up
+        , a  -.- up
+        , b  -.- up
+        , b  +.+ up
+        ]
+    left = 15 *.* normalizeV (a-.-b)
+    up   = vNormal left
 
 windowLineType :: Point2 -> Point2 -> PSType
 windowLineType = PutLineBlock baseWindowPane 8 8
@@ -88,10 +107,7 @@ baseWindowPane = Block
     , _blShadows = []
     , _blDegrades = [5,5]
     }
-
-{-
-Replaces instances of a given 'PutID' with 'PSType's drawn from a list.
--}
+{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list.  -}
 replacePutID 
     :: Int      -- ^ The id of 'PutID' to be replaced
     -> [PSType] -- ^ List of replacements
@@ -99,12 +115,9 @@ replacePutID
     -> Room
 replacePutID i psts r =
     r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
-
-{-
-Partition a list by a predicate, apply a zip to those elements 
+{- 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.
--}
+the new zipped list and the other (unchanged) half.  -}
 subZipWith 
     :: (a -> Bool)      -- ^ Filter: elements to apply zip to
     -> (a -> b -> a)    -- ^ Combining function
@@ -116,3 +129,20 @@ subZipWith f g xs ys =
     in  zipWith g zs ys ++ ws
 
 isPutID i ps = Just i == ps ^? psType . putID
+
+putBlockRect a x b y =  [ blockLine (a,b) (a,y)
+                        , blockLine (a,y) (x,y)
+                        , blockLine (x,y) (x,b)
+                        , blockLine (x,b) (a,b)
+                        ]
+putBlockV a x b y = [ blockLine (a,b) (a,y)
+                    , blockLine (x,b) (a,b)
+                    ]
+putBlockC a x b y = [ blockLine (a,b) (a,y)
+                    , blockLine (x,b) (a,b)
+                    , blockLine (a,y) (x,y)
+                    ]
+putBlockN a x b y = [ blockLine (a,b) (a,y)
+                    , blockLine (x,b) (a,b)
+                    , blockLine (x,y) (x,b)
+                    ]