GitHub
commit
6d051f6c5e
1 changed files with 224 additions and 216 deletions
136
src/Floorplan.hs
136
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,12 +172,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 +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
|
||||
| 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 +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))
|
||||
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 =
|
||||
|
|
@ -519,19 +528,16 @@ 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) =
|
||||
|
||||
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 +588,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 +605,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
|
||||
|
|
|
|||
Loading…
Reference in a new issue