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

works better

Browse source
This commit is contained in:
nek0 2018-02-16 22:16:28 +01:00
parent 713bc1adf2
commit e6fc4011ac
1 changed files with 19 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/Floorplan.hs
View file

@ -43,7 +43,7 @@ data FloorConfig = FloorConfig
data Boundaries = Boundaries data Boundaries = Boundaries
{ matmin :: (Int, Int) { matmin :: (Int, Int)
, matmax :: (Int, Int) , matmax :: (Int, Int)
} deriving (Show) } deriving (Show, Eq)
buildHallFloorIO :: FloorConfig -> IO (Matrix TileState) buildHallFloorIO :: FloorConfig -> IO (Matrix TileState)
buildHallFloorIO fc = do buildHallFloorIO fc = do
@ -372,20 +372,26 @@ buildDoorsGraph mat =
in in
if Hall `elem` map snd neighs if Hall `elem` map snd neighs
then then
let nroot = GHall let nroot =
{ connects = connects (head root) ++ [GRoom neighs b] if GRoom neighs b `notElem` connects (head root)
} : tail root then
GHall
{ connects = connects (head root) ++ [GRoom neighs b]
} : tail root
else root
in buildGraph amat nroot (br, 1 + snd (matmax b)) in buildGraph amat nroot (br, 1 + snd (matmax b))
else else
let nroot = root ++ let nroot = root ++
[GRoom neighs b] if GRoom neighs b `elem` root
then []
else [GRoom neighs b]
in buildGraph amat nroot (br, 1 + snd (matmax b)) in buildGraph amat nroot (br, 1 + snd (matmax b))
| otherwise = | otherwise =
buildGraph amat root (br, maxCol br (bc + 1)) buildGraph amat root (br, maxCol br (bc + 1))
in buildGraph mat [GHall []] (2, 2) in buildGraph mat [GHall []] (2, 2)
data GraphDirection = North | South | East | West data GraphDirection = North | South | East | West
deriving (Eq) deriving (Show, Eq)
data Graph data Graph
= GHall = GHall
@ -395,9 +401,11 @@ data Graph
{ neighbs :: [(GraphDirection, TileState)] { neighbs :: [(GraphDirection, TileState)]
, bounds :: Boundaries , bounds :: Boundaries
} }
deriving (Show, Eq)
buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState) buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
buildDoors input graph = buildDoors input graph = do
traceIO ("graph: " ++ show (tail graph))
foldM placeDoors input graph foldM placeDoors input graph
where where
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState) placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
@ -406,6 +414,7 @@ buildDoors input graph =
placeDoors amat (GRoom neighs bounds) = placeDoors amat (GRoom neighs bounds) =
if Hall `elem` map snd neighs if Hall `elem` map snd neighs
then do then do
traceIO "door in Hall"
let halls = filter ((== Hall) . snd) neighs let halls = filter ((== Hall) . snd) neighs
idx <- randomRIO (0, length halls - 1) idx <- randomRIO (0, length halls - 1)
let (dir, _) = halls !! idx let (dir, _) = halls !! idx
@ -431,6 +440,7 @@ buildDoors input graph =
(fst (matmin bounds), fst (matmax bounds)) (fst (matmin bounds), fst (matmax bounds))
(snd (matmax bounds) + 1) (snd (matmax bounds) + 1)
else do else do
traceIO "door in Office"
idx <- randomRIO (0, length neighs - 1) idx <- randomRIO (0, length neighs - 1)
let (dir, _) = neighs !! idx let (dir, _) = neighs !! idx
case dir of case dir of
@ -467,7 +477,7 @@ buildDoors input graph =
if Door `elem` M.toList (M.submatrix row row (fst cols) (snd cols) mat) if Door `elem` M.toList (M.submatrix row row (fst cols) (snd cols) mat)
then return mat then return mat
else do else do
traceIO "placing door" traceIO ("placing door: " ++ show (row, col))
return $ M.setElem Door (row, col) mat return $ M.setElem Door (row, col) mat
else else
inRow mat row cols inRow mat row cols
@ -484,7 +494,7 @@ buildDoors input graph =
if Door `elem` M.toList (M.submatrix (fst rows) (snd rows) col col mat) if Door `elem` M.toList (M.submatrix (fst rows) (snd rows) col col mat)
then return mat then return mat
else do else do
traceIO "placing door" traceIO ("placing door: " ++ show (row, col))
return $ M.setElem Door (row, col) mat return $ M.setElem Door (row, col) mat
else else
inCol mat rows col inCol mat rows col