npc now walk

This commit is contained in:
nek0 2018-04-14 18:43:05 +02:00
parent 5fe266ca9c
commit a0e6ab5013
10 changed files with 151 additions and 48 deletions

View file

@ -19,6 +19,7 @@ import Util
import Types.Interior import Types.Interior
import Types.Map import Types.Map
import Types.UserData import Types.UserData
import Types.ReachPoint
placeInteriorIO placeInteriorIO
:: Matrix TileState :: Matrix TileState

View file

@ -5,6 +5,8 @@ import Affection as A
import qualified Data.Matrix as M import qualified Data.Matrix as M
import Data.Ecstasy as E import Data.Ecstasy as E
import Control.Monad.IO.Class (MonadIO(..))
import Linear import Linear
import System.Random import System.Random
@ -19,6 +21,7 @@ import Util
import Types.UserData import Types.UserData
import Types.Interior import Types.Interior
import Types.Map import Types.Map
import Types.ReachPoint
drawNPCs drawNPCs
:: Context :: Context
@ -47,11 +50,12 @@ drawNPCs ctx npcposs prow pcol row col = do
placeNPCs placeNPCs
:: M.Matrix (Maybe ImgId) :: M.Matrix (Maybe ImgId)
-> M.Matrix TileState
-> [ReachPoint] -> [ReachPoint]
-> [Graph] -> [Graph]
-> Int -> Int
-> Affection UserData [V2 Double] -> Affection UserData [V2 Double]
placeNPCs imgmat rp gr count = placeNPCs imgmat tilemat rp gr count =
doPlace 1 [] doPlace 1 []
where where
doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double] doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double]
@ -61,13 +65,77 @@ placeNPCs imgmat rp gr count =
r <- liftIO $ randomRIO (1, M.nrows imgmat) r <- liftIO $ randomRIO (1, M.nrows imgmat)
c <- liftIO $ randomRIO (1, M.ncols imgmat) c <- liftIO $ randomRIO (1, M.ncols imgmat)
if null (imgObstacle $ imgmat M.! (r, c)) && if null (imgObstacle $ imgmat M.! (r, c)) &&
isReachable imgmat [V2 r c] (exits r c) tilemat M.! (r, c) == Hall
then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc) then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc)
else doPlace nr acc else do
i <- liftIO $ randomRIO (0, length nonexits - 1)
doPlace
(nr + 1)
((fmap fromIntegral $ pointCoord (nonexits !! i)) : acc)
else else
return acc return acc
applRooms row col = applRooms row col =
filter (\r -> graphIsRoom r && inBounds (V2 row col) (bounds r)) gr (filter (\r -> graphIsRoom r && inBounds (V2 row col) (bounds r)) gr)
exits row col= concatMap (\b -> nonexits =
filter (\p -> pointType p == RoomExit && inBounds (pointCoord p) b) rp filter
) (map bounds (applRooms row col)) (\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

View file

@ -4,7 +4,6 @@ import Affection as A
import Data.Matrix as M import Data.Matrix as M
import qualified Data.HashSet as HS import qualified Data.HashSet as HS
import Data.Graph.AStar
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Linear import Linear
@ -14,28 +13,13 @@ import Linear
import Types.Map import Types.Map
import Types.UserData import Types.UserData
import Types.Interior import Types.Interior
import Types.ReachPoint
import Util
isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool
isReachable imgmat reaches exits = isReachable imgmat reaches exits =
let astarAppl ex rc = aStar let result =
(naviGraph imgmat)
(\a b -> distance (fmap fromIntegral a) (fmap fromIntegral b))
(\a -> distance (fmap fromIntegral ex) (fmap fromIntegral a))
(== ex)
rc
result =
(concatMap (concatMap
(\exit -> map (astarAppl exit) reaches) (\exit -> map (astarAppl imgmat exit) reaches)
(map pointCoord exits)) (map pointCoord exits))
in all isJust result in all isJust result
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
naviGraph imgmat (V2 r c) =
let list = foldl
(\acc (or, oc) -> if null (imgObstacle $ imgmat M.! (r + or, c + oc))
then if or == 0 && oc == 0 then acc else V2 (r + or) (c + oc): acc
else acc
)
[]
[(0, 1), (0, -1), (1, 0), (-1, 0)]
in HS.fromList list

View file

@ -17,6 +17,8 @@ import Data.Matrix as M
import Data.Ecstasy as E import Data.Ecstasy as E
import Data.Maybe import Data.Maybe
import System.Random (randomRIO)
import Linear import Linear
import Foreign.C.Types (CFloat(..)) import Foreign.C.Types (CFloat(..))
@ -50,7 +52,8 @@ loadMap = do
((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat])
-- liftIO $ A.logIO A.Debug (show exits) -- liftIO $ A.logIO A.Debug (show exits)
(inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr (inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr
npcposs <- placeNPCs inter rps gr 10 let nnex = length (Prelude.filter (\p -> pointType p == RoomExit) rps)
npcposs <- placeNPCs inter mat rps gr nnex
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
void $ newEntity $ defEntity void $ newEntity $ defEntity
{ pos = Just (V2 20.5 20.5) { pos = Just (V2 20.5 20.5)
@ -58,10 +61,11 @@ loadMap = do
, player = Just () , player = Just ()
} }
void $ mapM_ (\(V2 nr nc) -> do void $ mapM_ (\(V2 nr nc) -> do
ttl <- liftIO $ randomRIO (5, 30)
newEntity $ defEntity newEntity $ defEntity
{ pos = Just (V2 (nr + 0.5) (nc + 0.5)) { pos = Just (V2 (nr + 0.5) (nc + 0.5))
, vel = Just (V2 0 0) , vel = Just (V2 0 0)
, npc = Just () , npcState = Just (NPCStanding ttl)
} }
) npcposs ) npcposs
uu <- partSubscribe m movePlayer uu <- partSubscribe m movePlayer
@ -74,6 +78,7 @@ loadMap = do
(\a -> if a == Just ImgEmpty then Nothing else a) (\a -> if a == Just ImgEmpty then Nothing else a)
(M.toList inter) (M.toList inter)
, initCoords = (0, 500) , initCoords = (0, 500)
, reachPoints = rps
} }
, uuid = [uu] , uuid = [uu]
} }
@ -118,11 +123,13 @@ drawMap = do
(_, playerPos) <- yieldSystemT (worldState ud) $ do (_, playerPos) <- yieldSystemT (worldState ud) $ do
efor $ \_ -> do efor $ \_ -> do
with player with player
with pos
pos' <- E.get pos pos' <- E.get pos
pure pos' pure pos'
(_, npcposs) <- yieldSystemT (worldState ud) $ do (_, npcposs) <- yieldSystemT (worldState ud) $ do
efor $ \_ -> do efor $ \_ -> do
with npc with npcState
with pos
pos' <- E.get pos pos' <- E.get pos
pure pos' pure pos'
let V2 pr pc = head playerPos let V2 pr pc = head playerPos
@ -196,6 +203,13 @@ updateMap dt = do
) )
} }
return ent return ent
updateNPCs
(imgMat $ stateData ud)
(Prelude.filter
(\p -> pointType p /= RoomExit)
(reachPoints $ stateData ud)
)
dt
putAffection ud putAffection ud
{ worldState = nws { worldState = nws
} }

View file

@ -5,3 +5,4 @@ module Types
import Types.UserData as T import Types.UserData as T
import Types.Map as T import Types.Map as T
import Types.Interior as T import Types.Interior as T
import Types.ReachPoint as T

View file

@ -8,6 +8,7 @@ import Linear.V2
import Types.Map import Types.Map
import Types.UserData import Types.UserData
import Types.ReachPoint
data Cluster data Cluster
= ClusterBox1 = ClusterBox1
@ -98,14 +99,3 @@ instance Size Cluster where
size c = size c =
let mat = clusterMat c let mat = clusterMat c
in fromIntegral ((nrows mat) * (ncols mat)) in fromIntegral ((nrows mat) * (ncols mat))
data ReachPoint = ReachPoint
{ pointType :: PointType
, pointCoord :: V2 Int
}
deriving (Show)
data PointType
= RoomExit
| Table
deriving (Eq, Show)

14
src/Types/ReachPoint.hs Normal file
View file

@ -0,0 +1,14 @@
module Types.ReachPoint where
import Linear (V2(..))
data ReachPoint = ReachPoint
{ pointType :: PointType
, pointCoord :: V2 Int
}
deriving (Show)
data PointType
= RoomExit
| Table
deriving (Eq, Show)

View file

@ -15,6 +15,7 @@ import Data.Matrix
import Data.Ecstasy import Data.Ecstasy
import Types.Map import Types.Map
import Types.ReachPoint
data UserData = UserData data UserData = UserData
{ state :: State { state :: State
@ -34,9 +35,10 @@ data State
data StateData data StateData
= None = None
| MenuData | MenuData
{ mapMat :: Matrix TileState { mapMat :: Matrix TileState
, initCoords :: (Int, Int) , initCoords :: (Int, Int)
, imgMat :: Matrix (Maybe ImgId) , imgMat :: Matrix (Maybe ImgId)
, reachPoints :: [ReachPoint]
} }
data ImgId data ImgId
@ -148,11 +150,18 @@ data Entity f = Entity
, rot :: Component f 'Field Direction , rot :: Component f 'Field Direction
, obstacle :: Component f 'Field (Boundaries Double) , obstacle :: Component f 'Field (Boundaries Double)
, player :: Component f 'Unique () , player :: Component f 'Unique ()
, npc :: Component f 'Field () , npcState :: Component f 'Field NPCState
, npcPath :: Component f 'Field (Maybe [V2 Int])
} }
deriving (Generic) deriving (Generic)
data NPCState
= NPCWalking
{ npcWalkPath :: [V2 Int]
}
| NPCStanding
{ npcStandTime :: Double
}
data Subsystems = Subsystems data Subsystems = Subsystems
{ subWindow :: Window { subWindow :: Window
, subMouse :: Mouse , subMouse :: Mouse

View file

@ -3,6 +3,8 @@ module Util where
import Affection as A import Affection as A
import Data.Matrix as M import Data.Matrix as M
import qualified Data.HashSet as HS
import Data.Graph.AStar
import qualified SDL import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL hiding (get) import qualified Graphics.Rendering.OpenGL as GL hiding (get)
@ -120,3 +122,22 @@ relativizeMouseCoords (V2 ix iy) = do
inBounds :: V2 Int -> Boundaries Int -> Bool inBounds :: V2 Int -> Boundaries Int -> Bool
inBounds (V2 r c) (Boundaries (minr, minc) (maxr, maxc)) = inBounds (V2 r c) (Boundaries (minr, minc) (maxr, maxc)) =
(r >= minr && r <= maxr) && (c >= minc && c <= maxc) (r >= minr && r <= maxr) && (c >= minc && c <= maxc)
astarAppl :: Matrix (Maybe ImgId) -> V2 Int -> V2 Int -> Maybe [V2 Int]
astarAppl imgmat target start = aStar
(naviGraph imgmat)
(\a b -> distance (fmap fromIntegral a) (fmap fromIntegral b))
(\a -> distance (fmap fromIntegral target) (fmap fromIntegral a))
(== target)
start
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
naviGraph imgmat (V2 r c) =
let list = foldl
(\acc (or, oc) -> if null (imgObstacle $ imgmat M.! (r + or, c + oc))
then if or == 0 && oc == 0 then acc else V2 (r + or) (c + oc): acc
else acc
)
[]
[(0, 1), (0, -1), (1, 0), (-1, 0)]
in HS.fromList list

View file

@ -21,6 +21,7 @@ executable tracer-game
, Types.UserData , Types.UserData
, Types.Map , Types.Map
, Types.Interior , Types.Interior
, Types.ReachPoint
, StateMachine , StateMachine
, Floorplan , Floorplan
, Interior , Interior