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

Merge pull request #3 from nek0/axe

Browse source 
Axe
This commit is contained in:
rys ostrovid 2019-03-29 15:59:34 +01:00 committed by GitHub
commit 6d051f6c5e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 224 additions and 216 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

136
src/Floorplan.hs
View file

@ -122,10 +122,8 @@ placeHalls rng fc input =
(fst (matmin b) + 10, fst (matmax b) - 10) agen (fst (matmin b) + 10, fst (matmax b) - 10) agen
(col, g2) = randomR (col, g2) = randomR
(snd (matmin b) + 10, snd (matmax b) - 10) g1 (snd (matmin b) + 10, snd (matmax b) - 10) g1
-- (nw, g3) = randomR (2, wmax) g2
(nbs, nmat) = buildHall cross 3 b amat (nbs, nmat) = buildHall cross 3 b amat
in in
-- if hallRatio nmat < 0.33 && wmax - 1 >= 2
if wmax - 1 >= 3 && if wmax - 1 >= 3 &&
all (\(Boundaries (minr, minc) (maxr, maxc)) -> all (\(Boundaries (minr, minc) (maxr, maxc)) ->
maxr - minr > 3 && maxc - minc > 3) nbs maxr - minr > 3 && maxc - minc > 3) nbs
@ -174,12 +172,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 +224,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,25 +309,26 @@ 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 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 let cur = mat M.! coords
altered = M.setElem ts coords mat altered = M.setElem ts coords mat
in in
if cur == ts || cur /= Offi if cur == ts || cur /= Offi
then mat then mat
else foldl (flood ts) else foldl (facilFlood ts)
altered altered
[ (cr + 1, cc) [ (cr + 1, cc)
, (cr - 1, cc) , (cr - 1, cc)
, (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 +347,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 +391,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 =
@ -519,19 +528,16 @@ findNeighbor (dir, _) bnds ingraph
in in
case filtered of case filtered of
[a@(GRoom _ _ _ _)] -> Just a [a@(GRoom _ _ _ _)] -> Just a
-- if ts == neighTile row col
-- then Just a
-- else error "findNeighbor: Query Result does not match"
[] -> Nothing [] -> Nothing
_ -> error "findNeighbor: Non-singleton filter result" _ -> error "findNeighbor: Non-singleton filter result"
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 +588,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 +605,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