From 33a8e496bb958f505a2732b2a9afec1f927c1045 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 7 Feb 2019 05:23:44 +0100 Subject: [PATCH] working on acces clearance --- src/Floorplan.hs | 100 +++++++++++++++++++++++++++++++++++---- src/Interior.hs | 2 +- src/MainGame/WorldMap.hs | 4 +- src/Types/Map.hs | 8 ++-- 4 files changed, 99 insertions(+), 15 deletions(-) diff --git a/src/Floorplan.hs b/src/Floorplan.hs index 7d343ef..1ea4997 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -12,6 +12,10 @@ import Control.Concurrent.MVar import System.Random +-- internal imports + +import Util + import Types.Map buildHallFloorIO @@ -58,14 +62,19 @@ buildHallFloorIO fc progress increment = do doors <- buildDoors closed doorgraph modifyMVar_ progress (return . (\(p, _) -> ( p + increment - , "Build doors" + , "Built doors" ))) let (_, facils) = buildFacilities g2 fc doors modifyMVar_ progress (return . (\(p, _) -> ( p + increment - , "Build facilities" + , "Built facilities" ))) - return (facils, doorgraph) + accessGraph <- assignClearance doorgraph facils + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Assigned room clearances" + ))) + return (facils, accessGraph) emptyFloor :: FloorConfig -> Matrix TileState emptyFloor fc = @@ -130,7 +139,7 @@ buildHall -> Boundaries Int -> Matrix TileState -> ([Boundaries Int], Matrix TileState) -buildHall coord@(V2 row col) width bs mat = +buildHall (V2 row col) width bs mat = let vertHalls = foldl (flip (M.mapCol (\r cur -> if r >= fst (matmin bs) && r <= fst (matmax bs) then replaceTile cur Hall @@ -377,30 +386,103 @@ buildDoorsGraph mat = if Hall `elem` map snd neighs then let nroot = - if GRoom neighs b `notElem` connects (head root) + if GRoom neighs b 0 Offi `notElem` connects (head root) then GHall - { connects = connects (head root) ++ [GRoom neighs b] + { connects = connects (head root) ++ + [GRoom neighs b 0 Offi] } : tail root else root in buildGraph amat nroot (br, 1 + snd (matmax b)) else let nroot = root ++ - if GRoom neighs b `elem` root + if GRoom neighs b 0 Offi `elem` root then [] - else [GRoom neighs b] + else [GRoom neighs b 0 Offi] in buildGraph amat nroot (br, 1 + snd (matmax b)) | otherwise = buildGraph amat root (br, maxCol br (bc + 1)) in buildGraph mat [GHall []] (2, 2) +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 + +actualRoomType :: Boundaries Int -> M.Matrix TileState -> TileState +actualRoomType (Boundaries (minrow, mincol) (maxrow, maxcol)) imat = + let row = minrow + ((maxrow - minrow) `div` 2) + col = mincol + ((maxcol - mincol) `div` 2) + in imat M.! (row, col) + +doRandomAssign :: Graph -> IO Graph +doRandomAssign g = do + c <- randomRIO (0, 4) + return g + { clearance = c + } + +doBoundedAssign :: Graph -> Word -> IO Graph +doBoundedAssign g b = do + c <- randomRIO (b, 4) + return g + { clearance = c + } + +findNeighbor :: (GraphDirection, TileState) -> Boundaries Int -> M.Matrix TileState -> [Graph] -> Maybe Graph +findNeighbor (dir, _) bnds imat ingraph + | dir == North = + let row = fst (matmin bnds) - 2 + col = snd (matmin bnds) + (snd (matmax bnds) - snd (matmin bnds) `div` 2) + in postprocess row col + | dir == East = + let row = fst (matmin bnds) + (fst (matmax bnds) - fst (matmin bnds) `div` 2) + col = snd (matmin bnds) - 2 + in postprocess row col + | dir == South = + let row = fst (matmax bnds) + 2 + col = snd (matmin bnds) + (snd (matmax bnds) - snd (matmin bnds) `div` 2) + in postprocess row col + | dir == West = + let row = fst (matmin bnds) + (fst (matmax bnds) - fst (matmin bnds) `div` 2) + col = snd (matmax bnds) + 2 + in postprocess row col + where + neighTile row col = imat M.! (row, col) + postprocess row col = + case filter (inBounds (V2 row col) . bounds) (filter graphIsRoom ingraph) of + [a@(GRoom _ _ _ ts)] -> if ts == neighTile row col + then Just a + else error "findNeighbor: Query Result dies not match" + [] -> Nothing + _ -> error "findNeighbor: Non-singleton filter result" + buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState) buildDoors = foldM placeDoors where placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState) placeDoors amat (GHall conns) = foldM placeDoors amat conns - placeDoors amat (GRoom neighs bs) = + placeDoors amat (GRoom neighs bs _ _) = if Hall `elem` map snd neighs then do let halls = filter ((== Hall) . snd) neighs diff --git a/src/Interior.hs b/src/Interior.hs index 1c37f6a..727df3a 100644 --- a/src/Interior.hs +++ b/src/Interior.hs @@ -41,7 +41,7 @@ traverseGraph -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) traverseGraph imat acc (GHall sub) = foldl (traverseGraph imat) acc sub -traverseGraph imat (rng, putt) (GRoom _ bnds) = +traverseGraph imat (rng, putt) (GRoom _ bnds _ clearance) = let applicable = L.sortBy (\b a -> size (a, (ph, pw), rng) `compare` size (b, (ph, pw), rng)) ( L.filter diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index edd9b16..cce32ff 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -101,7 +101,7 @@ loadMapFork -> MVar (Float, T.Text) -> IO () loadMapFork ud ad future progress = do - let loadSteps = 21 + let loadSteps = 22 increment = 1 / loadSteps fc = FloorConfig (V2 10 10) @@ -111,7 +111,7 @@ loadMapFork ud ad future progress = do ( p + increment , "Building floor" ))) - (mat, gr) <- buildHallFloorIO fc progress increment -- 10 increments inside + (mat, gr) <- buildHallFloorIO fc progress increment -- 11 increments inside modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Converting to images" diff --git a/src/Types/Map.hs b/src/Types/Map.hs index 3aa54db..4ca81c2 100644 --- a/src/Types/Map.hs +++ b/src/Types/Map.hs @@ -53,13 +53,15 @@ data Graph { connects :: [Graph] } | GRoom - { neighbs :: [(GraphDirection, TileState)] - , bounds :: Boundaries Int + { neighbs :: [(GraphDirection, TileState)] + , bounds :: Boundaries Int + , clearance :: Word + , roomType :: TileState } deriving (Show, Eq) graphIsRoom :: Graph -> Bool -graphIsRoom (GRoom _ _) = True +graphIsRoom (GRoom _ _ _ _) = True graphIsRoom _ = False class Size a where