inb4 chopping out

src/Floorplan.hs

@@ -2,8 +2,8 @@ module Floorplan where
 
 import Data.Matrix (Matrix(..))
 import qualified Data.Matrix as M
-import Data.Foldable (find)
+import qualified Data.Vector as V
-import Data.Maybe (fromMaybe)
+import Data.Maybe (isJust)
 
 import System.Random
 
@@ -50,13 +50,14 @@ buildHallFloorIO fc = do
 
 buildHallFloor :: FloorConfig -> StdGen -> Matrix TileState
 buildHallFloor fc gen =
-  let empty            = emptyFloor fc
+  let empty         = emptyFloor fc
-      (g1, withElv)    = buildElevator fc (placeHalls gen fc empty)
+      (g1, withElv) = buildElevator fc (placeHalls gen fc empty)
-      (g2, withIW)     = buildInnerWalls g1 withElv
+      (g2, withIW)  = buildInnerWalls g1 withElv
-      withOW           = buildOuterWalls withIW
+      withOW        = buildOuterWalls withIW
-      closed           = closeOffices withOW
+      closed        = closeOffices withOW
-      (g3, facilities) = buildFacilities g2 fc closed
+      (g3, doors)   = buildDoors g2 closed
-  in  facilities
+      (g4, facils)  = buildFacilities g3 fc (trace "doors finished" doors)
+  in  facils
 
 emptyFloor :: FloorConfig -> Matrix TileState
 emptyFloor fc =
@@ -67,12 +68,12 @@ buildElevator
   :: FloorConfig
   -> (StdGen, Matrix TileState)
   -> (StdGen, Matrix TileState)
-buildElevator fc (gen, emptyFloor) =
+buildElevator fc (gen, empty) =
   let (row, col) = elevator fc
       boxCoord x = (,) <$> [row - x .. row + x] <*> [col - x .. col + x]
       buildShaft = foldl
         (\acc coord -> M.setElem (replaceTile (acc M.! coord) Hall) coord acc)
-        (foldl (\acc coord -> M.setElem Wall coord acc) emptyFloor (boxCoord 2))
+        (foldl (\acc coord -> M.setElem Wall coord acc) empty (boxCoord 2))
         (boxCoord 5)
       elvDoor = M.setElem Door (row + 2, col) buildShaft
   in  (gen, foldl (\acc coord -> M.setElem Elev coord acc) elvDoor (boxCoord 1))
@@ -87,23 +88,21 @@ placeHalls rng fc input =
    [(Boundaries (1,1) (nrows input, ncols input))]
    (elevator fc) 5 input
   where
-    elPos = elevator fc
     doHalls rand bounds cross wmax mat =
-      let (rnd, gen) = next rand
+      foldl (\(agen, amat) b ->
-      in  foldl (\(agen, amat) b ->
+        let (row, g1)   = randomR (fst (matmin b), fst (matmax b)) agen
-            let (row, g1)   = randomR (fst (matmin b), fst (matmax b)) agen
+            (col, g2)   = randomR (snd (matmin b), snd (matmax b)) g1
-                (col, g2)   = randomR (snd (matmin b), snd (matmax b)) g1
+            (nw, g3)    = randomR (2, wmax) g2
-                (nw, g3)    = randomR (2, wmax) g2
+            (nbs, nmat) = buildHall cross nw b amat
-                (nbs, nmat) = buildHall cross nw b amat
+        in
-            in
+          if hallRatio nmat < 0.175 && wmax - 1 > 2
-              if hallRatio nmat < 0.175 && wmax - 1 > 2
+          then doHalls g3 nbs (row, col) (wmax -1) nmat
-              then doHalls g3 nbs (row, col) (wmax -1) nmat
+          else (g3, nmat)
-              else (g3, nmat)
+        ) (rand, mat) bounds
-            ) (rand, mat) bounds
 
 boundSize :: Boundaries -> Int
-boundSize (Boundaries min max) =
+boundSize (Boundaries mi ma) =
-  (fst max - fst min) * (snd max - snd min)
+  (fst ma - fst mi) * (snd ma - snd mi)
 
 buildHall
   :: (Int, Int)
@@ -141,7 +140,7 @@ replaceTile cur new
 
 hallRatio :: Matrix TileState -> Double
 hallRatio mat =
-  let hs = foldl (\acc a -> if a == Hall then acc + 1 else acc) 0 mat
+  let hs = foldl (\acc a -> if a == Hall then acc + 1 else acc) 0 mat :: Int
   in  fromIntegral hs / fromIntegral (nrows mat * ncols mat)
 
 buildInnerWalls :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState)
@@ -197,19 +196,19 @@ buildInnerWalls rng input =
                 -> Boundaries
                 -> Matrix TileState
                 -> (StdGen, Matrix TileState)
-              doCross gen coord@(xr, xc) b imat =
+              doCross gen cd@(xr, xc) b imat =
-                let nbs = map (\(min, max) -> Boundaries min max) bounds
+                let nbs = map (\(mi, ma) -> Boundaries mi ma) bounds
                     bounds =
-                      [ (matmin b, coord)
+                      [ (matmin b, cd)
                       , ((fst (matmin b), col), (row, snd (matmax b)))
                       , ((row, snd (matmin b)), (fst (matmax b), col))
-                      , (coord, matmax b)
+                      , (cd, matmax b)
                       ]
                     (ngen, crosses) = foldl
                       (\(agen, acc) (minb, maxb) ->
-                        let (fc, g1) = randomR (fst minb, fst maxb) agen
+                        let (fc, gg1) = randomR (fst minb, fst maxb) agen
-                            (fr, g2) = randomR (snd minb, snd maxb) g1
+                            (fr, gg2) = randomR (snd minb, snd maxb) gg1
-                        in  (g2, acc ++ [(fc, fr)])
+                        in  (gg2, acc ++ [(fc, fr)])
                         ) (gen, []) bounds
                     horz = M.mapRow (\icol cur ->
                       if icol >= snd (matmin b) && icol <= snd (matmax b)
@@ -230,7 +229,7 @@ buildInnerWalls rng input =
                       <*> [snd (matmin b) .. snd (matmax b)]
                 in if boundSize b >= 16
                    then foldl
-                     (\(agen, amat) (cr, nb) -> doCross agen cr nb amat)
+                     (\(agen, amat) (acr, nb) -> doCross agen acr nb amat)
                      (ngen, omat)
                      (zip crosses nbs)
                    else
@@ -304,10 +303,124 @@ findNearestOffice
   -> (Int, Int)
 findNearestOffice mat (rrr, ccc) =
   let matcoord = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
-      distance (ar, ac) = (ar - rrr) ^ 2 + (ac - ccc) ^ 2
+      distance :: (Int, Int) -> Int
+      distance (ar, ac) = (ar - rrr) ^ (2 :: Int) + (ac - ccc) ^ (2 :: Int)
       inlist = zip matcoord (M.toList mat)
-  in  foldl (\acc@(arow, acol) x@(xc@(crow, ccol), ts) ->
+  in  foldl (\acc (xc, ts) ->
         if ts == Offi && distance acc > distance xc
         then xc
         else acc
         ) (fst $ head inlist) inlist
+
+buildDoors :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState)
+buildDoors rand mat =
+  let maxRow r c
+        | M.safeGet (r + 1) c mat == Just Offi = maxRow (r + 1) c
+        | otherwise = r
+      maxCol r c
+        | M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
+        | otherwise = c
+      minRow r c
+        | M.safeGet (r + 1) c mat == Just Offi = minRow (r + 1) c
+        | otherwise = r
+      minCol r c
+        | M.safeGet r (c + 1) mat == Just Offi = minCol r (c + 1)
+        | otherwise = c
+      matcoord = (,) <$> [2 .. nrows mat - 1] <*> [2 .. ncols mat - 1]
+      inbounds (qr, qc) fg
+        | fg == Hall =
+          Nothing
+        | otherwise  =
+          Just fg
+      buildGraph amat rnd coord@(br, bc)
+        | bc > ncols amat - 1 =
+          buildGraph amat rnd (br + 1, 1)
+        | br > nrows amat - 1 =
+          (rnd, amat)
+        | M.safeGet br bc amat == Just Offi =
+          let b = Boundaries (minRow br bc, minCol br bc) (maxRow br bc, maxCol br bc)
+              neighs =
+                [ (North, M.safeGet (minRow br bc - 2) bc amat)
+                , (South, M.safeGet (maxRow br bc + 2) bc amat)
+                , (East,  M.safeGet br (minCol br bc - 2) amat)
+                , (West,  M.safeGet br (maxCol br bc + 2) amat)
+                ]
+              (namat, rnd2) = 
+                if Just Hall `elem` map snd neighs
+                then
+                  let halls = filter ((== Just Hall) . snd) neighs
+                      (rh, r1) = randomR (0, length halls - 1) rnd
+                      (dir, _) = halls !! rh
+                      (dp , r2)
+                        | dir == North =
+                          let (col, rr) = randomR (minCol br bc, maxCol br bc) r1
+                              doorpos = ((minRow br bc) - 1, col)
+                          in  (doorpos, rr)
+                        | dir == South =
+                          let (col, rr) = randomR (minCol br bc, maxCol br bc) r1
+                              doorpos = ((maxRow br bc) + 1, col)
+                          in  (doorpos, rr)
+                        | dir == East =
+                          let (row, rr) = randomR (minRow br bc, maxRow br bc) r1
+                              doorpos = (row, (minCol br bc) - 1)
+                          in  (doorpos, rr)
+                        | dir == West =
+                          let (row, rr) = randomR (minRow br bc, maxRow br bc) r1
+                              doorpos = (row, (maxCol br bc) + 1)
+                          in  (doorpos, rr)
+                  in
+                    if any (== Door) (M.toList $ M.submatrix
+                      ((fst $ matmin b) - 1)
+                      ((fst $ matmax b) + 1)
+                      ((snd $ matmin b) - 1)
+                      ((snd $ matmax b) + 1)
+                      amat)
+                    then (amat, rnd)
+                    else
+                      ( if amat M.! dp == Hall || amat M.! dp == Offi
+                        then amat
+                        else M.setElem Door dp amat
+                      , r2
+                      )
+                else
+                  let others = filter ((== Just Offi) . snd) neighs
+                      (ro, r1) = randomR (0, length others - 1) rnd
+                      (dir, _) = others !! ro
+                      (dp, r2)
+                        | dir == North =
+                          let (col, rr) = randomR (minCol br bc, maxCol br bc) r1
+                              doorpos = ((minRow br bc) - 1, col)
+                          in  (doorpos, rr)
+                        | dir == South =
+                          let (col, rr) = randomR (minCol br bc, maxCol br bc) r1
+                              doorpos = ((maxRow br bc) + 1, col)
+                          in  (doorpos, rr)
+                        | dir == East =
+                          let (row, rr) = randomR (minRow br bc, maxRow br bc) r1
+                              doorpos = (row, (minCol br bc) - 1)
+                          in  (doorpos, rr)
+                        | dir == West =
+                          let (row, rr) = randomR (minRow br bc, maxRow br bc) r1
+                              doorpos = (row, (maxCol br bc) + 1)
+                          in  (doorpos, rr)
+                  in
+                    if any (== Door) (M.toList $ M.submatrix
+                      ((fst $ matmin b) - 1)
+                      ((fst $ matmax b) + 1)
+                      ((snd $ matmin b) - 1)
+                      ((snd $ matmax b) + 1)
+                      amat)
+                    then (amat, rnd)
+                    else
+                      ( if amat M.! dp == Hall || amat M.! dp == Offi
+                        then amat
+                        else M.setElem Door dp amat
+                      , r2
+                      )
+          in  buildGraph namat rnd2 (br, bc + 1)
+        | otherwise =
+          buildGraph amat rnd (br, maxCol br (bc + 1))
+  in  foldl (\(aar, aam) c -> buildGraph aam aar c) (rand, mat) matcoord
+
+data GraphDirection = North | South | East | West
+  deriving (Eq)

src/Init.hs

@@ -25,6 +25,10 @@ import Foreign.C.Types (CInt(..))
 
 import Types
 
+import Floorplan
+
+import Debug.Trace
+
 foreign import ccall unsafe "glewInit"
   glewInit :: IO CInt
 
@@ -36,6 +40,9 @@ load = do
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
   w <- runSystemT defWorld getWorld
+  let fc = FloorConfig (20, 45) [(5, 5), (30,80)] (40, 90)
+  floor <- buildHallFloorIO fc
+  traceIO $ show floor
   return UserData
     { state       = Menu
     , subsystems  = subs

tracer-game.cabal

@@ -38,5 +38,7 @@ executable tracer-game
                      , linear
                      , matrix
                      , random
+                     , vector
   hs-source-dirs:      src
+  ghc-options:         -Wall -prof
   default-language:    Haskell2010