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.Map
import Types.UserData
import Types.ReachPoint
placeInteriorIO
:: Matrix TileState

View file

@ -5,6 +5,8 @@ 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
@ -19,6 +21,7 @@ import Util
import Types.UserData
import Types.Interior
import Types.Map
import Types.ReachPoint
drawNPCs
:: Context
@ -47,11 +50,12 @@ drawNPCs ctx npcposs prow pcol row col = do
placeNPCs
:: M.Matrix (Maybe ImgId)
-> M.Matrix TileState
-> [ReachPoint]
-> [Graph]
-> Int
-> Affection UserData [V2 Double]
placeNPCs imgmat rp gr count =
placeNPCs imgmat tilemat rp gr count =
doPlace 1 []
where
doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double]
@ -61,13 +65,77 @@ placeNPCs imgmat rp gr count =
r <- liftIO $ randomRIO (1, M.nrows imgmat)
c <- liftIO $ randomRIO (1, M.ncols imgmat)
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)
else doPlace nr 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
exits row col= concatMap (\b ->
filter (\p -> pointType p == RoomExit && inBounds (pointCoord p) b) rp
) (map bounds (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

View file

@ -4,7 +4,6 @@ import Affection as A
import Data.Matrix as M
import qualified Data.HashSet as HS
import Data.Graph.AStar
import Data.Maybe (isJust)
import Linear
@ -14,28 +13,13 @@ import Linear
import Types.Map
import Types.UserData
import Types.Interior
import Types.ReachPoint
import Util
isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool
isReachable imgmat reaches exits =
let astarAppl ex rc = aStar
(naviGraph imgmat)
(\a b -> distance (fmap fromIntegral a) (fmap fromIntegral b))
(\a -> distance (fmap fromIntegral ex) (fmap fromIntegral a))
(== ex)
rc
result =
let result =
(concatMap
(\exit -> map (astarAppl exit) reaches)
(\exit -> map (astarAppl imgmat exit) reaches)
(map pointCoord exits))
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.Maybe
import System.Random (randomRIO)
import Linear
import Foreign.C.Types (CFloat(..))
@ -50,7 +52,8 @@ loadMap = do
((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat])
-- liftIO $ A.logIO A.Debug (show exits)
(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
void $ newEntity $ defEntity
{ pos = Just (V2 20.5 20.5)
@ -58,10 +61,11 @@ loadMap = do
, player = Just ()
}
void $ mapM_ (\(V2 nr nc) -> do
ttl <- liftIO $ randomRIO (5, 30)
newEntity $ defEntity
{ pos = Just (V2 (nr + 0.5) (nc + 0.5))
, vel = Just (V2 0 0)
, npc = Just ()
, npcState = Just (NPCStanding ttl)
}
) npcposs
uu <- partSubscribe m movePlayer
@ -74,6 +78,7 @@ loadMap = do
(\a -> if a == Just ImgEmpty then Nothing else a)
(M.toList inter)
, initCoords = (0, 500)
, reachPoints = rps
}
, uuid = [uu]
}
@ -118,11 +123,13 @@ drawMap = do
(_, playerPos) <- yieldSystemT (worldState ud) $ do
efor $ \_ -> do
with player
with pos
pos' <- E.get pos
pure pos'
(_, npcposs) <- yieldSystemT (worldState ud) $ do
efor $ \_ -> do
with npc
with npcState
with pos
pos' <- E.get pos
pure pos'
let V2 pr pc = head playerPos
@ -196,6 +203,13 @@ updateMap dt = do
)
}
return ent
updateNPCs
(imgMat $ stateData ud)
(Prelude.filter
(\p -> pointType p /= RoomExit)
(reachPoints $ stateData ud)
)
dt
putAffection ud
{ worldState = nws
}

View file

@ -5,3 +5,4 @@ module Types
import Types.UserData as T
import Types.Map 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.UserData
import Types.ReachPoint
data Cluster
= ClusterBox1
@ -98,14 +99,3 @@ instance Size Cluster where
size c =
let mat = clusterMat c
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 Types.Map
import Types.ReachPoint
data UserData = UserData
{ state :: State
@ -37,6 +38,7 @@ data StateData
{ mapMat :: Matrix TileState
, initCoords :: (Int, Int)
, imgMat :: Matrix (Maybe ImgId)
, reachPoints :: [ReachPoint]
}
data ImgId
@ -148,11 +150,18 @@ data Entity f = Entity
, rot :: Component f 'Field Direction
, obstacle :: Component f 'Field (Boundaries Double)
, player :: Component f 'Unique ()
, npc :: Component f 'Field ()
, npcPath :: Component f 'Field (Maybe [V2 Int])
, npcState :: Component f 'Field NPCState
}
deriving (Generic)
data NPCState
= NPCWalking
{ npcWalkPath :: [V2 Int]
}
| NPCStanding
{ npcStandTime :: Double
}
data Subsystems = Subsystems
{ subWindow :: Window
, subMouse :: Mouse

View file

@ -3,6 +3,8 @@ module Util where
import Affection as A
import Data.Matrix as M
import qualified Data.HashSet as HS
import Data.Graph.AStar
import qualified SDL
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 r c) (Boundaries (minr, minc) (maxr, 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.Map
, Types.Interior
, Types.ReachPoint
, StateMachine
, Floorplan
, Interior