lets hack it to pieces

src/Floorplan.hs

@@ -6,7 +6,6 @@ import Data.Matrix (Matrix(..))
 import qualified Data.Matrix as M
 import qualified Data.Text as T
 import Data.Maybe
-import Data.List (intersect)
 
 import Linear (V2(..))
 
@@ -134,10 +133,6 @@ placeHalls rng fc input =
           else (g2, nmat)
         ) (rand, mat) bs
 
-boundSize :: Boundaries Int -> Int
-boundSize (Boundaries mi ma) =
-  (fst ma - fst mi) * (snd ma - snd mi)
-
 buildHall
   :: (V2 Int)
   -> Int
@@ -211,6 +206,7 @@ buildInnerWalls rng input =
                   doCross
                     g2
                     (cr, cc)
+                    coord
                     (Boundaries coord (maxRow, maxCol))
                     mat
                 else
@@ -224,56 +220,59 @@ buildInnerWalls rng input =
                           M.setElem (replaceTile (acc M.! coords) Offi) coords acc
                           ) mat btups
                     )
-              doCross
-                :: StdGen
-                -> (Int, Int)
-                -> Boundaries Int
-                -> Matrix TileState
-                -> (StdGen, Matrix TileState)
-              doCross gen cd@(xr, xc) b imat =
-                let nbs = map (uncurry Boundaries) bs
-                    bs =
-                      [ (matmin b, cd)
-                      , ((fst (matmin b), col), (row, snd (matmax b)))
-                      , ((row, snd (matmin b)), (fst (matmax b), col))
-                      , (cd, matmax b)
-                      ]
-                    (ngen, crosses) = foldl
-                      (\(agen, acc) (minb, maxb) ->
-                        let (fc, gg1) = randomR (fst minb, fst maxb) agen
-                            (fr, gg2) = randomR (snd minb, snd maxb) gg1
-                        in  (gg2, acc ++ [(fc, fr)])
-                        ) (gen, []) bs
-                    horz = M.mapRow (\icol cur ->
-                      if icol >= snd (matmin b) && icol <= snd (matmax b)
-                      then replaceTile cur Wall
-                      else cur
-                      ) xr imat
-                    vert = M.mapCol (\irow cur ->
-                      if irow >= fst (matmin b) && irow <= fst (matmax b)
-                      then replaceTile cur Wall
-                      else cur
-                      ) xc horz
-                    omat = foldl
-                      (\acc coords ->
-                        M.setElem (replaceTile (acc M.! coords) Offi) coords acc
-                        ) vert btups
-                    btups = (,)
-                      <$> [fst (matmin b) .. fst (matmax b)]
-                      <*> [snd (matmin b) .. snd (matmax b)]
-                in if boundSize b >= 16
-                   then foldl
-                     (\(agen, amat) (acr, nb) -> doCross agen acr nb amat)
-                     (ngen, omat)
-                     (zip crosses nbs)
-                   else
-                     (gen, omat)
           in  (nngen, nnmat)
         | otherwise = (gn, mat)
       tups mat = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
   in  foldl (\(agen, amat) cds -> floodSearchReplace agen cds amat)
         (rng, input) (tups input)
 
+doCross
+  :: RandomGen t
+  => t
+  -> (Int, Int)
+  -> (Int, Int)
+  -> Boundaries Int
+  -> Matrix TileState
+  -> (t, Matrix TileState)
+doCross gen cd@(xr, xc) coord@(row, col) b imat =
+  let nbs = map (uncurry Boundaries) bs
+      bs =
+        [ (matmin b, cd)
+        , ((fst (matmin b), col), (row, snd (matmax b)))
+        , ((row, snd (matmin b)), (fst (matmax b), col))
+        , (cd, matmax b)
+        ]
+      (ngen, crosses) = foldl
+        (\(agen, acc) (minb, maxb) ->
+          let (fc, gg1) = randomR (fst minb, fst maxb) agen
+              (fr, gg2) = randomR (snd minb, snd maxb) gg1
+          in  (gg2, acc ++ [(fc, fr)])
+          ) (gen, []) bs
+      horz = M.mapRow (\icol cur ->
+        if icol >= snd (matmin b) && icol <= snd (matmax b)
+        then replaceTile cur Wall
+        else cur
+        ) xr imat
+      vert = M.mapCol (\irow cur ->
+        if irow >= fst (matmin b) && irow <= fst (matmax b)
+        then replaceTile cur Wall
+        else cur
+        ) xc horz
+      omat = foldl
+        (\acc coords ->
+          M.setElem (replaceTile (acc M.! coords) Offi) coords acc
+          ) vert btups
+      btups = (,)
+        <$> [fst (matmin b) .. fst (matmax b)]
+        <*> [snd (matmin b) .. snd (matmax b)]
+  in if size b >= 16
+     then foldl
+       (\(agen, amat) (acr, nb) -> doCross agen acr coord nb amat)
+       (ngen, omat)
+       (zip crosses nbs)
+     else
+       (gen, omat)
+
 closeOffices :: Matrix TileState -> Matrix TileState
 closeOffices input =
   let tups mat = (,) <$> [2 .. nrows mat - 1] <*> [2 .. ncols mat - 1]
@@ -423,16 +422,16 @@ assignClearance graph imat =
   foldM doAssignClearance [] graph
   where
     doAssignClearance acc (GHall conns) = do
-      ret <- GHall <$> foldM (\acc a -> do
+      ret <- GHall <$> foldM (\facc a -> do
-        res <- reassign True acc a
+        res <- reassign True facc a
-        return (acc ++ [res])
+        return (facc ++ [res])
         ) [] conns
       return (ret : acc)
     doAssignClearance acc room = do
       ret <- reassign False acc room
       return (acc ++ [ret])
     reassign :: Bool -> [Graph] -> Graph -> IO Graph
-    reassign p acc room@(GRoom ns b c t) =
+    reassign p acc room@(GRoom ns b _ _) =
       if p
       then do
         if actualRoomType b imat == Offi
@@ -440,7 +439,7 @@ assignClearance graph imat =
           let neigh = filter (all ((/= Hall) . snd) . neighbs) $
                 catMaybes
                   (map
-                    (\n -> findNeighbor n b imat onlyrooms)
+                    (\n -> findNeighbor n b onlyrooms)
                     nonhalls
                     )
               onlyrooms = tail graph
@@ -458,7 +457,7 @@ assignClearance graph imat =
           let neigh =
                 catMaybes
                   (map
-                    (\n -> findNeighbor n b imat onlyrooms)
+                    (\n -> findNeighbor n b onlyrooms)
                     nonhalls
                     )
               onlyrooms = connects (head acc)
@@ -490,8 +489,12 @@ doBoundedAssign g b = do
     { clearance = c
     }
 
-findNeighbor :: (GraphDirection, TileState) -> Boundaries Int -> M.Matrix TileState -> [Graph] -> Maybe Graph
+findNeighbor
-findNeighbor (dir, _) bnds imat ingraph
+  :: (GraphDirection, TileState)
+  -> Boundaries Int
+  -> [Graph]
+  -> Maybe Graph
+findNeighbor (dir, _) bnds ingraph
   | dir == North =
     let row = fst (matmin bnds) - 2
         col = snd (matmin bnds) + ((snd (matmax bnds) - snd (matmin bnds)) `div` 2)
@@ -509,14 +512,13 @@ findNeighbor (dir, _) bnds imat ingraph
         col = snd (matmin bnds) - 2
     in  postprocess row col
   where 
-    neighTile row col = imat M.! (row, col)
     postprocess row col =
       let filtered = filter
             (inBounds (V2 row col) . bounds)
             ingraph
       in
         case filtered of
-          [a@(GRoom _ _ _ ts)] -> Just a
+          [a@(GRoom _ _ _ _)] -> Just a
                                   -- if ts == neighTile row col
                                   -- then Just a
                                   -- else error "findNeighbor: Query Result does not match"