NPCs now interact with objects!
This commit is contained in:
nek0
parent
289579470f
commit
56eac65266
3 changed files with 141 additions and 62 deletions
|
|
@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do
|
|||
let loadSteps = 20
|
||||
fc = FloorConfig
|
||||
(10, 10)
|
||||
[(5, 5), (5, 45)]
|
||||
(50, 50)
|
||||
[] -- [(5, 5), (5, 20)]
|
||||
(30, 50)
|
||||
_ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor")
|
||||
(mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps)
|
||||
_ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
|
||||
|
|
@ -320,9 +320,10 @@ drawMap = do
|
|||
pos' <- query pos
|
||||
t <- query objType
|
||||
s <- query objState
|
||||
pa <- query objPlayerActivated
|
||||
let maxt = actionTime t s
|
||||
ttl <- query objStateTime
|
||||
return (pos', realToFrac (1 - ttl / maxt))
|
||||
return (pos', pa, realToFrac (1 - ttl / maxt))
|
||||
return (pc, posanims, posActions)
|
||||
let V2 pr pc = playerPos
|
||||
mat = imgMat (stateData ud)
|
||||
|
|
@ -377,7 +378,7 @@ drawMap = do
|
|||
(\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
|
||||
(reverse $ zip [1..] ls))
|
||||
(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) +
|
||||
(sr - pr)) * (tileWidth / 2) :: CFloat
|
||||
ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) -
|
||||
|
|
|
|||
192
src/NPC.hs
192
src/NPC.hs
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
module NPC where
|
||||
|
||||
import Affection as A
|
||||
|
|
@ -21,6 +23,8 @@ import Util
|
|||
|
||||
import Types
|
||||
|
||||
import Object
|
||||
|
||||
placeNPCs
|
||||
:: M.Matrix (Maybe ImgId)
|
||||
-> M.Matrix TileState
|
||||
|
|
@ -54,11 +58,10 @@ placeNPCs imgmat tilemat rp count =
|
|||
rp
|
||||
|
||||
updateNPCs
|
||||
:: MonadIO m
|
||||
=> M.Matrix (Maybe ImgId)
|
||||
:: M.Matrix (Maybe ImgId)
|
||||
-> [ReachPoint]
|
||||
-> Double
|
||||
-> SystemT Entity m ()
|
||||
-> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
|
||||
updateNPCs imgmat rp dt = do
|
||||
posbounds <- efor allEnts $ do
|
||||
with pos
|
||||
|
|
@ -66,68 +69,141 @@ updateNPCs imgmat rp dt = do
|
|||
pos' <- query pos
|
||||
bnds <- query obstacle
|
||||
return (pos', bnds)
|
||||
emap allEnts $ do
|
||||
npcs <- efor allEnts $ do
|
||||
with npcMoveState
|
||||
with vel
|
||||
with pos
|
||||
with rot
|
||||
with anim
|
||||
npcState' <- query npcMoveState
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
let nttl = ttl - dt
|
||||
if nttl > 0
|
||||
then
|
||||
return $ unchanged
|
||||
{ npcMoveState = Set $ NPCStanding nttl future
|
||||
, vel = Set $ V2 0 0
|
||||
}
|
||||
else do
|
||||
mpath <- liftIO $ tryTakeMVar future
|
||||
case mpath of
|
||||
Just path ->
|
||||
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
|
||||
pos' <- query pos
|
||||
rot' <- query rot
|
||||
let mdir =
|
||||
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
|
||||
e <- queryEnt
|
||||
return (e, pos', rot', mdir)
|
||||
mapM_ (\(e, pos', rot', mdir) -> do
|
||||
accessibles <- getObjects pos'
|
||||
moent <- eover (anEnt e) $ do
|
||||
npcState' <- query npcMoveState
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
let nttl = ttl - dt
|
||||
if nttl > 0
|
||||
then
|
||||
return $ unchanged
|
||||
{ npcMoveState = Set $ NPCWalking (tail path)
|
||||
}
|
||||
else
|
||||
return $ unchanged
|
||||
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
|
||||
}
|
||||
else do
|
||||
ttl <- liftIO $ randomRIO (5, 30)
|
||||
future <- liftIO $ newEmptyMVar
|
||||
rot' <- query rot
|
||||
stat <- query anim
|
||||
let mdir =
|
||||
(pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
|
||||
-- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat
|
||||
_ <- liftIO $ forkIO $
|
||||
getPath (fmap floor pos') future rp imgmat posbounds
|
||||
return $ 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
|
||||
}
|
||||
}
|
||||
}
|
||||
return $ (Nothing, unchanged
|
||||
{ npcMoveState = Set $ NPCStanding nttl future
|
||||
, vel = Set $ V2 0 0
|
||||
})
|
||||
else do
|
||||
mpath <- liftIO $ tryTakeMVar future
|
||||
case mpath of
|
||||
Just path ->
|
||||
return $ (Nothing, unchanged
|
||||
{ npcMoveState = Set $ NPCWalking path
|
||||
})
|
||||
Nothing ->
|
||||
return $ (Nothing, 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
|
||||
return $ (Nothing, unchanged
|
||||
{ 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
|
||||
:: V2 Int
|
||||
|
|
|
|||
|
|
@ -1,4 +1,6 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
module Types.ObjClass where
|
||||
|
||||
import Affection
|
||||
|
|
|
|||
Loading…
Reference in a new issue