initial state

This commit is contained in:
nek0 2018-08-10 22:45:32 +02:00
parent 56eac65266
commit 2911514578
2 changed files with 13 additions and 9 deletions

View file

@ -6,7 +6,7 @@ import Affection as A
import qualified Data.Matrix as M
import Data.Ecstasy as E
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, fromJust)
import Data.List (find)
import Control.Monad.IO.Class (MonadIO(..))
@ -83,7 +83,7 @@ updateNPCs imgmat rp dt = do
return (e, pos', rot', mdir)
mapM_ (\(e, pos', rot', mdir) -> do
accessibles <- getObjects pos'
moent <- eover (anEnt e) $ do
moent <- runQueryT e $ do
npcState' <- query npcMoveState
case npcState' of
NPCStanding ttl future -> do
@ -165,21 +165,24 @@ updateNPCs imgmat rp dt = do
}
}
})
mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do
[(t, s)] <- efor (anEnt oent) $ do
(\(_, ent) ->
setEntity e ent
) (fromJust moent)
maybe (return()) (\(oent, npcent) -> do
Just (t, s) <- runQueryT 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
Just (nt, ns) <- runQueryT oent $ do
with objType
with objState
otyp <- query objType
ostat <- query objState
return (otyp, ostat)
emap (anEnt npcent) $ do
Just npc <- runQueryT npcent $ do
let ttl = actionTime nt ns
future <- liftIO $ newEmptyMVar
_ <- liftIO $ forkIO $
@ -188,7 +191,8 @@ updateNPCs imgmat rp dt = do
{ npcMoveState = Set $ NPCStanding ttl future
, vel = Set $ V2 0 0
}
) smoent) moent
setEntity npcent npc
) (fromJust (fst <$> moent))
) npcs
getObjects npos = do

View file

@ -3,7 +3,7 @@
{-# LANGUAGE FlexibleInstances #-}
module Object where
import Affection
import Affection as A
import Control.Monad (when)
@ -67,4 +67,4 @@ instance ObjectAction ObjType ObjState where
instance ActionTime ObjType ObjState where
actionTime ObjCopier "copying" = 5
actionTime o s = error (show o ++ ": " ++ s ++ ": has not time")
actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not time") 0