Refactoring, add screen when generating level

src/Dodge/LevelGen.hs

@@ -88,8 +88,8 @@ placeSpot ps w = case ps of
     PS {_psPos = p, _psRot = rot, _psType = PutLineBlock wl width depth a b}
         -> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
 
-    PS {_psPos = p, _psRot = rot, _psType = PutWindow { _pwPoly = ps, _pwColor = c }}
-        -> rmCrossPaths $ over walls (addWindow (q:qs) c) w
+    PS {_psPos = p, _psRot = rot, _psType = PutWall { _pwPoly = ps, _pwWall = wl }}
+        -> rmCrossPaths $ over walls (addWalls (q:qs) wl) w
                 where (q:qs) = map (shiftPointBy (p,rot)) ps
                       rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q])
 
@@ -119,18 +119,17 @@ instance Shiftable PlacementSpot where
 
 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
 
-addWindow :: [Point2] -> Color -> IM.IntMap Wall -> IM.IntMap Wall
-addWindow qs c wls = foldr (addPane c) wls pairs
-    where (p:ps) = orderPolygon qs
-          pairs = zip (ps ++ [p]) (p:ps)
-addPane :: Color -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall
-addPane c (p0,p1) wls = IM.insert (newKey wls) (Wall { _wlLine = [p0,p1]
-                                                     , _wlID = newKey wls
-                                                     , _wlColor = c
-                                                     , _wlSeen = False 
-                                                     , _wlIsSeeThrough = True
-                                                     }
-                                               ) wls
+addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
+addWalls qs wl wls = foldr (addPane wl) wls pairs
+  where 
+    (p:ps) = orderPolygon qs
+    pairs = zip (ps ++ [p]) (p:ps)
+addPane :: Wall -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall
+addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
+    { _wlLine = [p0,p1]
+    , _wlID = newKey wls
+    })
+    wls
 
 
 placeBt bt p rot w = over buttons addBT w