diff --git a/src/Floorplan.hs b/src/Floorplan.hs index d6774d6..90b3f41 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -5,6 +5,8 @@ import qualified Data.Matrix as M import qualified Data.Text as T import Data.Maybe +import Linear (V2(..)) + import Control.Monad (foldM) import Control.Concurrent.MVar @@ -75,7 +77,7 @@ buildElevator -> (StdGen, Matrix TileState) -> (StdGen, Matrix TileState) buildElevator fc (gen, empty) = - let (row, col) = fcElevator fc + let (V2 row col) = fcElevator fc boxCoord x = (,) <$> [row - x .. row + x] <*> [col - x .. col + x] buildShaft = foldl (\acc coord -> M.setElem (replaceTile (acc M.! coord) Hall) coord acc) @@ -97,7 +99,7 @@ placeHalls rng fc input = doHalls :: StdGen -> [Boundaries Int] - -> (Int , Int) + -> (V2 Int) -> Int -> Matrix TileState -> (StdGen, Matrix TileState) @@ -114,7 +116,7 @@ placeHalls rng fc input = if wmax - 1 >= 3 && all (\(Boundaries (minr, minc) (maxr, maxc)) -> maxr - minr > 3 && maxc - minc > 3) nbs - then doHalls g2 nbs (row, col) (wmax -1) nmat + then doHalls g2 nbs (V2 row col) (wmax -1) nmat else (g2, nmat) ) (rand, mat) bs @@ -123,12 +125,12 @@ boundSize (Boundaries mi ma) = (fst ma - fst mi) * (snd ma - snd mi) buildHall - :: (Int, Int) + :: (V2 Int) -> Int -> Boundaries Int -> Matrix TileState -> ([Boundaries Int], Matrix TileState) -buildHall coord@(row, col) width bs mat = +buildHall coord@(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 @@ -143,10 +145,10 @@ buildHall coord@(row, col) width bs mat = ))) vertHalls [row - (width `div` 2) .. row + (width `div` 2)] - in ( [ Boundaries (matmin bs) coord + in ( [ Boundaries (matmin bs) (row, col) , Boundaries (fst (matmin bs), col) (row, snd (matmax bs)) , Boundaries (row, snd (matmin bs)) (fst (matmax bs), col) - , Boundaries coord (matmax bs) + , Boundaries (row, col) (matmax bs) ] , horzHalls ) @@ -317,9 +319,9 @@ buildFacilities gen fc input = findNearestOffice :: Matrix TileState + -> (V2 Int) -> (Int, Int) - -> (Int, Int) -findNearestOffice mat (rrr, ccc) = +findNearestOffice mat (V2 rrr ccc) = let matcoord = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat] distance :: (Int, Int) -> Int distance (ar, ac) = (ar - rrr) ^ (2 :: Int) + (ac - ccc) ^ (2 :: Int) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 8756adf..750b12c 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do let loadSteps = 22 increment = 1 / loadSteps fc = FloorConfig - (10, 10) - [] -- [(5, 5), (5, 20)] + (V2 10 10) + [(V2 5 5), (V2 5 20)] (40, 40) modifyMVar_ progress (return . (\(p, _) -> ( p + increment @@ -108,7 +108,8 @@ loadMapFork ud ad future progress = do ( p + increment , "Placing furniture" ))) - (inter, rps) <- placeInteriorIO mat imgmat exits gr + (inter, rawrps) <- placeInteriorIO mat imgmat exits gr + let rps = ReachPoint Elevator (fcElevator fc) SE : rawrps modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Creating WorldState" @@ -135,9 +136,9 @@ loadMapFork ud ad future progress = do , "Registering computers into WorldState" ))) let computers = Prelude.filter (\a -> pointType a == Computer) rps - compEnts <- mapM (\(ReachPoint _ icoord dir) -> do + mapM_ (\(ReachPoint _ icoord dir) -> do let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord - createEntity $ newEntity + void $ createEntity $ newEntity { pos = Just $ reachCoord - case dir of N -> V2 1 (-1) _ -> error "not yet defined" @@ -212,16 +213,11 @@ loadMapFork ud ad future progress = do pos' <- query pos bnds <- query obstacle return (pos', bnds) - mapM_ (\(ce, npcpos@(V2 nr nc)) -> do + mapM_ (\(crp, npcpos@(V2 nr nc)) -> do fact <- liftIO $ randomRIO (0.5, 1.5) fut <- liftIO newEmptyMVar - [access] <- efor (anEnt ce) $ do - with pos - pos' <- query pos - acc <- queryMaybe objAccess - return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc) _ <- liftIO $ forkIO $ - getPathTo (fmap floor npcpos) fut access inter posbounds + getPathTo (fmap floor npcpos) fut (pointCoord crp) inter posbounds stats <- liftIO $ NPCStats <$> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) @@ -230,16 +226,17 @@ loadMapFork ud ad future progress = do <*> (randomRIO (0, 1)) <*> (randomRIO (0, 1)) void $ createEntity $ newEntity - { pos = Just (fmap (+ 0.5) npcpos) - , vel = Just (V2 0 0) - , velFact = Just fact - , rot = Just SE - , npcMoveState = Just (NPCStanding 0 fut) - , npcWorkplace = Just ce - , npcStats = Just stats - , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 + { pos = Just (fmap (+ 0.5) npcpos) + , vel = Just (V2 0 0) + , velFact = Just fact + , rot = Just SE + , npcMoveState = Just (NPCStanding 0 fut) + , npcWorkplace = Just crp + , npcActionState = Just ASWork + , npcStats = Just stats + , anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0 } - ) (zip compEnts npcposs) + ) (zip computers npcposs) liftIO $ modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Handing over" diff --git a/src/NPC.hs b/src/NPC.hs index 22f5b42..b482d2d 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -83,6 +83,9 @@ updateNPCs imgmat rp dt = do moent <- catMaybes <$> eover allEnts (do with pos with npcMoveState + with npcActionState + with npcWorkplace + with npcStats with vel with rot with anim @@ -100,10 +103,26 @@ updateNPCs imgmat rp dt = do }) else do mpath <- liftIO $ tryTakeMVar future + as <- query npcActionState + stats <- query npcStats + let nstats = case as of + ASDrink -> stats + { statThirst = 0 + , statDrink = 1 + } + ASEat -> stats + { statHunger = 0 + , statFood = 1 + } + ASToilet -> stats + { statBladder = 0 + } + _ -> stats case mpath of Just path -> return (Nothing, unchanged { npcMoveState = Set $ NPCWalking path + , npcStats = Set nstats }) Nothing -> return (Nothing, unchanged @@ -112,7 +131,7 @@ updateNPCs imgmat rp dt = do NPCWalking path -> if not (null path) then do - let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double + let itarget = fmap (+ 0.5) (fromIntegral <$> head path) :: V2 Double if distance pos' itarget < 0.1 then return (Nothing, unchanged @@ -125,8 +144,28 @@ updateNPCs imgmat rp dt = do else do future <- liftIO $ newEmptyMVar stat <- query anim + as <- query npcActionState + targetRPs <- case as of + ASWork -> (: []) <$> query npcWorkplace + ASToilet -> do + let seekRP = filter (\p -> pointType p == Toilet) rp + if null seekRP + then return $ filter (\p -> pointType p == Elevator) rp + else return seekRP + ASDrink -> do + let seekRP = filter (\p -> pointType p == Drink) rp + if null seekRP + then return $ filter (\p -> pointType p == Elevator) rp + else return seekRP + ASEat -> do + let seekRP = filter (\p -> pointType p == Eat) rp + if null seekRP + then return $ filter (\p -> pointType p == Elevator) rp + else return seekRP + ASRandWalk -> + return $ filter (\p -> pointType p /= RoomExit) rp _ <- liftIO $ forkIO $ - getPath (fmap floor pos') future rp imgmat posbounds + getPath (fmap floor pos') future targetRPs imgmat posbounds e <- queryEnt let mdir = pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp diff --git a/src/Types/Entity.hs b/src/Types/Entity.hs index 824e15b..610927f 100644 --- a/src/Types/Entity.hs +++ b/src/Types/Entity.hs @@ -9,6 +9,7 @@ import Types.Map import Types.NPCState import Types.Animation import Types.ObjType +import Types.ReachPoint data Entity f = Entity { pos :: Component f 'Field (V2 Double) @@ -21,7 +22,7 @@ data Entity f = Entity , obstacle :: Component f 'Field (Boundaries Double) , player :: Component f 'Unique () , npcMoveState :: Component f 'Field NPCMoveState - , npcWorkplace :: Component f 'Field Ent + , npcWorkplace :: Component f 'Field ReachPoint , npcActionState :: Component f 'Field NPCActionState , npcStats :: Component f 'Field NPCStats , anim :: Component f 'Field AnimState diff --git a/src/Types/Map.hs b/src/Types/Map.hs index df6c1a7..3aa54db 100644 --- a/src/Types/Map.hs +++ b/src/Types/Map.hs @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} module Types.Map where +import Linear (V2) + data TileState = Wall -- | Wind @@ -25,8 +27,8 @@ instance Show TileState where show Unde = " " data FloorConfig = FloorConfig - { fcElevator :: (Int, Int) - , fcFacilities :: [(Int, Int)] + { fcElevator :: V2 Int + , fcFacilities :: [V2 Int] , fcSize :: (Int, Int) } deriving (Show) diff --git a/src/Types/ReachPoint.hs b/src/Types/ReachPoint.hs index b5fce05..e1f3aba 100644 --- a/src/Types/ReachPoint.hs +++ b/src/Types/ReachPoint.hs @@ -17,4 +17,6 @@ data PointType | Computer | Toilet | Drink + | Eat + | Elevator deriving (Eq, Show)