*insert screechy music*

This commit is contained in:
nek0 2019-03-29 12:30:47 +01:00
parent e206062dfc
commit 1c95794285

View file

@ -174,12 +174,16 @@ 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
-> (StdGen, Matrix TileState)
floodSearchReplace gn coord@(row, col) mat
floodSearchReplace gn coord@(row, col) mat
| mat M.! coord == Unde =
let maxRow = doRow row
doRow r
@ -222,9 +226,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,7 +311,27 @@ buildFacilities
-> Matrix TileState
-> (StdGen, Matrix TileState)
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
altered = M.setElem ts coords mat
in
@ -323,12 +344,6 @@ buildFacilities gen fc input =
, (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 +362,30 @@ findNearestOffice mat (V2 rrr ccc) =
buildDoorsGraph :: Matrix TileState -> IO [Graph]
buildDoorsGraph mat =
let maxCol r c
| M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
| otherwise = c
buildGraph :: Matrix TileState -> [Graph] -> (Int, Int) -> [Graph]
buildGraph amat root coord@(br, bc)
weedOut $ buildGraph mat mat [GHall []] (2, 2)
where
weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
weedOut (g@(GRoom neighs _ _ _):gs) = do
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 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
let roomcoords = flood amat [coord] coord
b = Boundaries
(minimum (map fst roomcoords), minimum (map snd roomcoords))
(maximum (map fst roomcoords), maximum (map snd roomcoords))
@ -397,25 +406,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))
in weedOut $ buildGraph mat [GHall []] (2, 2)
buildGraph amat mat root (br, maxCol br (bc + 1))
where
weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
weedOut (g@(GRoom neighs _ _ _):gs) = do
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 []
maxCol r c
| M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
| otherwise = c
flood amat acc (fr, fc) =
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 amat) (acc ++ ncoords) ncoords
assignClearance :: [Graph] -> M.Matrix TileState -> IO [Graph]
assignClearance graph imat =
@ -527,11 +551,11 @@ findNeighbor (dir, _) bnds ingraph
buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
buildDoors = foldM placeDoors
where
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
placeDoors amat (GHall conns) =
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
placeDoors amat (GHall conns) =
foldM placeDoors amat conns
placeDoors amat (GRoom neighs bs _ _) =
placeDoors amat (GRoom neighs bs _ _) =
if Hall `elem` map snd neighs
then do
let halls = filter ((== Hall) . snd) neighs
@ -582,8 +606,9 @@ 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
inRow :: Matrix TileState -> Int -> (Int, Int) -> IO (Matrix TileState)
inRow mat row cols = do
col <- randomRIO cols
let tile = mat M.! (row, col)
if tile == Wall
@ -598,8 +623,9 @@ 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
inCol :: Matrix TileState -> (Int, Int) -> Int -> IO (Matrix TileState)
inCol mat rows col = do
row <- randomRIO rows
let tile = mat M.! (row, col)
if tile == Wall