module Game.LambdaHack.Client.State
( StateClient(..), defStateClient, defHistory
, updateTarget, getTarget, updateLeader, sside
, TgtMode(..), Target(..)
, toggleMarkVision, toggleMarkSmell, toggleMarkSuspect
) where
import Control.Monad
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import Game.LambdaHack.Common.Vector
import qualified NLP.Miniutter.English as MU
import qualified System.Random as R
import System.Time
import Game.LambdaHack.Client.Config
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Animation
import Game.LambdaHack.Common.AtomicCmd
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Key as K
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Control.Exception.Assert.Sugar
data StateClient = StateClient
{ stgtMode :: !(Maybe TgtMode)
, scursor :: !(Maybe Point)
, seps :: !Int
, stargetD :: !(EM.EnumMap ActorId Target)
, srunning :: !(Maybe (Vector, Int))
, sreport :: !Report
, shistory :: !History
, sundo :: ![Atomic]
, sdisco :: !Discovery
, sfper :: !FactionPers
, srandom :: !R.StdGen
, sconfigUI :: !ConfigUI
, slastKey :: !(Maybe K.KM)
, _sleader :: !(Maybe ActorId)
, _sside :: !FactionId
, squit :: !Bool
, sisAI :: !Bool
, smarkVision :: !Bool
, smarkSmell :: !Bool
, smarkSuspect :: !Bool
, sdebugCli :: !DebugModeCli
}
deriving (Show)
data TgtMode =
TgtExplicit { tgtLevelId :: !LevelId }
| TgtAuto { tgtLevelId :: !LevelId }
deriving (Show, Eq)
data Target =
TEnemy !ActorId !Point
| TPos !Point
deriving (Show, Eq)
defStateClient :: History -> ConfigUI -> FactionId -> Bool
-> StateClient
defStateClient shistory sconfigUI _sside sisAI =
StateClient
{ stgtMode = Nothing
, scursor = Nothing
, seps = 0
, stargetD = EM.empty
, srunning = Nothing
, sreport = emptyReport
, shistory
, sundo = []
, sdisco = EM.empty
, sfper = EM.empty
, sconfigUI
, srandom = R.mkStdGen 42
, slastKey = Nothing
, _sleader = Nothing
, _sside
, squit = False
, sisAI
, smarkVision = False
, smarkSmell = False
, smarkSuspect = False
, sdebugCli = defDebugModeCli
}
defHistory :: IO History
defHistory = do
dateTime <- getClockTime
let curDate = MU.Text $ T.pack $ calendarTimeToString $ toUTCTime dateTime
return $ singletonHistory $ singletonReport
$ makeSentence ["Human history log started on", curDate]
updateTarget :: ActorId -> (Maybe Target -> Maybe Target) -> StateClient
-> StateClient
updateTarget aid f cli = cli { stargetD = EM.alter f aid (stargetD cli) }
getTarget :: ActorId -> StateClient -> Maybe Target
getTarget aid cli = EM.lookup aid (stargetD cli)
updateLeader :: ActorId -> State -> StateClient -> StateClient
updateLeader leader s cli =
let side1 = bfid $ getActorBody leader s
side2 = sside cli
in assert (side1 == side2 `blame` "enemy actor becomes our leader"
`twith` (side1, side2, leader, s))
$ cli {_sleader = Just leader}
sside :: StateClient -> FactionId
sside = _sside
toggleMarkVision :: StateClient -> StateClient
toggleMarkVision s@StateClient{smarkVision} = s {smarkVision = not smarkVision}
toggleMarkSmell :: StateClient -> StateClient
toggleMarkSmell s@StateClient{smarkSmell} = s {smarkSmell = not smarkSmell}
toggleMarkSuspect :: StateClient -> StateClient
toggleMarkSuspect s@StateClient{smarkSuspect} =
s {smarkSuspect = not smarkSuspect}
instance Binary StateClient where
put StateClient{..} = do
put stgtMode
put scursor
put seps
put stargetD
put srunning
put sreport
put shistory
put sundo
put sdisco
put (show srandom)
put sconfigUI
put _sleader
put _sside
put sisAI
put smarkVision
put smarkSmell
put smarkSuspect
put sdebugCli
get = do
stgtMode <- get
scursor <- get
seps <- get
stargetD <- get
srunning <- get
sreport <- get
shistory <- get
sundo <- get
sdisco <- get
g <- get
sconfigUI <- get
_sleader <- get
_sside <- get
sisAI <- get
smarkVision <- get
smarkSmell <- get
smarkSuspect <- get
sdebugCli <- get
let sfper = EM.empty
srandom = read g
slastKey = Nothing
squit = False
return StateClient{..}
instance Binary TgtMode where
put (TgtExplicit l) = putWord8 0 >> put l
put (TgtAuto l) = putWord8 1 >> put l
get = do
tag <- getWord8
case tag of
0 -> liftM TgtExplicit get
1 -> liftM TgtAuto get
_ -> fail "no parse (TgtMode)"
instance Binary Target where
put (TEnemy a ll) = putWord8 0 >> put a >> put ll
put (TPos pos) = putWord8 1 >> put pos
get = do
tag <- getWord8
case tag of
0 -> liftM2 TEnemy get get
1 -> liftM TPos get
_ -> fail "no parse (Target)"