module NPC where import Affection as A import qualified Data.Matrix as M import Data.Ecstasy as E import Data.Maybe (fromMaybe) 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 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 :: MonadIO m => M.Matrix (Maybe ImgId) -> [ReachPoint] -> Double -> SystemT Entity m () updateNPCs imgmat rp dt = do posbounds <- efor allEnts $ do with pos with obstacle pos' <- query pos bnds <- query obstacle return (pos', bnds) emap 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 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 } } } 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