diff --git a/src/Floorplan.hs b/src/Floorplan.hs index 1ea4997..c2b66e7 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -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