nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

NPCs now interact with objects!

Browse source
This commit is contained in:
nek0 2018-08-10 14:09:07 +02:00
parent 289579470f
commit 56eac65266
3 changed files with 141 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/MainGame/WorldMap.hs
View file

@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do
let loadSteps = 20 let loadSteps = 20
fc = FloorConfig fc = FloorConfig
(10, 10) (10, 10)
[(5, 5), (5, 45)] [] -- [(5, 5), (5, 20)]
(50, 50) (30, 50)
_ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor") _ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor")
(mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps) (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps)
_ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images") _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
@ -320,9 +320,10 @@ drawMap = do
pos' <- query pos pos' <- query pos
t <- query objType t <- query objType
s <- query objState s <- query objState
pa <- query objPlayerActivated
let maxt = actionTime t s let maxt = actionTime t s
ttl <- query objStateTime ttl <- query objStateTime
return (pos', realToFrac (1 - ttl / maxt)) return (pos', pa, realToFrac (1 - ttl / maxt))
return (pc, posanims, posActions) return (pc, posanims, posActions)
let V2 pr pc = playerPos let V2 pr pc = playerPos
mat = imgMat (stateData ud) mat = imgMat (stateData ud)
@ -377,7 +378,7 @@ drawMap = do
(\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
(reverse $ zip [1..] ls)) (reverse $ zip [1..] ls))
(zip [1..] (toLists mat)) (zip [1..] (toLists mat))
mapM_ (\(V2 sr sc, perc) -> do mapM_ (\(V2 sr sc, pa, perc) -> when pa $ do
let lx = realToFrac $ 640 + ((sc - pc) + let lx = realToFrac $ 640 + ((sc - pc) +
(sr - pr)) * (tileWidth / 2) :: CFloat (sr - pr)) * (tileWidth / 2) :: CFloat
ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) - ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) -

192
src/NPC.hs
View file

@ -1,3 +1,5 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module NPC where module NPC where
import Affection as A import Affection as A
@ -21,6 +23,8 @@ import Util
import Types import Types
import Object
placeNPCs placeNPCs
:: M.Matrix (Maybe ImgId) :: M.Matrix (Maybe ImgId)
-> M.Matrix TileState -> M.Matrix TileState
@ -54,11 +58,10 @@ placeNPCs imgmat tilemat rp count =
rp rp
updateNPCs updateNPCs
:: MonadIO m :: M.Matrix (Maybe ImgId)
=> M.Matrix (Maybe ImgId)
-> [ReachPoint] -> [ReachPoint]
-> Double -> Double
-> SystemT Entity m () -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
updateNPCs imgmat rp dt = do updateNPCs imgmat rp dt = do
posbounds <- efor allEnts $ do posbounds <- efor allEnts $ do
with pos with pos
@ -66,68 +69,141 @@ updateNPCs imgmat rp dt = do
pos' <- query pos pos' <- query pos
bnds <- query obstacle bnds <- query obstacle
return (pos', bnds) return (pos', bnds)
emap allEnts $ do npcs <- efor allEnts $ do
with npcMoveState with npcMoveState
with vel with vel
with pos with pos
with rot with rot
with anim with anim
npcState' <- query npcMoveState pos' <- query pos
case npcState' of rot' <- query rot
NPCStanding ttl future -> do let mdir =
let nttl = ttl - dt (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
if nttl > 0 e <- queryEnt
then return (e, pos', rot', mdir)
return $ unchanged mapM_ (\(e, pos', rot', mdir) -> do
{ npcMoveState = Set $ NPCStanding nttl future accessibles <- getObjects pos'
, vel = Set $ V2 0 0 moent <- eover (anEnt e) $ do
} npcState' <- query npcMoveState
else do case npcState' of
mpath <- liftIO $ tryTakeMVar future NPCStanding ttl future -> do
case mpath of let nttl = ttl - dt
Just path -> if nttl > 0
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 then
return $ unchanged return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking (tail path) { npcMoveState = Set $ NPCStanding nttl future
} , vel = Set $ V2 0 0
else })
return $ unchanged else do
{ vel = Set $ (* 2) <$> signorm (itarget - pos') mpath <- liftIO $ tryTakeMVar future
} case mpath of
else do Just path ->
ttl <- liftIO $ randomRIO (5, 30) return $ (Nothing, unchanged
future <- liftIO $ newEmptyMVar { npcMoveState = Set $ NPCWalking path
rot' <- query rot })
stat <- query anim Nothing ->
let mdir = return $ (Nothing, unchanged
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp) { npcMoveState = Set $ NPCStanding 1 future
-- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat })
_ <- liftIO $ forkIO $ NPCWalking path -> do
getPath (fmap floor pos') future rp imgmat posbounds pos' <- query pos
return $ unchanged if not (null path)
{ npcMoveState = Set $ NPCStanding ttl future then do
, vel = Set $ V2 0 0 let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
, rot = Set $ fromMaybe rot' mdir if distance pos' itarget < 0.1
, anim = Set stat then
{ asId = (asId stat) return $ (Nothing, unchanged
{ aiDirection = fromMaybe rot' mdir { npcMoveState = Set $ NPCWalking (tail path)
} })
} else
} return $ (Nothing, unchanged
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
})
else do
future <- liftIO $ newEmptyMVar
stat <- query anim
rot' <- query rot
pos' <- query pos
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
let mdir =
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
-- ttl <- liftIO $ randomRIO (5, 30)
-- return $ (Nothing, 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
-- }
-- }
-- })
case accessibles of
[] -> do
ttl <- liftIO $ randomRIO (5, 30)
return $ (Nothing, 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
}
}
})
objects -> do
liftIO $ logIO Debug ("applicable objects: " ++ show objects)
rind <- liftIO $ randomRIO (0, length objects - 1)
npcent <- queryEnt
let (oent, _, _) = objects !! rind
return (Just (oent, npcent), unchanged
{ rot = Set $ fromMaybe rot' mdir
, anim = Set stat
{ asId = (asId stat)
{ aiDirection = fromMaybe rot' mdir
}
}
})
mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do
[(t, s)] <- efor (anEnt oent) $ do
with objType
with objState
otyp <- query objType
ostat <- query objState
return (otyp, ostat)
setEntity oent =<< objectTransition t s False oent
[(nt, ns)] <- efor (anEnt oent) $ do
with objType
with objState
otyp <- query objType
ostat <- query objState
return (otyp, ostat)
emap (anEnt npcent) $ do
let ttl = actionTime nt ns
future <- liftIO $ newEmptyMVar
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
return unchanged
{ npcMoveState = Set $ NPCStanding ttl future
, vel = Set $ V2 0 0
}
) smoent) moent
) npcs
getObjects npos = do
candidates <- efor allEnts $ do
with pos
with objType
with objState
with objAccess
pos' <- query pos
oacc <- query objAccess
ent <- queryEnt
return (ent, pos', oacc)
return $ filter (\(_, p, (delta, _)) ->
fmap floor p + delta == fmap floor npos
) candidates
getPath getPath
:: V2 Int :: V2 Int

2
src/Types/ObjClass.hs
View file

@ -1,4 +1,6 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Types.ObjClass where module Types.ObjClass where
import Affection import Affection