Continue to refactor zoning to be more stream-based

src/Dodge/Room/Procedural.hs

@@ -49,7 +49,7 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmName  = "rect"
-    , _rmPath  = concatMap doublePair pth
+    , _rmPath  = foldMap doublePairSet pth
     --, _rmPos   = map (roomposat (RoomPosOnPath S.empty)) posps
     --    ++ map (roomposat (RoomPosOffPath S.empty)) interposps
     , _rmPos   = map makeonpos posps'
@@ -86,7 +86,7 @@ roomRect x y xn yn = defaultRoom
         ++ m South (FromEdge West) (FromEdge East) slnks
     m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
         . zipCountDown
-    pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
+    pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
     makeonpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a) NotLink 0
     makerpedges (a,b) = S.fromList 
         [PathFromEdge South b
@@ -131,7 +131,7 @@ combineRooms :: Room -> Room -> Room
 combineRooms r r' = defaultRoom
     { _rmPolys  = _rmPolys r ++ _rmPolys r'
     , _rmLinks  = _rmLinks r ++ _rmLinks r'
-    , _rmPath   = map clampPath $ _rmPath  r ++ _rmPath  r'
+    , _rmPath   = S.map clampPath $ _rmPath  r <> _rmPath  r'
     , _rmPmnts  = _rmPmnts r ++ _rmPmnts r'
     , _rmBound  = _rmBound r ++ _rmBound r'
     , _rmPos    = _rmPos r ++ _rmPos r'
@@ -163,7 +163,7 @@ quarterRoomTri w = do
     pure $ defaultRoom
         { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
         , _rmLinks  = [toBothLnk (V2 0 w, 0)]
-        , _rmPath   = concatMap doublePair
+        , _rmPath   = foldMap doublePairSet
             [(V2 0 w,V2 0 (w-20))
             ,(V2 0 (w-20),V2 (w-20) (w-20))
             ,(V2 0 (w-20),V2 (55-w) (w-20))
@@ -199,7 +199,7 @@ quarterRoomSquare w = do
             [ (V2 (w/2) (3*w/2), negate $ pi/4)
             , (V2 (negate $ w/2) (3*w/2), pi/4)
             ]
-        , _rmPath   = concatMap doublePair
+        , _rmPath   = foldMap doublePairSet
             [(V2 (0.5*w) (1.5*w),V2 (0.5*w-20) (1.5*w-20))
             ,(V2 (-0.5*w) (1.5*w),V2 (-0.5*w+20) (1.5*w-20))
             ,(V2 0 (2*w-40),V2 (-0.5*w+20) (1.5*w-20))
@@ -249,7 +249,7 @@ centerVaultRoom w h d = return $ defaultRoom
         ,outLink (V2 w    0) (-pi/2)
         ,outLink (V2 (-w) 0) (pi/2) 
         , inLink (V2 0   (-h)) pi ]
-    , _rmPath   = []
+    , _rmPath   = mempty
     , _rmPmnts     = 
         [sps0 $ PutWall (reverse $ rectNSWE   d  (d - 30) (d - 30)   d ) defaultWall
         ,sps0 $ PutWall (reverse $ rectNSWE   d  (d - 30) (30 - d) (-d)) defaultWall