diff --git a/src/Interior.hs b/src/Interior.hs index 727df3a..52ba10c 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 _ clearance) = +traverseGraph imat (rng, putt) (GRoom _ bnds clear _) = let applicable = L.sortBy (\b a -> size (a, (ph, pw), rng) `compare` size (b, (ph, pw), rng)) ( L.filter @@ -64,7 +64,9 @@ traverseGraph imat (rng, putt) (GRoom _ bnds _ clearance) = (pw, g2) = randomR (1, snd (matmax bnds) - snd (matmin bnds) + 1) g1 in foldl - (\(orng, (omat, orp)) -> placeCluster imat orng bnds (ph, pw) 1 omat orp) + (\(orng, (omat, orp)) -> + placeCluster imat orng bnds (ph, pw) 1 clear omat orp + ) (g2, putt) applicable @@ -74,11 +76,12 @@ placeCluster -> Boundaries Int -> (Int, Int) -> Int + -> Word -> Matrix (Maybe ImgId) -> [ReachPoint] -> Cluster -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint])) -placeCluster imat rng bnds dim try mat rp appl = +placeCluster imat rng bnds dim try clearance mat rp appl = let (pr, g1) = randomR (fst (matmin bnds) - 1, fst (matmax bnds) - 1) rng (pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) g1 (g2_1, g2_2) = split g2 @@ -103,7 +106,7 @@ placeCluster imat rng bnds dim try mat rp appl = [] rp reaches = (map (+ V2 (pr - 1) (pc - 1)) (map pointCoord nrp)) - newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c) + newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c clearance) (zip3 (map pointType nrp) reaches @@ -115,7 +118,7 @@ placeCluster imat rng bnds dim try mat rp appl = else if pr + nrows cmat - 1 > fst (matmax bnds) || pc + ncols cmat - 1 > snd (matmax bnds) - then placeCluster imat g2 bnds dim (try + 1) mat rp appl + then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl else if any (`notElem` clusterRoom appl) (M.toList (M.submatrix @@ -129,17 +132,17 @@ placeCluster imat rng bnds dim try mat rp appl = pc (pc + ncols cmat - 1) mat )) - then placeCluster imat g2_1 bnds dim (try + 1) mat rp appl + then placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp appl else if any (`elem` (oldreaches)) (V2 <$> [pr .. pr + nrows cmat - 1] <*> [pc .. pc + ncols cmat - 1]) - then placeCluster imat g2 bnds dim (try + 1) mat rp appl + then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl else if isReachable newmat [(V2 10 10, Boundaries (0, 1) (0, 1))] (oldreaches ++ reaches) exits - then placeCluster imat g2_1 bnds dim (try + 1) newmat newrp appl - else placeCluster imat g2_1 bnds dim (try + 1) mat rp appl + then placeCluster imat g2_1 bnds dim (try + 1) clearance newmat newrp appl + else placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp appl insertMat :: Matrix (Maybe a) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 54e4ae2..d05c7e0 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -119,7 +119,7 @@ loadMapFork ud ad future progress = do let !imgmat = convertTileToImg mat !exits = Prelude.foldl (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty - then ReachPoint RoomExit (V2 r c) NE : acc + then ReachPoint RoomExit (V2 r c) NE 0 : acc else acc ) [] @@ -129,7 +129,7 @@ loadMapFork ud ad future progress = do , "Placing furniture" ))) (!inter, !rawrps) <- placeInteriorIO mat imgmat exits gr - let !rps = ReachPoint Elevator (fcElevator fc) SE : rawrps + let !rps = ReachPoint Elevator (fcElevator fc) SE 0 : rawrps modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Creating WorldState" @@ -140,7 +140,7 @@ loadMapFork ud ad future progress = do , "Registering copiers into WorldState" ))) let !copiers = Prelude.filter (\a -> pointType a == Copier) rps - mapM_ (\(ReachPoint _ icoord _) -> do + mapM_ (\(ReachPoint _ icoord _ _) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord void $ createEntity $ newEntity { pos = Just $ reachCoord - V2 1 0 @@ -156,7 +156,7 @@ loadMapFork ud ad future progress = do , "Registering computers into WorldState" ))) let !computers = Prelude.filter (\a -> pointType a == Computer) rps - mapM_ (\(ReachPoint _ icoord dir) -> do + mapM_ (\(ReachPoint _ icoord dir _) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord void $ createEntity $ newEntity { pos = Just $ reachCoord - case dir of @@ -173,7 +173,7 @@ loadMapFork ud ad future progress = do , "Registering toilets into WorldState" ))) let !toilets = Prelude.filter (\a -> pointType a == Toilet) rps - mapM_ (\(ReachPoint _ icoord dir) -> do + mapM_ (\(ReachPoint _ icoord dir _) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord void $ createEntity $ newEntity { pos = Just $ reachCoord - V2 0 (-1) @@ -266,6 +266,7 @@ loadMapFork ud ad future progress = do , imgMat = retMat , reachPoints = rps , mmImgMat = mmimgmat + , roomGraph = gr }) mouseToPlayer :: V2 Int32 -> Affection UserData () @@ -455,6 +456,9 @@ drawMap = do return (pos', pa, realToFrac (1 - ttl / maxt)) return (head pc, posanims, posActions) let V2 pr pc = playerPos + MainData _ _ _ _ gr = stateData ud + seekGraph = Types.connects (head gr) ++ tail gr + room = Prelude.filter (inBounds (fmap floor playerPos) . bounds) seekGraph mat = imgMat (stateData ud) cols = fromIntegral (ncols mat) rows = fromIntegral (nrows mat) @@ -528,7 +532,12 @@ drawMap = do fontFace ctx (assetFonts ud Map.! FontBedstead) textAlign ctx (S.fromList [AlignCenter,AlignTop]) fillColor ctx (rgb 255 128 0) - textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) + textBox ctx 0 0 200 ( + "FPS: " + <> T.pack (Prelude.take 5 $ show (1/dt)) + <> " Clearance: " + <> if not (Prelude.null room) then T.pack (show $ clearance $ head room) else "0" + ) drawTile :: UserData diff --git a/src/NPC.hs b/src/NPC.hs index b1ad36e..b695804 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -45,7 +45,7 @@ updateNPCs -> [ReachPoint] -> Double -> SystemT Entity (AffectionState (AffectionData UserData) IO) () -updateNPCs imgmat ws rp dt = do +updateNPCs imgmat ws rrp dt = do updateStats dt posbounds <- getPosBounds moent <- catMaybes <$> eover allEnts (do @@ -54,12 +54,15 @@ updateNPCs imgmat ws rp dt = do with npcActionState with npcWorkplace with npcStats + with npcClearanceLvl with vel with rot with anim pos' <- query pos rot' <- query rot + lvl <- query npcClearanceLvl npcState' <- query npcMoveState + let rp = filter ((lvl >=) . pointClearance) rrp case npcState' of NPCStanding ttl future -> do let nttl = ttl - dt diff --git a/src/Types/Interior.hs b/src/Types/Interior.hs index a5e83ff..21c27e5 100644 --- a/src/Types/Interior.hs +++ b/src/Types/Interior.hs @@ -178,9 +178,9 @@ clusterMatWithRPs ClusterCabinets dim@(h, w) g = let (typ, gf2) = randomR (0, length selses - 1) gf1 img = selses !! typ rp i - | i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW - | i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW - | i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW + | i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW 0 + | i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW 0 + | i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW 0 in (gf2, Just img : lsi, rp img : lsr) else (gf1, Just ImgCabinetSE : lsi, lsr) @@ -195,9 +195,9 @@ clusterMatWithRPs ClusterCabinets dim@(h, w) g = let (typ, gf2) = randomR (0, length selsws - 1) gf1 img = selsws !! typ rp i - | i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE - | i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE - | i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE + | i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE 0 + | i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE 0 + | i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE 0 in (gf2, Just img : lsi, rp img : lsr) else (gf1, Just ImgCabinetSW : lsi, lsr) @@ -234,43 +234,43 @@ clusterRoom ClusterCabinets = [Kitc] clusterPoints :: Cluster -> (Int, Int) -> [ReachPoint] clusterPoints ClusterBox1 _ = [] clusterPoints ClusterTableNE (h, _) = - [ ReachPoint Table (V2 r 2) SW | r <- [1..h] ] + [ ReachPoint Table (V2 r 2) SW 0 | r <- [1..h] ] clusterPoints ClusterTableNW (_, w) = - [ ReachPoint Table (V2 1 c) SE | c <- [1..w] ] + [ ReachPoint Table (V2 1 c) SE 0 | c <- [1..w] ] clusterPoints ClusterTableSW (h, _) = - [ ReachPoint Table (V2 r 1) NE | r <- [1..h] ] + [ ReachPoint Table (V2 r 1) NE 0 | r <- [1..h] ] clusterPoints ClusterTableSE (_, w) = - [ ReachPoint Table (V2 2 c) NW | c <- [1..w] ] + [ ReachPoint Table (V2 2 c) NW 0 | c <- [1..w] ] clusterPoints ClusterCornerTable _ = - [ ReachPoint Computer (V2 2 1) N + [ ReachPoint Computer (V2 2 1) N 0 ] clusterPoints ClusterTableGroup _ = - [ ReachPoint Computer (V2 2 2) N - , ReachPoint Computer (V2 2 5) N - , ReachPoint Computer (V2 5 5) N + [ ReachPoint Computer (V2 2 2) N 0 + , ReachPoint Computer (V2 2 5) N 0 + , ReachPoint Computer (V2 5 5) N 0 ] clusterPoints ClusterCopier _ = - [ ReachPoint Copier (V2 2 1) NW + [ ReachPoint Copier (V2 2 1) NW 0 ] clusterPoints ClusterFlipchart _ = - [ ReachPoint Table (V2 2 1) NW + [ ReachPoint Table (V2 2 1) NW 0 ] clusterPoints ClusterConferenceTable (h, w) = let mw = max 4 w mh = max 4 h in - [ ReachPoint Table (V2 1 c) SE | c <- [2..mw-1] ] ++ - [ ReachPoint Table (V2 r 1) NE | r <- [2..mh-1] ] ++ - [ ReachPoint Table (V2 r mw) SW | r <- [2..mh-1] ] ++ - [ ReachPoint Table (V2 mh c) NW | c <- [2..mw-1] ] + [ ReachPoint Table (V2 1 c) SE 0 | c <- [2..mw-1] ] ++ + [ ReachPoint Table (V2 r 1) NE 0 | r <- [2..mh-1] ] ++ + [ ReachPoint Table (V2 r mw) SW 0 | r <- [2..mh-1] ] ++ + [ ReachPoint Table (V2 mh c) NW 0 | c <- [2..mw-1] ] clusterPoints ClusterToilet _ = - [ ReachPoint Toilet (V2 1 1) NE + [ ReachPoint Toilet (V2 1 1) NE 0 ] clusterPoints ClusterWatercooler _ = - [ ReachPoint Drink (V2 2 1) NW + [ ReachPoint Drink (V2 2 1) NW 0 ] clusterPoints ClusterVending _ = - [ ReachPoint Eat (V2 2 1) NW + [ ReachPoint Eat (V2 2 1) NW 0 ] clusterPoints _ _ = [] diff --git a/src/Types/ReachPoint.hs b/src/Types/ReachPoint.hs index e1f3aba..d56b8ab 100644 --- a/src/Types/ReachPoint.hs +++ b/src/Types/ReachPoint.hs @@ -4,9 +4,10 @@ import Linear (V2(..)) import Types.Direction data ReachPoint = ReachPoint - { pointType :: PointType - , pointCoord :: V2 Int - , pointDir :: Direction + { pointType :: PointType + , pointCoord :: V2 Int + , pointDir :: Direction + , pointClearance :: Word } deriving (Eq, Show) diff --git a/src/Types/StateData.hs b/src/Types/StateData.hs index f6cbd7a..9a1158f 100644 --- a/src/Types/StateData.hs +++ b/src/Types/StateData.hs @@ -25,6 +25,7 @@ data StateData , imgMat :: Matrix (Maybe ImgId) , reachPoints :: [ReachPoint] , mmImgMat :: Matrix (Maybe ImgId) + , roomGraph :: [Graph] } | MenuData { velocity :: V2 Double