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
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) -

116
src/NPC.hs
View file

@ -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,33 +69,42 @@ 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
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
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 $ unchanged
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking path
}
})
Nothing ->
return $ unchanged
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCStanding 1 future
}
})
NPCWalking path -> do
pos' <- query pos
if not (null path)
@ -100,24 +112,37 @@ updateNPCs imgmat rp dt = do
let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
if distance pos' itarget < 0.1
then
return $ unchanged
return $ (Nothing, unchanged
{ npcMoveState = Set $ NPCWalking (tail path)
}
})
else
return $ unchanged
return $ (Nothing, 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
rot' <- query rot
pos' <- query pos
_ <- liftIO $ forkIO $
getPath (fmap floor pos') future rp imgmat posbounds
return $ unchanged
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
@ -126,8 +151,59 @@ updateNPCs imgmat rp dt = do
{ 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

2
src/Types/ObjClass.hs
View file

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