module Game.LambdaHack.Client.State
( StateClient(..), defStateClient, defaultHistory
, updateTarget, getTarget, updateLeader, sside
, PathEtc, TgtMode(..), RunParams(..), LastRecord, EscAI(..)
, toggleMarkVision, toggleMarkSmell, toggleMarkSuspect
) where
import Control.Exception.Assert.Sugar
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Text (Text)
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import qualified System.Random as R
import System.Time
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.ItemSlot
import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
data StateClient = StateClient
{ stgtMode :: !(Maybe TgtMode)
, scursor :: !Target
, seps :: !Int
, stargetD :: !(EM.EnumMap ActorId (Target, Maybe PathEtc))
, sexplored :: !(ES.EnumSet LevelId)
, sbfsD :: !(EM.EnumMap ActorId
( Bool, PointArray.Array BfsDistance
, Point, Int, Maybe [Point]) )
, sselected :: !(ES.EnumSet ActorId)
, srunning :: !(Maybe RunParams)
, sreport :: !Report
, shistory :: !History
, sdisplayed :: !(EM.EnumMap LevelId Time)
, sundo :: ![CmdAtomic]
, sdiscoKind :: !DiscoveryKind
, sdiscoEffect :: !DiscoveryEffect
, sfper :: !FactionPers
, srandom :: !R.StdGen
, slastKM :: !K.KM
, slastRecord :: !LastRecord
, slastPlay :: ![K.KM]
, slastLost :: !(ES.EnumSet ActorId)
, swaitTimes :: !Int
, _sleader :: !(Maybe ActorId)
, _sside :: !FactionId
, squit :: !Bool
, sisAI :: !Bool
, smarkVision :: !Bool
, smarkSmell :: !Bool
, smarkSuspect :: !Bool
, scurDiff :: !Int
, snxtDiff :: !Int
, sslots :: !ItemSlots
, slastSlot :: !SlotChar
, slastStore :: !CStore
, sescAI :: !EscAI
, sdebugCli :: !DebugModeCli
}
deriving Show
type PathEtc = ([Point], (Point, Int))
newtype TgtMode = TgtMode { tgtLevelId :: LevelId }
deriving (Show, Eq, Binary)
data RunParams = RunParams
{ runLeader :: !ActorId
, runMembers :: ![ActorId]
, runInitial :: !Bool
, runStopMsg :: !(Maybe Text)
, runWaiting :: !Int
}
deriving (Show)
type LastRecord = ( [K.KM]
, [K.KM]
, Int
)
data EscAI = EscAINothing | EscAIStarted | EscAIMenu | EscAIExited
deriving (Show, Eq)
defStateClient :: History -> Report -> FactionId -> Bool -> StateClient
defStateClient shistory sreport _sside sisAI =
StateClient
{ stgtMode = Nothing
, scursor = if sisAI
then TVector $ Vector 30000 30000
else TVector $ Vector 1 1
, seps = fromEnum _sside
, stargetD = EM.empty
, sexplored = ES.empty
, sbfsD = EM.empty
, sselected = ES.empty
, srunning = Nothing
, sreport
, shistory
, sdisplayed = EM.empty
, sundo = []
, sdiscoKind = EM.empty
, sdiscoEffect = EM.empty
, sfper = EM.empty
, srandom = R.mkStdGen 42
, slastKM = K.escKM
, slastRecord = ([], [], 0)
, slastPlay = []
, slastLost = ES.empty
, swaitTimes = 0
, _sleader = Nothing
, _sside
, squit = False
, sisAI
, smarkVision = False
, smarkSmell = True
, smarkSuspect = False
, scurDiff = difficultyDefault
, snxtDiff = difficultyDefault
, sslots = (EM.empty, EM.empty)
, slastSlot = SlotChar 0 'Z'
, slastStore = CInv
, sescAI = EscAINothing
, sdebugCli = defDebugModeCli
}
defaultHistory :: Int -> IO History
defaultHistory configHistoryMax = do
dateTime <- getClockTime
let curDate = MU.Text $ T.pack $ calendarTimeToString $ toUTCTime dateTime
let emptyHist = emptyHistory configHistoryMax
return $! addReport emptyHist timeZero
$! singletonReport
$! makeSentence ["Human history log started on", curDate]
updateTarget :: ActorId -> (Maybe Target -> Maybe Target) -> StateClient
-> StateClient
updateTarget aid f cli =
let f2 tp = case f $ fmap fst tp of
Nothing -> Nothing
Just tgt -> Just (tgt, Nothing)
in cli {stargetD = EM.alter f2 aid (stargetD cli)}
getTarget :: ActorId -> StateClient -> Maybe Target
getTarget aid cli = fmap fst $ 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 sexplored
put sselected
put srunning
put sreport
put shistory
put sundo
put sdisplayed
put sdiscoKind
put sdiscoEffect
put (show srandom)
put _sleader
put _sside
put sisAI
put smarkVision
put smarkSmell
put smarkSuspect
put scurDiff
put snxtDiff
put sslots
put slastSlot
put slastStore
put sdebugCli
get = do
stgtMode <- get
scursor <- get
seps <- get
stargetD <- get
sexplored <- get
sselected <- get
srunning <- get
sreport <- get
shistory <- get
sundo <- get
sdisplayed <- get
sdiscoKind <- get
sdiscoEffect <- get
g <- get
_sleader <- get
_sside <- get
sisAI <- get
smarkVision <- get
smarkSmell <- get
smarkSuspect <- get
scurDiff <- get
snxtDiff <- get
sslots <- get
slastSlot <- get
slastStore <- get
sdebugCli <- get
let sbfsD = EM.empty
sfper = EM.empty
srandom = read g
slastKM = K.escKM
slastRecord = ([], [], 0)
slastPlay = []
slastLost = ES.empty
swaitTimes = 0
squit = False
sescAI = EscAINothing
return $! StateClient{..}
instance Binary RunParams where
put RunParams{..} = do
put runLeader
put runMembers
put runInitial
put runStopMsg
put runWaiting
get = do
runLeader <- get
runMembers <- get
runInitial <- get
runStopMsg <- get
runWaiting <- get
return $! RunParams{..}