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 -> Maybe ImgId -> Affection UserData () drawNPCs ctx npcposs prow pcol row col img = do ud <- getAffection let fnpcposs = filter (\(V2 nr nc) -> let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 in ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) && ((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs && all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) || (all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs && all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) && (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 where tileWidth = 64 :: Double tileHeight = 32 :: Double mb = imgObstacle img minrs = Prelude.map (fst . matmin) mb maxrs = Prelude.map (fst . matmax) mb mincs = Prelude.map (snd . matmin) mb maxcs = Prelude.map (snd . matmax) mb 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.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget) case path of Nothing -> getPath pos' Just p -> return p