module Game.LambdaHack.Client.State
( StateClient(..), defStateClient, defHistory
, updateTarget, getTarget, updateLeader, sside
, PathEtc, TgtMode(..), Target(..), RunParams(..), LastRecord
, toggleMarkVision, toggleMarkSmell, toggleMarkSuspect
) where
import Control.Exception.Assert.Sugar
import Control.Monad
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.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 qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.State
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
( PointArray.Array BfsDistance
, Point, Int, Maybe [Point]) )
, sselected :: !(ES.EnumSet ActorId)
, srunning :: !(Maybe RunParams)
, sreport :: !Report
, shistory :: !History
, sundo :: ![Atomic]
, sdisco :: !Discovery
, sfper :: !FactionPers
, srandom :: !R.StdGen
, sconfigUI :: ConfigUI
, slastKey :: !(Maybe K.KM)
, slastRecord :: !LastRecord
, slastPlay :: ![K.KM]
, slastCmd :: !(Maybe CmdTakeTimeSer)
, swaitTimes :: !Int
, _sleader :: !(Maybe ActorId)
, _sside :: !FactionId
, squit :: !Bool
, sisAI :: !Bool
, smarkVision :: !Bool
, smarkSmell :: !Bool
, smarkSuspect :: !Bool
, scurDifficulty :: !Int
, sdebugCli :: !DebugModeCli
}
deriving Show
type PathEtc = ([Point], (Point, Int))
newtype TgtMode = TgtMode { tgtLevelId :: LevelId }
deriving (Show, Eq, Binary)
data Target =
TEnemy !ActorId !Bool
| TEnemyPos !ActorId !LevelId !Point !Bool
| TPoint !LevelId !Point
| TVector !Vector
deriving (Show, Eq)
data RunParams = RunParams
{ runLeader :: !ActorId
, runMembers :: ![ActorId]
, runDist :: !Int
, runStopMsg :: !(Maybe Text)
, runInitDir :: !(Maybe Vector)
}
deriving (Show)
type LastRecord = ( [K.KM]
, [K.KM]
, Int
)
defStateClient :: History -> ConfigUI -> FactionId -> Bool
-> StateClient
defStateClient shistory sconfigUI _sside sisAI =
StateClient
{ stgtMode = Nothing
, scursor = if sisAI
then TVector $ Vector 30000 30000
else TVector $ Vector 1 1
, seps = 0
, stargetD = EM.empty
, sexplored = ES.empty
, sbfsD = EM.empty
, sselected = ES.empty
, srunning = Nothing
, sreport = emptyReport
, shistory
, sundo = []
, sdisco = EM.empty
, sfper = EM.empty
, sconfigUI
, srandom = R.mkStdGen 42
, slastKey = Nothing
, slastRecord = ([], [], 0)
, slastPlay = []
, slastCmd = Nothing
, swaitTimes = 0
, _sleader = Nothing
, _sside
, squit = False
, sisAI
, smarkVision = False
, smarkSmell = False
, smarkSuspect = False
, scurDifficulty = 0
, 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 =
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 sdisco
put (show srandom)
put _sleader
put _sside
put sisAI
put smarkVision
put smarkSmell
put smarkSuspect
put scurDifficulty
put sdebugCli
get = do
stgtMode <- get
scursor <- get
seps <- get
stargetD <- get
sexplored <- get
sselected <- get
srunning <- get
sreport <- get
shistory <- get
sundo <- get
sdisco <- get
g <- get
_sleader <- get
_sside <- get
sisAI <- get
smarkVision <- get
smarkSmell <- get
smarkSuspect <- get
scurDifficulty <- get
sdebugCli <- get
let sbfsD = EM.empty
sfper = EM.empty
srandom = read g
slastKey = Nothing
slastRecord = ([], [], 0)
slastPlay = []
slastCmd = Nothing
swaitTimes = 0
squit = False
sconfigUI = undefined
return $! StateClient{..}
instance Binary RunParams where
put RunParams{..} = do
put runLeader
put runMembers
put runDist
put runStopMsg
put runInitDir
get = do
runLeader <- get
runMembers <- get
runDist<- get
runStopMsg <- get
runInitDir <- get
return $! RunParams{..}
instance Binary Target where
put (TEnemy a permit) = putWord8 0 >> put a >> put permit
put (TEnemyPos a lid p permit) =
putWord8 1 >> put a >> put lid >> put p >> put permit
put (TPoint lid p) = putWord8 2 >> put lid >> put p
put (TVector v) = putWord8 3 >> put v
get = do
tag <- getWord8
case tag of
0 -> liftM2 TEnemy get get
1 -> liftM4 TEnemyPos get get get get
2 -> liftM2 TPoint get get
3 -> liftM TVector get
_ -> fail "no parse (Target)"