still working on clearance levels

This commit is contained in:
nek0 2019-02-07 06:15:21 +01:00
parent 33a8e496bb
commit 8b5a9e6006

View file

@ -54,7 +54,7 @@ buildHallFloorIO fc progress increment = do
( p + increment
, "Closed offices"
)))
let doorgraph = buildDoorsGraph closed
doorgraph <- buildDoorsGraph closed
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Doorgraph"
@ -69,12 +69,12 @@ buildHallFloorIO fc progress increment = do
( p + increment
, "Built facilities"
)))
accessGraph <- assignClearance doorgraph facils
-- accessGraph <- assignClearance doorgraph facils
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Assigned room clearances"
)))
return (facils, accessGraph)
return (facils, doorgraph)
emptyFloor :: FloorConfig -> Matrix TileState
emptyFloor fc =
@ -341,7 +341,7 @@ findNearestOffice mat (V2 rrr ccc) =
else acc
) (fst $ head inlist) inlist
buildDoorsGraph :: Matrix TileState -> [Graph]
buildDoorsGraph :: Matrix TileState -> IO [Graph]
buildDoorsGraph mat =
let maxCol r c
| M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
@ -402,31 +402,34 @@ buildDoorsGraph mat =
in buildGraph amat nroot (br, 1 + snd (matmax b))
| otherwise =
buildGraph amat root (br, maxCol br (bc + 1))
in buildGraph mat [GHall []] (2, 2)
in weedOut $ buildGraph 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 []
assignClearance :: [Graph] -> M.Matrix TileState -> IO [Graph]
assignClearance graph imat =
mapM doAssignClearance graph
where
doAssignClearance (GHall hgs) = do
arooms <- mapM doAssignClearance hgs
return (GHall arooms)
doAssignClearance s@(GRoom _ _ _ _) = error (show s)
doAssignClearance gr@(GRoom neighs bnds _ _)
| all ((/= Offi) . flip actualRoomType imat . bounds) (
filter graphIsRoom (catMaybes $ map (\g -> findNeighbor g bnds imat graph) neighs)) &&
actualRoomType bnds imat == Offi = do
aroom <- doRandomAssign gr
return aroom
| all ((== Offi) . flip actualRoomType imat . bounds) (
filter graphIsRoom (catMaybes $ map (\g -> findNeighbor g bnds imat graph) neighs)) &&
actualRoomType bnds imat == Offi = do
aroom <- doBoundedAssign gr
(minimum $ map
(\n -> fromMaybe 0 (clearance <$> (\g -> findNeighbor g bnds imat graph) n))
neighs
)
return aroom
doAssignClearance (GHall conns) =
GHall <$> mapM (reassign True) conns
doAssignClearance room =
reassign False room
reassign p room@(GRoom ns b c t) =
if p
then do
if actualRoomType b imat == Offi
then doRandomAssign room
else return room
else do
let neigh = findNeighbor (head ns) b imat graph
actualRoomType :: Boundaries Int -> M.Matrix TileState -> TileState
actualRoomType (Boundaries (minrow, mincol) (maxrow, maxcol)) imat =
@ -438,7 +441,7 @@ doRandomAssign :: Graph -> IO Graph
doRandomAssign g = do
c <- randomRIO (0, 4)
return g
{ clearance = c
{ clearance = if actualRoomType c
}
doBoundedAssign :: Graph -> Word -> IO Graph