module Game.LambdaHack.Common.ClientCmd
( CmdClientAI(..), CmdClientUI(..)
, debugCmdClientAI, debugCmdClientUI, debugAid
, ChanServer(..), ConnServerFaction, ConnServerDict
) where
import Control.Concurrent.STM.TQueue
import qualified Data.EnumMap.Strict as EM
import Data.Text (Text)
import qualified Data.Text as T
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.AtomicCmd
import Game.LambdaHack.Common.AtomicPos
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Frontend
data CmdClientAI =
CmdAtomicAI !CmdAtomic
| CmdQueryAI !ActorId
| CmdPingAI
deriving Show
data CmdClientUI =
CmdAtomicUI !CmdAtomic
| SfxAtomicUI !SfxAtomic
| CmdQueryUI !ActorId
| CmdPingUI
deriving Show
debugCmdClientAI :: MonadActionRO m => CmdClientAI -> m Text
debugCmdClientAI cmd = case cmd of
CmdAtomicAI cmdA@PerceptionA{} -> debugPlain cmd cmdA
CmdAtomicAI cmdA@ResumeA{} -> debugPlain cmd cmdA
CmdAtomicAI cmdA@SpotTileA{} -> debugPlain cmd cmdA
CmdAtomicAI cmdA -> debugPretty cmd cmdA
CmdQueryAI aid -> debugAid aid "CmdQueryAI" cmd
CmdPingAI -> return $! tshow cmd
debugCmdClientUI :: MonadActionRO m => CmdClientUI -> m Text
debugCmdClientUI cmd = case cmd of
CmdAtomicUI cmdA@PerceptionA{} -> debugPlain cmd cmdA
CmdAtomicUI cmdA@ResumeA{} -> debugPlain cmd cmdA
CmdAtomicUI cmdA@SpotTileA{} -> debugPlain cmd cmdA
CmdAtomicUI cmdA -> debugPretty cmd cmdA
SfxAtomicUI sfx -> do
ps <- posSfxAtomic sfx
return $! tshow (cmd, ps)
CmdQueryUI aid -> debugAid aid "CmdQueryUI" cmd
CmdPingUI -> return $! tshow cmd
debugPretty :: (MonadActionRO m, Show a) => a -> CmdAtomic -> m Text
debugPretty cmd cmdA = do
ps <- posCmdAtomic cmdA
return $! tshow (cmd, ps)
debugPlain :: (MonadActionRO m, Show a) => a -> CmdAtomic -> m Text
debugPlain cmd cmdA = do
ps <- posCmdAtomic cmdA
return $! T.pack $ show (cmd, ps)
data DebugAid a = DebugAid
{ label :: !Text
, cmd :: !a
, lid :: !LevelId
, time :: !Time
, aid :: !ActorId
, faction :: !FactionId
}
deriving Show
debugAid :: (MonadActionRO m, Show a) => ActorId -> Text -> a -> m Text
debugAid aid label cmd =
if aid == toEnum (1) then
return ""
else do
b <- getsState $ getActorBody aid
time <- getsState $ getLocalTime (blid b)
return $! tshow DebugAid { label
, cmd
, lid = blid b
, time
, aid
, faction = bfid b }
data ChanServer c d = ChanServer
{ fromServer :: !(TQueue c)
, toServer :: !(TQueue d)
}
type ConnServerFaction = ( Maybe (ChanFrontend, ChanServer CmdClientUI CmdSer)
, ChanServer CmdClientAI CmdTakeTimeSer )
type ConnServerDict = EM.EnumMap FactionId ConnServerFaction