From 56eac652665e31c684cac9b8b2f5b9bc19243f8c Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 10 Aug 2018 14:09:07 +0200 Subject: [PATCH] NPCs now interact with objects! --- src/MainGame/WorldMap.hs | 9 +- src/NPC.hs | 192 +++++++++++++++++++++++++++------------ src/Types/ObjClass.hs | 2 + 3 files changed, 141 insertions(+), 62 deletions(-) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 768edbe..c6e4175 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do let loadSteps = 20 fc = FloorConfig (10, 10) - [(5, 5), (5, 45)] - (50, 50) + [] -- [(5, 5), (5, 20)] + (30, 50) _ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor") (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps) _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images") @@ -320,9 +320,10 @@ drawMap = do pos' <- query pos t <- query objType s <- query objState + pa <- query objPlayerActivated let maxt = actionTime t s ttl <- query objStateTime - return (pos', realToFrac (1 - ttl / maxt)) + return (pos', pa, realToFrac (1 - ttl / maxt)) return (pc, posanims, posActions) let V2 pr pc = playerPos mat = imgMat (stateData ud) @@ -377,7 +378,7 @@ drawMap = do (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) (reverse $ zip [1..] ls)) (zip [1..] (toLists mat)) - mapM_ (\(V2 sr sc, perc) -> do + mapM_ (\(V2 sr sc, pa, perc) -> when pa $ do let lx = realToFrac $ 640 + ((sc - pc) + (sr - pr)) * (tileWidth / 2) :: CFloat ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) - diff --git a/src/NPC.hs b/src/NPC.hs index 0680a18..28ad51d 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module NPC where import Affection as A @@ -21,6 +23,8 @@ import Util import Types +import Object + placeNPCs :: M.Matrix (Maybe ImgId) -> M.Matrix TileState @@ -54,11 +58,10 @@ placeNPCs imgmat tilemat rp count = rp updateNPCs - :: MonadIO m - => M.Matrix (Maybe ImgId) + :: M.Matrix (Maybe ImgId) -> [ReachPoint] -> Double - -> SystemT Entity m () + -> SystemT Entity (AffectionState (AffectionData UserData) IO) () updateNPCs imgmat rp dt = do posbounds <- efor allEnts $ do with pos @@ -66,68 +69,141 @@ updateNPCs imgmat rp dt = do pos' <- query pos bnds <- query obstacle return (pos', bnds) - emap allEnts $ do + npcs <- efor allEnts $ do with npcMoveState with vel with pos with rot with anim - npcState' <- query npcMoveState - case npcState' of - NPCStanding ttl future -> do - let nttl = ttl - dt - if nttl > 0 - then - return $ unchanged - { npcMoveState = Set $ NPCStanding nttl future - , vel = Set $ V2 0 0 - } - else do - mpath <- liftIO $ tryTakeMVar future - case mpath of - Just path -> - return $ unchanged - { npcMoveState = Set $ NPCWalking path - } - Nothing -> - return $ unchanged - { npcMoveState = Set $ NPCStanding 1 future - } - NPCWalking path -> do - pos' <- query pos - if not (null path) - then do - let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double - if distance pos' itarget < 0.1 + pos' <- query pos + rot' <- query rot + let mdir = + (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) + e <- queryEnt + return (e, pos', rot', mdir) + mapM_ (\(e, pos', rot', mdir) -> do + accessibles <- getObjects pos' + moent <- eover (anEnt e) $ do + npcState' <- query npcMoveState + case npcState' of + NPCStanding ttl future -> do + let nttl = ttl - dt + if nttl > 0 then - return $ unchanged - { npcMoveState = Set $ NPCWalking (tail path) - } - else - return $ unchanged - { vel = Set $ (* 2) <$> signorm (itarget - pos') - } - else do - ttl <- liftIO $ randomRIO (5, 30) - future <- liftIO $ newEmptyMVar - rot' <- query rot - stat <- query anim - let mdir = - (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) - -- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat - _ <- liftIO $ forkIO $ - getPath (fmap floor pos') future rp imgmat posbounds - return $ unchanged - { npcMoveState = Set $ NPCStanding ttl future - , vel = Set $ V2 0 0 - , rot = Set $ fromMaybe rot' mdir - , anim = Set stat - { asId = (asId stat) - { aiDirection = fromMaybe rot' mdir - } - } - } + return $ (Nothing, unchanged + { npcMoveState = Set $ NPCStanding nttl future + , vel = Set $ V2 0 0 + }) + else do + mpath <- liftIO $ tryTakeMVar future + case mpath of + Just path -> + return $ (Nothing, unchanged + { npcMoveState = Set $ NPCWalking path + }) + Nothing -> + return $ (Nothing, unchanged + { npcMoveState = Set $ NPCStanding 1 future + }) + NPCWalking path -> do + pos' <- query pos + if not (null path) + then do + let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double + if distance pos' itarget < 0.1 + then + return $ (Nothing, unchanged + { npcMoveState = Set $ NPCWalking (tail path) + }) + else + return $ (Nothing, unchanged + { vel = Set $ (* 2) <$> signorm (itarget - pos') + }) + else do + future <- liftIO $ newEmptyMVar + stat <- query anim + rot' <- query rot + pos' <- query pos + _ <- liftIO $ forkIO $ + getPath (fmap floor pos') future rp imgmat posbounds + let mdir = + (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) + -- ttl <- liftIO $ randomRIO (5, 30) + -- return $ (Nothing, unchanged + -- { npcMoveState = Set $ NPCStanding ttl future + -- , vel = Set $ V2 0 0 + -- , rot = Set $ fromMaybe rot' mdir + -- , anim = Set stat + -- { asId = (asId stat) + -- { aiDirection = fromMaybe rot' mdir + -- } + -- } + -- }) + case accessibles of + [] -> do + ttl <- liftIO $ randomRIO (5, 30) + return $ (Nothing, unchanged + { npcMoveState = Set $ NPCStanding ttl future + , vel = Set $ V2 0 0 + , rot = Set $ fromMaybe rot' mdir + , anim = Set stat + { asId = (asId stat) + { aiDirection = fromMaybe rot' mdir + } + } + }) + objects -> do + liftIO $ logIO Debug ("applicable objects: " ++ show objects) + rind <- liftIO $ randomRIO (0, length objects - 1) + npcent <- queryEnt + let (oent, _, _) = objects !! rind + return (Just (oent, npcent), unchanged + { rot = Set $ fromMaybe rot' mdir + , anim = Set stat + { asId = (asId stat) + { aiDirection = fromMaybe rot' mdir + } + } + }) + mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do + [(t, s)] <- efor (anEnt oent) $ do + with objType + with objState + otyp <- query objType + ostat <- query objState + return (otyp, ostat) + setEntity oent =<< objectTransition t s False oent + [(nt, ns)] <- efor (anEnt oent) $ do + with objType + with objState + otyp <- query objType + ostat <- query objState + return (otyp, ostat) + emap (anEnt npcent) $ do + let ttl = actionTime nt ns + future <- liftIO $ newEmptyMVar + _ <- liftIO $ forkIO $ + getPath (fmap floor pos') future rp imgmat posbounds + return unchanged + { npcMoveState = Set $ NPCStanding ttl future + , vel = Set $ V2 0 0 + } + ) smoent) moent + ) npcs +getObjects npos = do + candidates <- efor allEnts $ do + with pos + with objType + with objState + with objAccess + pos' <- query pos + oacc <- query objAccess + ent <- queryEnt + return (ent, pos', oacc) + return $ filter (\(_, p, (delta, _)) -> + fmap floor p + delta == fmap floor npos + ) candidates getPath :: V2 Int diff --git a/src/Types/ObjClass.hs b/src/Types/ObjClass.hs index d2d9008..f97b745 100644 --- a/src/Types/ObjClass.hs +++ b/src/Types/ObjClass.hs @@ -1,4 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module Types.ObjClass where import Affection