139 lines
3.7 KiB
Haskell
139 lines
3.7 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 =
|
|
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
|
|
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)
|
|
-> IO ()
|
|
getPath pos' mvar rp imgmat = do
|
|
let seekRP = filter (\p -> pointType p /= RoomExit) rp
|
|
ntargeti <- randomRIO (0, length seekRP - 1)
|
|
let ntarget = pointCoord (seekRP !! ntargeti)
|
|
path = astarAppl imgmat ntarget pos'
|
|
logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget)
|
|
case path of
|
|
Nothing -> getPath pos' mvar rp imgmat
|
|
Just p -> putMVar mvar p
|