From f09bcfd87eb1c5e14df6d3b1045922f01c2bd7bc Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 15 Feb 2018 19:42:07 +0100 Subject: [PATCH] inb4 chopping out --- src/Floorplan.hs | 185 +++++++++++++++++++++++++++++++++++++--------- src/Init.hs | 7 ++ tracer-game.cabal | 2 + 3 files changed, 158 insertions(+), 36 deletions(-) diff --git a/src/Floorplan.hs b/src/Floorplan.hs index 5e2f39f..2fadbf2 100644 --- a/src/Floorplan.hs +++ b/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 Data.Maybe (fromMaybe) +import qualified Data.Vector as V +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 - (g1, withElv) = buildElevator fc (placeHalls gen fc empty) - (g2, withIW) = buildInnerWalls g1 withElv - withOW = buildOuterWalls withIW - closed = closeOffices withOW - (g3, facilities) = buildFacilities g2 fc closed - in facilities + let empty = emptyFloor fc + (g1, withElv) = buildElevator fc (placeHalls gen fc empty) + (g2, withIW) = buildInnerWalls g1 withElv + withOW = buildOuterWalls withIW + closed = closeOffices withOW + (g3, doors) = buildDoors g2 closed + (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 - in foldl (\(agen, amat) b -> - let (row, g1) = randomR (fst (matmin b), fst (matmax b)) agen - (col, g2) = randomR (snd (matmin b), snd (matmax b)) g1 - (nw, g3) = randomR (2, wmax) g2 - (nbs, nmat) = buildHall cross nw b amat - in - if hallRatio nmat < 0.175 && wmax - 1 > 2 - then doHalls g3 nbs (row, col) (wmax -1) nmat - else (g3, nmat) - ) (rand, mat) bounds + foldl (\(agen, amat) b -> + let (row, g1) = randomR (fst (matmin b), fst (matmax b)) agen + (col, g2) = randomR (snd (matmin b), snd (matmax b)) g1 + (nw, g3) = randomR (2, wmax) g2 + (nbs, nmat) = buildHall cross nw b amat + in + if hallRatio nmat < 0.175 && wmax - 1 > 2 + then doHalls g3 nbs (row, col) (wmax -1) nmat + else (g3, nmat) + ) (rand, mat) bounds boundSize :: Boundaries -> Int -boundSize (Boundaries min max) = - (fst max - fst min) * (snd max - snd min) +boundSize (Boundaries mi ma) = + (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 = - let nbs = map (\(min, max) -> Boundaries min max) bounds + doCross gen cd@(xr, xc) b imat = + 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 - (fr, g2) = randomR (snd minb, snd maxb) g1 - in (g2, acc ++ [(fc, fr)]) + let (fc, gg1) = randomR (fst minb, fst maxb) agen + (fr, gg2) = randomR (snd minb, snd maxb) gg1 + 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) diff --git a/src/Init.hs b/src/Init.hs index 0c82bbd..c4f7a31 100644 --- a/src/Init.hs +++ b/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 diff --git a/tracer-game.cabal b/tracer-game.cabal index 10dd6e6..3f80546 100644 --- a/tracer-game.cabal +++ b/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