tracer/src/NPC.hs
2018-07-21 21:10:32 +02:00

148 lines
3.9 KiB
Haskell

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