{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module NPC where import Affection as A import qualified Data.Matrix as M import Data.Ecstasy as E import Data.Maybe import Data.List (find) import Control.Monad.IO.Class (MonadIO(..)) import Control.Concurrent.MVar import Control.Concurrent (forkIO) import Linear import System.Random -- internal imports import Util import Types import Object () placeNPCs :: M.Matrix (Maybe ImgId) -> M.Matrix TileState -> [ReachPoint] -> Int -> IO [V2 Double] placeNPCs imgmat tilemat rp count = doPlace 1 [] where doPlace :: Int -> [V2 Double] -> IO [V2 Double] doPlace nr acc = if nr <= count then do r <- randomRIO (1, M.nrows imgmat) c <- randomRIO (1, M.ncols imgmat) if null (maybe [] collisionObstacle $ imgmat M.! (r, c)) && tilemat M.! (r, c) == Hall then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc) else do i <- randomRIO (0, length nonexits - 1) doPlace (nr + 1) ((fmap fromIntegral $ pointCoord (nonexits !! i)) : acc) else return acc nonexits = filter (\p -> pointType p /= RoomExit ) rp updateNPCs :: M.Matrix (Maybe ImgId) -> [ReachPoint] -> Double -> SystemT Entity (AffectionState (AffectionData UserData) IO) () updateNPCs imgmat rp dt = do posbounds <- efor allEnts $ do with pos with obstacle pos' <- query pos bnds <- query obstacle return (pos', bnds) npcposs <- efor allEnts $ do with pos with npcMoveState with vel with rot with anim pos' <- query pos e <- queryEnt return (e, pos') eaccess <- getObjects npcposs moent <- catMaybes <$> (eover allEnts $ do with pos with npcMoveState with vel with rot with anim pos' <- query pos rot' <- query rot npcState' <- query npcMoveState case npcState' of NPCStanding ttl future -> do let nttl = ttl - dt if nttl > 0 then 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 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 _ <- liftIO $ forkIO $ getPath (fmap floor pos') future rp imgmat posbounds e <- queryEnt let mdir = (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) accessibles = fromMaybe [] $ lookup e eaccess 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 rind <- liftIO $ randomRIO (0, length objects - 1) npcent <- queryEnt let (oent, _, _) = objects !! rind return (Just (oent, npcent, future), unchanged { rot = Set $ fromMaybe rot' mdir , anim = Set stat { asId = (asId stat) { aiDirection = fromMaybe rot' mdir } } , vel = Set $ V2 0 0 })) mapM_ (\(oent, npcent, future) -> do Just (t, s) <- runQueryT oent $ do with objType with objState otyp <- query objType ostat <- query objState return (otyp, ostat) setEntity oent =<< objectTransition t s False oent Just (nt, ns) <- runQueryT oent $ do with objType with objState otyp <- query objType ostat <- query objState return (otyp, ostat) emap (anEnt npcent) $ do let ttl = actionTime nt ns return unchanged { npcMoveState = Set $ NPCStanding ttl future } ) moent getObjects :: (Monad m, Traversable t, RealFrac a1) => t (a2, V2 a1) -> SystemT Entity m (t (a2, [(Ent, V2 Double, (V2 Int, Direction))])) getObjects npcposs = 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) mapM (\(e, npos) -> return ( e , filter (\(_, p, (delta, _)) -> fmap floor p + delta == fmap floor npos ) candidates ) ) npcposs getPath :: V2 Int -> MVar [V2 Int] -> [ReachPoint] -> M.Matrix (Maybe ImgId) -> [(V2 Double, Boundaries Double)] -> IO () getPath pos' mvar rp imgmat posbounds = do let seekRP = filter (\p -> pointType p /= RoomExit) rp ntargeti <- randomRIO (0, length seekRP - 1) let ntarget = pointCoord (seekRP !! ntargeti) path = astarAppl imgmat posbounds ntarget pos' logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget) case path of Nothing -> getPath pos' mvar rp imgmat posbounds Just p -> putMVar mvar p