tracer/src/NPC.hs
2018-04-14 18:43:05 +02:00

142 lines
3.5 KiB
Haskell

module NPC where
import Affection as A
import qualified Data.Matrix as M
import Data.Ecstasy as E
import Control.Monad.IO.Class (MonadIO(..))
import Linear
import System.Random
import NanoVG hiding (V2(..))
-- internal imports
import Navigation
import Util
import Types.UserData
import Types.Interior
import Types.Map
import Types.ReachPoint
drawNPCs
:: Context
-> [V2 Double]
-> Double
-> Double
-> Int
-> Int
-> Affection UserData ()
drawNPCs ctx npcposs prow pcol row col = do
ud <- getAffection
let fnpcposs = filter
(\(V2 nr nc) -> floor nr == row && floor nc == col)
npcposs
liftIO $ mapM_
(\(V2 nr nc) -> do
let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
beginPath ctx
circle ctx x y 5
closePath ctx
fillColor ctx (rgba 255 0 0 255)
fill ctx
)
fnpcposs
placeNPCs
:: M.Matrix (Maybe ImgId)
-> M.Matrix TileState
-> [ReachPoint]
-> [Graph]
-> Int
-> Affection UserData [V2 Double]
placeNPCs imgmat tilemat rp gr count =
doPlace 1 []
where
doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double]
doPlace nr acc = do
if nr <= count
then do
r <- liftIO $ randomRIO (1, M.nrows imgmat)
c <- liftIO $ randomRIO (1, M.ncols imgmat)
if null (imgObstacle $ imgmat M.! (r, c)) &&
tilemat M.! (r, c) == Hall
then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc)
else do
i <- liftIO $ randomRIO (0, length nonexits - 1)
doPlace
(nr + 1)
((fmap fromIntegral $ pointCoord (nonexits !! i)) : acc)
else
return acc
applRooms row col =
(filter (\r -> graphIsRoom r && inBounds (V2 row col) (bounds r)) gr)
nonexits =
filter
(\p ->
pointType p /= RoomExit
)
rp
updateNPCs
:: MonadIO m
=> M.Matrix (Maybe ImgId)
-> [ReachPoint]
-> Double
-> SystemT Entity m ()
updateNPCs imgmat rp dt =
emap $ do
with npcState
with vel
with pos
npcState' <- E.get npcState
case npcState' of
NPCStanding ttl -> do
let nttl = ttl - dt
if nttl > 0
then
return $ defEntity'
{ npcState = Set $ NPCStanding nttl
, vel = Set $ V2 0 0
}
else do
pos' <- E.get pos
path <- liftIO $ getPath (fmap floor pos')
return $ defEntity'
{ npcState = Set $ NPCWalking path
}
NPCWalking path -> do
pos' <- E.get 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 $ defEntity'
{ npcState = Set $ NPCWalking (tail path)
}
else
return $ defEntity'
{ vel = Set $ (* 0.5) <$> signorm (itarget - pos')
}
else do
ttl <- liftIO $ randomRIO (5, 30)
return $ defEntity'
{ npcState = Set $ NPCStanding ttl
}
where
getPath pos' = 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.Debug ("seeking path from " ++ show pos' ++ " to " ++ show ntarget)
case path of
Nothing -> getPath pos'
Just p -> return p