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

lets hack it to pieces

Browse source
This commit is contained in:
nek0 2019-03-28 21:00:44 +01:00
parent 9cdec48044
commit e206062dfc
1 changed files with 61 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
src/Floorplan.hs
View file

@ -6,7 +6,6 @@ import Data.Matrix (Matrix(..))
import qualified Data.Matrix as M
import qualified Data.Text as T
import Data.Maybe
import Data.List (intersect)
import Linear (V2(..))
@ -134,10 +133,6 @@ placeHalls rng fc input =
else (g2, nmat)
) (rand, mat) bs
boundSize :: Boundaries Int -> Int
boundSize (Boundaries mi ma) =
(fst ma - fst mi) * (snd ma - snd mi)
buildHall
:: (V2 Int)
-> Int
@ -211,6 +206,7 @@ buildInnerWalls rng input =
doCross
g2
(cr, cc)
coord
(Boundaries coord (maxRow, maxCol))
mat
else
@ -224,13 +220,21 @@ buildInnerWalls rng input =
M.setElem (replaceTile (acc M.! coords) Offi) coords acc
) mat btups
)
doCross
:: StdGen
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
=> t
-> (Int, Int)
-> (Int, Int)
-> Boundaries Int
-> Matrix TileState
-> (StdGen, Matrix TileState)
doCross gen cd@(xr, xc) b imat =
-> (t, Matrix TileState)
doCross gen cd@(xr, xc) coord@(row, col) b imat =
let nbs = map (uncurry Boundaries) bs
bs =
[ (matmin b, cd)
@ -261,18 +265,13 @@ buildInnerWalls rng input =
btups = (,)
<$> [fst (matmin b) .. fst (matmax b)]
<*> [snd (matmin b) .. snd (matmax b)]
in if boundSize b >= 16
in if size b >= 16
then foldl
(\(agen, amat) (acr, nb) -> doCross agen acr nb amat)
(\(agen, amat) (acr, nb) -> doCross agen acr coord nb amat)
(ngen, omat)
(zip crosses nbs)
else
(gen, omat)
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)
closeOffices :: Matrix TileState -> Matrix TileState
closeOffices input =
@ -423,16 +422,16 @@ assignClearance graph imat =
foldM doAssignClearance [] graph
where
doAssignClearance acc (GHall conns) = do
ret <- GHall <$> foldM (\acc a -> do
res <- reassign True acc a
return (acc ++ [res])
ret <- GHall <$> foldM (\facc a -> do
res <- reassign True facc a
return (facc ++ [res])
) [] conns
return (ret : acc)
doAssignClearance acc room = do
ret <- reassign False acc room
return (acc ++ [ret])
reassign :: Bool -> [Graph] -> Graph -> IO Graph
reassign p acc room@(GRoom ns b c t) =
reassign p acc room@(GRoom ns b _ _) =
if p
then do
if actualRoomType b imat == Offi
@ -440,7 +439,7 @@ assignClearance graph imat =
let neigh = filter (all ((/= Hall) . snd) . neighbs) $
catMaybes
(map
(\n -> findNeighbor n b imat onlyrooms)
(\n -> findNeighbor n b onlyrooms)
nonhalls
)
onlyrooms = tail graph
@ -458,7 +457,7 @@ assignClearance graph imat =
let neigh =
catMaybes
(map
(\n -> findNeighbor n b imat onlyrooms)
(\n -> findNeighbor n b onlyrooms)
nonhalls
)
onlyrooms = connects (head acc)
@ -490,8 +489,12 @@ doBoundedAssign g b = do
{ clearance = c
}
findNeighbor :: (GraphDirection, TileState) -> Boundaries Int -> M.Matrix TileState -> [Graph] -> Maybe Graph
findNeighbor (dir, _) bnds imat ingraph
findNeighbor
:: (GraphDirection, TileState)
-> Boundaries Int
-> [Graph]
-> Maybe Graph
findNeighbor (dir, _) bnds ingraph
| dir == North =
let row = fst (matmin bnds) - 2
col = snd (matmin bnds) + ((snd (matmax bnds) - snd (matmin bnds)) `div` 2)
@ -509,14 +512,13 @@ findNeighbor (dir, _) bnds imat ingraph
col = snd (matmin bnds) - 2
in postprocess row col
where
neighTile row col = imat M.! (row, col)
postprocess row col =
let filtered = filter
(inBounds (V2 row col) . bounds)
ingraph
in
case filtered of
[a@(GRoom _ _ _ ts)] -> Just a
[a@(GRoom _ _ _ _)] -> Just a
-- if ts == neighTile row col
-- then Just a
-- else error "findNeighbor: Query Result does not match"