Merge pull request #3 from nek0/axe

Axe

src/Floorplan.hs

@@ -122,10 +122,8 @@ placeHalls rng fc input =
               (fst (matmin b) + 10, fst (matmax b) - 10) agen
             (col, g2)   = randomR
               (snd (matmin b) + 10, snd (matmax b) - 10) g1
-            -- (nw, g3)    = randomR (2, wmax) g2
             (nbs, nmat) = buildHall cross 3 b amat
         in
-          -- if hallRatio nmat < 0.33 && wmax - 1 >= 2
           if wmax - 1 >= 3 &&
             all (\(Boundaries (minr, minc) (maxr, maxc)) ->
               maxr - minr > 3 && maxc - minc > 3) nbs
@@ -174,7 +172,11 @@ hallRatio mat =
 
 buildInnerWalls :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState)
 buildInnerWalls rng input =
-  let floodSearchReplace
+  let tups mat = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
+  in  foldl (\(agen, amat) cds -> floodSearchReplace agen cds amat)
+        (rng, input) (tups input)
+
+floodSearchReplace
   :: StdGen
   -> (Int, Int)
   -> Matrix TileState
@@ -222,9 +224,6 @@ buildInnerWalls rng input =
               )
     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
@@ -310,25 +309,26 @@ buildFacilities
   -> Matrix TileState
   -> (StdGen, Matrix TileState)
 buildFacilities gen fc input =
-  let flood ts mat coords@(cr, cc) =
+  let nearests = map (findNearestOffice input) (fcFacilities fc)
+  in  foldl (\(agen, acc) x ->
+        let (numfac, ngen) = randomR (0 :: Int, 1 :: Int) agen
+            facil = if numfac == 1 then Kitc else Toil
+        in  (ngen, facilFlood facil acc x)
+        ) (gen, input) nearests
+
+facilFlood ts mat coords@(cr, cc) =
   let cur = mat M.! coords
       altered = M.setElem ts coords mat
   in
     if cur == ts || cur /= Offi
     then mat
-          else foldl (flood ts)
+    else foldl (facilFlood ts)
       altered
       [ (cr + 1, cc)
       , (cr - 1, cc)
       , (cr, cc + 1)
       , (cr, cc - 1)
       ]
-      nearests = map (findNearestOffice input) (fcFacilities fc)
-  in  foldl (\(agen, acc) x ->
-        let (numfac, ngen) = randomR (0 :: Int, 1 :: Int) agen
-            facil = if numfac == 1 then Kitc else Toil
-        in  (ngen, flood facil acc x)
-        ) (gen, input) nearests
 
 findNearestOffice
   :: Matrix TileState
@@ -347,36 +347,30 @@ findNearestOffice mat (V2 rrr ccc) =
 
 buildDoorsGraph :: Matrix TileState -> IO [Graph]
 buildDoorsGraph mat =
-  let maxCol r c
+  weedOut $ buildGraph mat mat [GHall []] (2, 2)
-        | M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
+  where
-        | otherwise = c
+    weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
-      buildGraph :: Matrix TileState -> [Graph] -> (Int, Int) -> [Graph]
+    weedOut (g@(GRoom neighs _ _ _):gs) = do
-      buildGraph amat root coord@(br, bc)
+      let filtered = filter ((== Offi) . snd) neighs
+      rand <- randomRIO (0, length filtered -1) :: IO Int
+      let nneigh = filtered !! rand : []
+      rest <- weedOut gs
+      return (g { neighbs = nneigh } : rest)
+    weedOut [] = return []
+
+buildGraph
+  :: Matrix TileState
+  -> Matrix TileState
+  -> [Graph]
+  -> (Int, Int)
+  -> [Graph]
+buildGraph amat mat root coord@(br, bc)
   | bc > ncols amat - 1 =
-          buildGraph amat root (br + 1, 1)
+    buildGraph amat mat root (br + 1, 1)
   | br > nrows amat - 1 =
     root
   | M.safeGet br bc amat == Just Offi =
-          let flood acc (fr, fc) =
+    let roomcoords = flood amat [coord] coord
-                let ncoords = [] ++
-                      (if (fr + 1, fc) `notElem` acc &&
-                        M.safeGet (fr + 1) fc amat == Just Offi
-                      then [(fr + 1, fc)]
-                      else []) ++
-                      (if (fr - 1, fc) `notElem` acc &&
-                        M.safeGet (fr - 1) fc amat == Just Offi
-                      then [(fr - 1, fc)]
-                      else []) ++
-                      (if (fr, fc - 1) `notElem` acc &&
-                        M.safeGet fr (fc - 1) amat == Just Offi
-                      then [(fr, fc - 1)]
-                      else []) ++
-                      (if (fr, fc + 1) `notElem` acc &&
-                        M.safeGet fr (fc + 1) amat == Just Offi
-                      then [(fr, fc + 1)]
-                      else [])
-                in  foldl flood (acc ++ ncoords) ncoords
-              roomcoords = flood [coord] coord
         b = Boundaries
           (minimum (map fst roomcoords), minimum (map snd roomcoords))
           (maximum (map fst roomcoords), maximum (map snd roomcoords))
@@ -397,25 +391,40 @@ buildDoorsGraph mat =
                     [GRoom neighs b 0 Offi]
                   } : tail root
               else root
-              in  buildGraph amat nroot (br, 1 + snd (matmax b))
+        in  buildGraph amat mat nroot (br, 1 + snd (matmax b))
       else
         let nroot = root ++
               if GRoom neighs b 0 Offi `elem` root
               then []
               else [GRoom neighs b 0 Offi]
-              in  buildGraph amat nroot (br, 1 + snd (matmax b))
+        in  buildGraph amat mat nroot (br, 1 + snd (matmax b))
   | otherwise =
-          buildGraph amat root (br, maxCol br (bc + 1))
+    buildGraph amat mat root (br, maxCol br (bc + 1))
-  in  weedOut $ buildGraph mat [GHall []] (2, 2)
   where
-    weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
+    maxCol r c
-    weedOut (g@(GRoom neighs _ _ _):gs) = do
+      | M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
-      let filtered = filter ((== Offi) . snd) neighs
+      | otherwise = c
-      rand <- randomRIO (0, length filtered -1) :: IO Int
+
-      let nneigh = filtered !! rand : []
+
-      rest <- weedOut gs
+flood amat acc (fr, fc) =
-      return (g { neighbs = nneigh } : rest)
+  let ncoords = [] ++
-    weedOut [] = return []
+        (if (fr + 1, fc) `notElem` acc &&
+          M.safeGet (fr + 1) fc amat == Just Offi
+        then [(fr + 1, fc)]
+        else []) ++
+        (if (fr - 1, fc) `notElem` acc &&
+          M.safeGet (fr - 1) fc amat == Just Offi
+        then [(fr - 1, fc)]
+        else []) ++
+        (if (fr, fc - 1) `notElem` acc &&
+          M.safeGet fr (fc - 1) amat == Just Offi
+        then [(fr, fc - 1)]
+        else []) ++
+        (if (fr, fc + 1) `notElem` acc &&
+          M.safeGet fr (fc + 1) amat == Just Offi
+        then [(fr, fc + 1)]
+        else [])
+  in  foldl (flood amat) (acc ++ ncoords) ncoords
 
 assignClearance :: [Graph] -> M.Matrix TileState -> IO [Graph]
 assignClearance graph imat =
@@ -519,15 +528,12 @@ findNeighbor (dir, _) bnds ingraph
       in
         case filtered of
           [a@(GRoom _ _ _ _)] -> Just a
-                                  -- if ts == neighTile row col
-                                  -- then Just a
-                                  -- else error "findNeighbor: Query Result does not match"
           []                   -> Nothing
           _                    -> error "findNeighbor: Non-singleton filter result"
 
 buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
 buildDoors = foldM placeDoors
-  where
+
 placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
 placeDoors amat (GHall conns) =
   foldM placeDoors amat conns
@@ -582,6 +588,7 @@ buildDoors = foldM placeDoors
           amat
           (fst (matmin bs), fst (matmax bs))
           (snd (matmax bs) + 1)
+
 inRow :: Matrix TileState -> Int -> (Int, Int) -> IO (Matrix TileState)
 inRow mat row cols = do
   col <- randomRIO cols
@@ -598,6 +605,7 @@ buildDoors = foldM placeDoors
       return $ M.setElem Door (row, col) mat
   else
     inRow mat row cols
+
 inCol :: Matrix TileState -> (Int, Int) -> Int -> IO (Matrix TileState)
 inCol mat rows col = do
   row <- randomRIO rows