nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

*insert screechy music*

Browse source
This commit is contained in:
nek0 2019-03-29 12:30:47 +01:00
parent e206062dfc
commit 1c95794285
1 changed files with 236 additions and 210 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

142
src/Floorplan.hs
View file

@ -174,12 +174,16 @@ hallRatio mat =
buildInnerWalls :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState) buildInnerWalls :: StdGen -> Matrix TileState -> (StdGen, Matrix TileState)
buildInnerWalls rng input = 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 :: StdGen
-> (Int, Int) -> (Int, Int)
-> Matrix TileState -> Matrix TileState
-> (StdGen, Matrix TileState) -> (StdGen, Matrix TileState)
floodSearchReplace gn coord@(row, col) mat floodSearchReplace gn coord@(row, col) mat
| mat M.! coord == Unde = | mat M.! coord == Unde =
let maxRow = doRow row let maxRow = doRow row
doRow r doRow r
@ -222,9 +226,6 @@ buildInnerWalls rng input =
) )
in (nngen, nnmat) in (nngen, nnmat)
| otherwise = (gn, mat) | 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 doCross
:: RandomGen t :: RandomGen t
@ -310,7 +311,27 @@ buildFacilities
-> Matrix TileState -> Matrix TileState
-> (StdGen, Matrix TileState) -> (StdGen, Matrix TileState)
buildFacilities gen fc input = buildFacilities gen fc input =
let flood ts mat coords@(cr, cc) = -- let flood 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)
-- altered
-- [ (cr + 1, cc)
-- , (cr - 1, cc)
-- , (cr, cc + 1)
-- , (cr, cc - 1)
-- ]
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, flood facil acc x)
) (gen, input) nearests
facilFlood ts mat coords@(cr, cc) =
let cur = mat M.! coords let cur = mat M.! coords
altered = M.setElem ts coords mat altered = M.setElem ts coords mat
in in
@ -323,12 +344,6 @@ buildFacilities gen fc input =
, (cr, cc + 1) , (cr, cc + 1)
, (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 findNearestOffice
:: Matrix TileState :: Matrix TileState
@ -347,36 +362,30 @@ findNearestOffice mat (V2 rrr ccc) =
buildDoorsGraph :: Matrix TileState -> IO [Graph] buildDoorsGraph :: Matrix TileState -> IO [Graph]
buildDoorsGraph mat = 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 = | bc > ncols amat - 1 =
buildGraph amat root (br + 1, 1) buildGraph amat mat root (br + 1, 1)
| br > nrows amat - 1 = | br > nrows amat - 1 =
root root
| M.safeGet br bc amat == Just Offi = | 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 b = Boundaries
(minimum (map fst roomcoords), minimum (map snd roomcoords)) (minimum (map fst roomcoords), minimum (map snd roomcoords))
(maximum (map fst roomcoords), maximum (map snd roomcoords)) (maximum (map fst roomcoords), maximum (map snd roomcoords))
@ -397,25 +406,40 @@ buildDoorsGraph mat =
[GRoom neighs b 0 Offi] [GRoom neighs b 0 Offi]
} : tail root } : tail root
else root else root
in buildGraph amat nroot (br, 1 + snd (matmax b)) in buildGraph amat mat nroot (br, 1 + snd (matmax b))
else else
let nroot = root ++ let nroot = root ++
if GRoom neighs b 0 Offi `elem` root if GRoom neighs b 0 Offi `elem` root
then [] then []
else [GRoom neighs b 0 Offi] 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 = | 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 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] -> M.Matrix TileState -> IO [Graph]
assignClearance graph imat = assignClearance graph imat =
@ -527,11 +551,11 @@ findNeighbor (dir, _) bnds ingraph
buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState) buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
buildDoors = foldM placeDoors buildDoors = foldM placeDoors
where
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState) placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
placeDoors amat (GHall conns) = placeDoors amat (GHall conns) =
foldM placeDoors amat conns foldM placeDoors amat conns
placeDoors amat (GRoom neighs bs _ _) = placeDoors amat (GRoom neighs bs _ _) =
if Hall `elem` map snd neighs if Hall `elem` map snd neighs
then do then do
let halls = filter ((== Hall) . snd) neighs let halls = filter ((== Hall) . snd) neighs
@ -582,8 +606,9 @@ buildDoors = foldM placeDoors
amat amat
(fst (matmin bs), fst (matmax bs)) (fst (matmin bs), fst (matmax bs))
(snd (matmax bs) + 1) (snd (matmax bs) + 1)
inRow :: Matrix TileState -> Int -> (Int, Int) -> IO (Matrix TileState)
inRow mat row cols = do inRow :: Matrix TileState -> Int -> (Int, Int) -> IO (Matrix TileState)
inRow mat row cols = do
col <- randomRIO cols col <- randomRIO cols
let tile = mat M.! (row, col) let tile = mat M.! (row, col)
if tile == Wall if tile == Wall
@ -598,8 +623,9 @@ buildDoors = foldM placeDoors
return $ M.setElem Door (row, col) mat return $ M.setElem Door (row, col) mat
else else
inRow mat row cols inRow mat row cols
inCol :: Matrix TileState -> (Int, Int) -> Int -> IO (Matrix TileState)
inCol mat rows col = do inCol :: Matrix TileState -> (Int, Int) -> Int -> IO (Matrix TileState)
inCol mat rows col = do
row <- randomRIO rows row <- randomRIO rows
let tile = mat M.! (row, col) let tile = mat M.! (row, col)
if tile == Wall if tile == Wall