Commit before generalising picture transformation to alternative

src/Dodge/Layout.hs

@@ -26,6 +26,7 @@ import System.Random
 import Data.Tree
 import Data.Graph.Inductive.Graph (labNodes)
 import qualified Data.Map as M
+import Data.Foldable
 
 generateLevelFromRoomList :: State StdGen [Room] -> World -> World
 generateLevelFromRoomList gr w = updateWallZoning 
@@ -48,7 +49,7 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
    $ w  {_walls         = wallsFromTree tr
         ,_pathGraph     = path
         ,_pathGraph'    = pairGraph
-        ,_pathPoints    = foldr insertPoint IM.empty (labNodes path) 
+        ,_pathPoints    = foldl' (flip insertPoint) IM.empty (labNodes path) 
         ,_pathInc       = pinc
         }
   where 
@@ -60,7 +61,7 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
     pinc = M.fromList $ pairsToIncidence pairGraph
 
 initializeStaticWalls :: World -> World
-initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldr wallToWall wls' wls)
+initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldl' (flip wallToWall) wls' wls)
     & walls %~ IM.filter (not . wlIsWall)
   where
     wls = [wl | wl@Wall{} <- (IM.elems $ _walls w)]
@@ -68,18 +69,18 @@ initializeStaticWalls w = w & staticWalls %~ (\wls' -> foldr wallToWall wls' wls
     wlIsWall _ = False
 
 wallToWall :: Wall -> IM.IntMap (IM.IntMap [Wall']) -> IM.IntMap (IM.IntMap [Wall'])
-wallToWall wl wls = foldr f wls is
+wallToWall wl wls = foldl' (flip f) wls is
   where
     is = uncurry zoneOfLine (_wlLine wl)
     wl' = Wall' {_wlLine' = _wlLine wl, _wlColor' = _wlColor wl}
     f (x,y) = insertInZoneWith x y (++) [wl']
 
 updateWallZoning :: World -> World
-updateWallZoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w)) w
+updateWallZoning w = set wallsZone (foldl' (flip wallInZone) IM.empty (_walls w)) w
   where
     wallInZone wl 
         | uncurry dist (_wlLine wl) <= 2*zoneSize = insertIMInZone x y wlid wl
-        | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
+        | otherwise = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b wlid wl)) ips
       where 
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
@@ -96,7 +97,7 @@ wallsFromTree t =
     divideWalls 
     . assignKeys 
     . removeInverseWalls
-    . foldr cutWalls [] -- map (map (g . roundPoint2)) 
+    . foldl' (flip cutWalls) [] -- map (map (g . roundPoint2)) 
 --    . map (map roundPoint2)
     $ concatMap _rmPolys (flatten t)
   where
@@ -107,7 +108,7 @@ wallsFromRooms :: [Room] -> IM.IntMap Wall
 wallsFromRooms =
 --    divideWalls .
     IM.fromList . zip [0..] . zipWith f [0..] . removeInverseWalls 
-        . foldr cutWalls [] . concatMap _rmPolys
+        . foldl' (flip cutWalls) [] . concatMap _rmPolys
   where
     f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
 
@@ -125,10 +126,10 @@ divideWallIn wl wls =
     let (wl':newWls) = divideWall wl
         k = IM.newKey wls
         newWls' = zipWith (\i w -> w {_wlID = i}) [k..] newWls
-    in  foldr (\w -> IM.insert (_wlID w) w) wls (wl':newWls')
+    in  foldl' (flip $ \w -> IM.insert (_wlID w) w) wls (wl':newWls')
 
 divideWalls :: IM.IntMap Wall -> IM.IntMap Wall
-divideWalls wls = IM.foldr divideWallIn wls wls
+divideWalls wls = foldl' (flip divideWallIn) wls wls
 
 insertInZone :: Int -> Int -> a -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
 insertInZone x y obj = IM.insertWith f x $ IM.singleton y obj