{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | The client UI session state.
module Game.LambdaHack.Client.UI.SessionUI
  ( SessionUI(..), ReqDelay(..), ItemDictUI, ItemRoles(..), AimMode(..)
  , KeyMacro(..), KeyMacroFrame(..), RunParams(..), ChosenLore(..)
  , emptySessionUI, emptyMacroFrame
  , cycleMarkVision, toggleMarkSmell, cycleOverrideTut, getActorUI
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import           Data.Time.Clock.POSIX
import           GHC.Generics (Generic)
import qualified System.Random.SplitMix32 as SM

import           Game.LambdaHack.Client.Request
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.EffectDescription (DetailLevel (..))
import           Game.LambdaHack.Client.UI.Frontend
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.PointUI
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ModeKind (ModeKind)
import           Game.LambdaHack.Definition.Defs

-- | The information that is used across a human player playing session,
-- including many consecutive games in a single session,
-- including playing different teams. Some of it is saved, some is reset
-- when a new playing session starts. Nothing is tied to a faction/team,
-- but instead all to UI configuration and UI input and display history.
-- An important component is the frontend session.
data SessionUI = SessionUI
  { SessionUI -> Maybe RequestUI
sreqPending    :: Maybe RequestUI
                                    -- ^ request created by a UI query
                                    --   but not yet sent to the server
  , SessionUI -> ReqDelay
sreqDelay      :: ReqDelay      -- ^ server delayed sending query to client
                                    --   or receiving request from client
  , SessionUI -> Bool
sreqQueried    :: Bool          -- ^ player is now queried for a command
  , SessionUI -> Bool
sregainControl :: Bool          -- ^ player requested to regain control
                                    --   from AI ASAP
  , SessionUI -> Maybe Target
sxhair         :: Maybe Target  -- ^ the common xhair
  , SessionUI -> Maybe Target
sxhairGoTo     :: Maybe Target  -- ^ xhair set for last GoTo
  , SessionUI -> ActorDictUI
sactorUI       :: ActorDictUI   -- ^ assigned actor UI presentations
  , SessionUI -> ItemDictUI
sitemUI        :: ItemDictUI    -- ^ assigned item first seen level
  , SessionUI -> ItemRoles
sroles         :: ItemRoles     -- ^ assignment of roles to items
  , SessionUI -> Maybe (CStore, CStore)
slastItemMove  :: Maybe (CStore, CStore)
                                    -- ^ last item move stores
  , SessionUI -> ChanFrontend
schanF         :: ChanFrontend  -- ^ connection with the frontend
  , SessionUI -> CCUI
sccui          :: CCUI          -- ^ UI client content
  , SessionUI -> UIOptions
sUIOptions     :: UIOptions     -- ^ UI options as set by the player
  , SessionUI -> Maybe AimMode
saimMode       :: Maybe AimMode -- ^ aiming mode
  , SessionUI -> Bool
sxhairMoused   :: Bool          -- ^ last mouse aiming not vacuus
  , SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel       :: Maybe (ItemId, CStore, Bool)
                                    -- ^ selected item, if any, it's store and
                                    --   whether to override suitability check
  , SessionUI -> EnumSet ActorId
sselected      :: ES.EnumSet ActorId
                                    -- ^ the set of currently selected actors
  , SessionUI -> Maybe RunParams
srunning       :: Maybe RunParams
                                    -- ^ parameters of the current run, if any
  , SessionUI -> History
shistory       :: History       -- ^ history of messages
  , SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories     :: EM.EnumMap (ContentId ModeKind) (M.Map Challenge Int)
      -- ^ the number of games won by the UI faction per game mode
      --   and per difficulty level
  , SessionUI -> EnumSet (ContentId ModeKind)
scampings      :: ES.EnumSet (ContentId ModeKind)  -- ^ camped games
  , SessionUI -> EnumSet (ContentId ModeKind)
srestarts      :: ES.EnumSet (ContentId ModeKind)  -- ^ restarted games
  , SessionUI -> PointUI
spointer       :: PointUI       -- ^ mouse pointer position
  , SessionUI -> Bool
sautoYes       :: Bool          -- ^ whether to auto-clear prompts
  , SessionUI -> KeyMacroFrame
smacroFrame    :: KeyMacroFrame -- ^ the head of the key macro stack
  , SessionUI -> [KeyMacroFrame]
smacroStack    :: [KeyMacroFrame]
                                    -- ^ the tail of the key macro stack
  , SessionUI -> EnumSet ActorId
slastLost      :: ES.EnumSet ActorId
                                    -- ^ actors that just got out of sight
  , SessionUI -> Int
swaitTimes     :: Int           -- ^ player just waited this many times
  , SessionUI -> Bool
swasAutomated  :: Bool          -- ^ the player just exited AI automation
  , SessionUI -> Int
smarkVision    :: Int           -- ^ mark leader and party FOV
  , SessionUI -> Bool
smarkSmell     :: Bool          -- ^ mark smell, if the leader can smell
  , SessionUI -> Int
snxtScenario   :: Int           -- ^ next game scenario number
  , SessionUI -> Bool
scurTutorial   :: Bool          -- ^ whether current game is a tutorial
  , SessionUI -> Bool
snxtTutorial   :: Bool          -- ^ whether next game is to be tutorial
  , SessionUI -> Maybe Bool
soverrideTut   :: Maybe Bool    -- ^ override display of tutorial hints
  , SessionUI -> Set Msg
susedHints     :: S.Set Msg     -- ^ tutorial hints already shown this game
  , SessionUI -> Bool
smuteMessages  :: Bool          -- ^ whether to mute all new messages
  , SessionUI -> Map String Int
smenuIxMap     :: M.Map String Int
                                    -- ^ indices of last used menu items
  , SessionUI -> ChosenLore
schosenLore    :: ChosenLore    -- ^ last lore chosen to display
  , SessionUI -> Bool
sdisplayNeeded :: Bool          -- ^ current level needs displaying
  , SessionUI -> Bool
sturnDisplayed :: Bool          -- ^ a frame was already displayed this turn
  , SessionUI -> Bool
sreportNull    :: Bool          -- ^ whether no visible report created
                                    --   last UI faction turn or the report
                                    --   wiped out from screen since
  , SessionUI -> POSIXTime
sstart         :: POSIXTime     -- ^ this session start time
  , SessionUI -> POSIXTime
sgstart        :: POSIXTime     -- ^ this game start time
  , SessionUI -> Time
sallTime       :: Time          -- ^ clips from start of session
                                    --   to current game start
  , SessionUI -> Int
snframes       :: Int           -- ^ this game current frame count
  , SessionUI -> Int
sallNframes    :: Int           -- ^ frame count from start of session
                                    --   to current game start
  , SessionUI -> SMGen
srandomUI      :: SM.SMGen      -- ^ current random generator for UI
  }

data ReqDelay = ReqDelayNot | ReqDelayHandled | ReqDelayAlarm
  deriving ReqDelay -> ReqDelay -> Bool
(ReqDelay -> ReqDelay -> Bool)
-> (ReqDelay -> ReqDelay -> Bool) -> Eq ReqDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReqDelay -> ReqDelay -> Bool
$c/= :: ReqDelay -> ReqDelay -> Bool
== :: ReqDelay -> ReqDelay -> Bool
$c== :: ReqDelay -> ReqDelay -> Bool
Eq

-- | Local macro buffer frame. Predefined macros have their own in-game macro
-- buffer, allowing them to record in-game macro, queue actions and repeat
-- the last macro's action.
-- Running predefined macro pushes new @KeyMacroFrame@ onto the stack. We pop
-- buffers from the stack if locally there are no actions pending to be handled.
data KeyMacroFrame = KeyMacroFrame
  { KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer :: Either [K.KM] KeyMacro -- ^ record keystrokes in Left;
                                             --   repeat from Right
  , KeyMacroFrame -> KeyMacro
keyPending     :: KeyMacro               -- ^ actions pending to be handled
  , KeyMacroFrame -> Maybe KM
keyLast        :: Maybe K.KM             -- ^ last pressed key
  } deriving Int -> KeyMacroFrame -> ShowS
[KeyMacroFrame] -> ShowS
KeyMacroFrame -> String
(Int -> KeyMacroFrame -> ShowS)
-> (KeyMacroFrame -> String)
-> ([KeyMacroFrame] -> ShowS)
-> Show KeyMacroFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMacroFrame] -> ShowS
$cshowList :: [KeyMacroFrame] -> ShowS
show :: KeyMacroFrame -> String
$cshow :: KeyMacroFrame -> String
showsPrec :: Int -> KeyMacroFrame -> ShowS
$cshowsPrec :: Int -> KeyMacroFrame -> ShowS
Show

-- This can stay a map forever, not a vector, because it's added to often,
-- but never read from, except when the user requests item details.
type ItemDictUI = EM.EnumMap ItemId LevelId

-- | A collection of item identifier sets indicating what roles (possibly many)
-- an item has assigned.
newtype ItemRoles = ItemRoles (EM.EnumMap SLore (ES.EnumSet ItemId))
  deriving (Int -> ItemRoles -> ShowS
[ItemRoles] -> ShowS
ItemRoles -> String
(Int -> ItemRoles -> ShowS)
-> (ItemRoles -> String)
-> ([ItemRoles] -> ShowS)
-> Show ItemRoles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemRoles] -> ShowS
$cshowList :: [ItemRoles] -> ShowS
show :: ItemRoles -> String
$cshow :: ItemRoles -> String
showsPrec :: Int -> ItemRoles -> ShowS
$cshowsPrec :: Int -> ItemRoles -> ShowS
Show, Get ItemRoles
[ItemRoles] -> Put
ItemRoles -> Put
(ItemRoles -> Put)
-> Get ItemRoles -> ([ItemRoles] -> Put) -> Binary ItemRoles
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ItemRoles] -> Put
$cputList :: [ItemRoles] -> Put
get :: Get ItemRoles
$cget :: Get ItemRoles
put :: ItemRoles -> Put
$cput :: ItemRoles -> Put
Binary)

-- | Current aiming mode of a client.
data AimMode = AimMode
  { AimMode -> LevelId
aimLevelId  :: LevelId
  , AimMode -> DetailLevel
detailLevel :: DetailLevel
  }
  deriving (Int -> AimMode -> ShowS
[AimMode] -> ShowS
AimMode -> String
(Int -> AimMode -> ShowS)
-> (AimMode -> String) -> ([AimMode] -> ShowS) -> Show AimMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AimMode] -> ShowS
$cshowList :: [AimMode] -> ShowS
show :: AimMode -> String
$cshow :: AimMode -> String
showsPrec :: Int -> AimMode -> ShowS
$cshowsPrec :: Int -> AimMode -> ShowS
Show, AimMode -> AimMode -> Bool
(AimMode -> AimMode -> Bool)
-> (AimMode -> AimMode -> Bool) -> Eq AimMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AimMode -> AimMode -> Bool
$c/= :: AimMode -> AimMode -> Bool
== :: AimMode -> AimMode -> Bool
$c== :: AimMode -> AimMode -> Bool
Eq, (forall x. AimMode -> Rep AimMode x)
-> (forall x. Rep AimMode x -> AimMode) -> Generic AimMode
forall x. Rep AimMode x -> AimMode
forall x. AimMode -> Rep AimMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AimMode x -> AimMode
$cfrom :: forall x. AimMode -> Rep AimMode x
Generic)

instance Binary AimMode

-- | In-game macros. We record menu navigation keystrokes and keystrokes
-- bound to commands with one exception --- we exclude keys that invoke
-- the @Record@ command, to avoid surprises.
-- Keys are kept in the same order in which they're meant to be replayed,
-- i.e. the first element of the list is replayed also as the first one.
newtype KeyMacro = KeyMacro {KeyMacro -> [KM]
unKeyMacro :: [K.KM]}
  deriving (Int -> KeyMacro -> ShowS
[KeyMacro] -> ShowS
KeyMacro -> String
(Int -> KeyMacro -> ShowS)
-> (KeyMacro -> String) -> ([KeyMacro] -> ShowS) -> Show KeyMacro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMacro] -> ShowS
$cshowList :: [KeyMacro] -> ShowS
show :: KeyMacro -> String
$cshow :: KeyMacro -> String
showsPrec :: Int -> KeyMacro -> ShowS
$cshowsPrec :: Int -> KeyMacro -> ShowS
Show, KeyMacro -> KeyMacro -> Bool
(KeyMacro -> KeyMacro -> Bool)
-> (KeyMacro -> KeyMacro -> Bool) -> Eq KeyMacro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMacro -> KeyMacro -> Bool
$c/= :: KeyMacro -> KeyMacro -> Bool
== :: KeyMacro -> KeyMacro -> Bool
$c== :: KeyMacro -> KeyMacro -> Bool
Eq, Get KeyMacro
[KeyMacro] -> Put
KeyMacro -> Put
(KeyMacro -> Put)
-> Get KeyMacro -> ([KeyMacro] -> Put) -> Binary KeyMacro
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [KeyMacro] -> Put
$cputList :: [KeyMacro] -> Put
get :: Get KeyMacro
$cget :: Get KeyMacro
put :: KeyMacro -> Put
$cput :: KeyMacro -> Put
Binary, b -> KeyMacro -> KeyMacro
NonEmpty KeyMacro -> KeyMacro
KeyMacro -> KeyMacro -> KeyMacro
(KeyMacro -> KeyMacro -> KeyMacro)
-> (NonEmpty KeyMacro -> KeyMacro)
-> (forall b. Integral b => b -> KeyMacro -> KeyMacro)
-> Semigroup KeyMacro
forall b. Integral b => b -> KeyMacro -> KeyMacro
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> KeyMacro -> KeyMacro
$cstimes :: forall b. Integral b => b -> KeyMacro -> KeyMacro
sconcat :: NonEmpty KeyMacro -> KeyMacro
$csconcat :: NonEmpty KeyMacro -> KeyMacro
<> :: KeyMacro -> KeyMacro -> KeyMacro
$c<> :: KeyMacro -> KeyMacro -> KeyMacro
Semigroup, Semigroup KeyMacro
KeyMacro
Semigroup KeyMacro
-> KeyMacro
-> (KeyMacro -> KeyMacro -> KeyMacro)
-> ([KeyMacro] -> KeyMacro)
-> Monoid KeyMacro
[KeyMacro] -> KeyMacro
KeyMacro -> KeyMacro -> KeyMacro
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [KeyMacro] -> KeyMacro
$cmconcat :: [KeyMacro] -> KeyMacro
mappend :: KeyMacro -> KeyMacro -> KeyMacro
$cmappend :: KeyMacro -> KeyMacro -> KeyMacro
mempty :: KeyMacro
$cmempty :: KeyMacro
$cp1Monoid :: Semigroup KeyMacro
Monoid)

-- | Parameters of the current run.
data RunParams = RunParams
  { RunParams -> ActorId
runLeader  :: ActorId         -- ^ the original leader from run start
  , RunParams -> [ActorId]
runMembers :: [ActorId]       -- ^ the list of actors that take part
  , RunParams -> Bool
runInitial :: Bool            -- ^ initial run continuation by any
                                  --   run participant, including run leader
  , RunParams -> Maybe Text
runStopMsg :: Maybe Text      -- ^ message with the next stop reason
  , RunParams -> Int
runWaiting :: Int             -- ^ waiting for others to move out of the way
  }
  deriving Int -> RunParams -> ShowS
[RunParams] -> ShowS
RunParams -> String
(Int -> RunParams -> ShowS)
-> (RunParams -> String)
-> ([RunParams] -> ShowS)
-> Show RunParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunParams] -> ShowS
$cshowList :: [RunParams] -> ShowS
show :: RunParams -> String
$cshow :: RunParams -> String
showsPrec :: Int -> RunParams -> ShowS
$cshowsPrec :: Int -> RunParams -> ShowS
Show

-- | Last lore being aimed at.
data ChosenLore =
    ChosenLore [(ActorId, Actor)] [(ItemId, ItemQuant)]
  | ChosenNothing

emptySessionUI :: UIOptions -> SessionUI
emptySessionUI :: UIOptions -> SessionUI
emptySessionUI UIOptions
sUIOptions =
  SessionUI :: Maybe RequestUI
-> ReqDelay
-> Bool
-> Bool
-> Maybe Target
-> Maybe Target
-> ActorDictUI
-> ItemDictUI
-> ItemRoles
-> Maybe (CStore, CStore)
-> ChanFrontend
-> CCUI
-> UIOptions
-> Maybe AimMode
-> Bool
-> Maybe (ItemId, CStore, Bool)
-> EnumSet ActorId
-> Maybe RunParams
-> History
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> EnumSet (ContentId ModeKind)
-> EnumSet (ContentId ModeKind)
-> PointUI
-> Bool
-> KeyMacroFrame
-> [KeyMacroFrame]
-> EnumSet ActorId
-> Int
-> Bool
-> Int
-> Bool
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Set Msg
-> Bool
-> Map String Int
-> ChosenLore
-> Bool
-> Bool
-> Bool
-> POSIXTime
-> POSIXTime
-> Time
-> Int
-> Int
-> SMGen
-> SessionUI
SessionUI
    { sreqPending :: Maybe RequestUI
sreqPending = Maybe RequestUI
forall a. Maybe a
Nothing
    , sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayNot
    , sreqQueried :: Bool
sreqQueried = Bool
False
    , sregainControl :: Bool
sregainControl = Bool
False
    , sxhair :: Maybe Target
sxhair = Maybe Target
forall a. Maybe a
Nothing
    , sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
forall a. Maybe a
Nothing
    , sactorUI :: ActorDictUI
sactorUI = ActorDictUI
forall k a. EnumMap k a
EM.empty
    , sitemUI :: ItemDictUI
sitemUI = ItemDictUI
forall k a. EnumMap k a
EM.empty
    , sroles :: ItemRoles
sroles = EnumMap SLore (EnumSet ItemId) -> ItemRoles
ItemRoles (EnumMap SLore (EnumSet ItemId) -> ItemRoles)
-> EnumMap SLore (EnumSet ItemId) -> ItemRoles
forall a b. (a -> b) -> a -> b
$ [(SLore, EnumSet ItemId)] -> EnumMap SLore (EnumSet ItemId)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
               ([(SLore, EnumSet ItemId)] -> EnumMap SLore (EnumSet ItemId))
-> [(SLore, EnumSet ItemId)] -> EnumMap SLore (EnumSet ItemId)
forall a b. (a -> b) -> a -> b
$ [SLore] -> [EnumSet ItemId] -> [(SLore, EnumSet ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound] (EnumSet ItemId -> [EnumSet ItemId]
forall a. a -> [a]
repeat EnumSet ItemId
forall k. EnumSet k
ES.empty)
    , slastItemMove :: Maybe (CStore, CStore)
slastItemMove = Maybe (CStore, CStore)
forall a. Maybe a
Nothing
    , schanF :: ChanFrontend
schanF = (forall a. FrontReq a -> IO a) -> ChanFrontend
ChanFrontend ((forall a. FrontReq a -> IO a) -> ChanFrontend)
-> (forall a. FrontReq a -> IO a) -> ChanFrontend
forall a b. (a -> b) -> a -> b
$ IO a -> FrontReq a -> IO a
forall a b. a -> b -> a
const (IO a -> FrontReq a -> IO a) -> IO a -> FrontReq a -> IO a
forall a b. (a -> b) -> a -> b
$
        String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"emptySessionUI: ChanFrontend" String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()
    , sccui :: CCUI
sccui = CCUI
emptyCCUI
    , UIOptions
sUIOptions :: UIOptions
sUIOptions :: UIOptions
sUIOptions
    , saimMode :: Maybe AimMode
saimMode = Maybe AimMode
forall a. Maybe a
Nothing
    , sxhairMoused :: Bool
sxhairMoused = Bool
True
    , sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing
    , sselected :: EnumSet ActorId
sselected = EnumSet ActorId
forall k. EnumSet k
ES.empty
    , srunning :: Maybe RunParams
srunning = Maybe RunParams
forall a. Maybe a
Nothing
    , shistory :: History
shistory = Int -> History
emptyHistory Int
0
    , svictories :: EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories = EnumMap (ContentId ModeKind) (Map Challenge Int)
forall k a. EnumMap k a
EM.empty
    , scampings :: EnumSet (ContentId ModeKind)
scampings = EnumSet (ContentId ModeKind)
forall k. EnumSet k
ES.empty
    , srestarts :: EnumSet (ContentId ModeKind)
srestarts = EnumSet (ContentId ModeKind)
forall k. EnumSet k
ES.empty
    , spointer :: PointUI
spointer = Int -> Int -> PointUI
PointUI Int
0 Int
0
    , sautoYes :: Bool
sautoYes = Bool
False
    , smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
emptyMacroFrame
    , smacroStack :: [KeyMacroFrame]
smacroStack = []
    , slastLost :: EnumSet ActorId
slastLost = EnumSet ActorId
forall k. EnumSet k
ES.empty
    , swaitTimes :: Int
swaitTimes = Int
0
    , swasAutomated :: Bool
swasAutomated = Bool
False
    , smarkVision :: Int
smarkVision = Int
1
    , smarkSmell :: Bool
smarkSmell = Bool
True
    , snxtScenario :: Int
snxtScenario = Int
0
    , scurTutorial :: Bool
scurTutorial = Bool
False
    , snxtTutorial :: Bool
snxtTutorial = Bool
True  -- matches @snxtScenario = 0@
    , soverrideTut :: Maybe Bool
soverrideTut = Maybe Bool
forall a. Maybe a
Nothing
    , susedHints :: Set Msg
susedHints = Set Msg
forall a. Set a
S.empty
    , smuteMessages :: Bool
smuteMessages = Bool
False
    , smenuIxMap :: Map String Int
smenuIxMap = Map String Int
forall k a. Map k a
M.empty
    , schosenLore :: ChosenLore
schosenLore = ChosenLore
ChosenNothing
    , sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False
    , sturnDisplayed :: Bool
sturnDisplayed = Bool
False
    , sreportNull :: Bool
sreportNull = Bool
True
    , sstart :: POSIXTime
sstart = POSIXTime
0
    , sgstart :: POSIXTime
sgstart = POSIXTime
0
    , sallTime :: Time
sallTime = Time
timeZero
    , snframes :: Int
snframes = Int
0
    , sallNframes :: Int
sallNframes = Int
0
    , srandomUI :: SMGen
srandomUI = Word32 -> SMGen
SM.mkSMGen Word32
0
    }

emptyMacroFrame :: KeyMacroFrame
emptyMacroFrame :: KeyMacroFrame
emptyMacroFrame = Either [KM] KeyMacro -> KeyMacro -> Maybe KM -> KeyMacroFrame
KeyMacroFrame (KeyMacro -> Either [KM] KeyMacro
forall a b. b -> Either a b
Right KeyMacro
forall a. Monoid a => a
mempty) KeyMacro
forall a. Monoid a => a
mempty Maybe KM
forall a. Maybe a
Nothing

cycleMarkVision :: Int -> SessionUI -> SessionUI
cycleMarkVision :: Int -> SessionUI -> SessionUI
cycleMarkVision Int
delta SessionUI
sess =
  SessionUI
sess {smarkVision :: Int
smarkVision = (SessionUI -> Int
smarkVision SessionUI
sess Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3}

toggleMarkSmell :: SessionUI -> SessionUI
toggleMarkSmell :: SessionUI -> SessionUI
toggleMarkSmell SessionUI
sess = SessionUI
sess {smarkSmell :: Bool
smarkSmell = Bool -> Bool
not (SessionUI -> Bool
smarkSmell SessionUI
sess)}

cycleOverrideTut :: Int -> SessionUI -> SessionUI
cycleOverrideTut :: Int -> SessionUI -> SessionUI
cycleOverrideTut Int
delta SessionUI
sess =
  let ordering :: [Maybe Bool]
ordering = [Maybe Bool] -> [Maybe Bool]
forall a. [a] -> [a]
cycle [Maybe Bool
forall a. Maybe a
Nothing, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True]
  in SessionUI
sess {soverrideTut :: Maybe Bool
soverrideTut =
    let ix :: Int
ix = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> [Maybe Bool] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (SessionUI -> Maybe Bool
soverrideTut SessionUI
sess) [Maybe Bool]
ordering
    in [Maybe Bool]
ordering [Maybe Bool] -> Int -> Maybe Bool
forall a. [a] -> Int -> a
!! (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta)}

getActorUI :: ActorId -> SessionUI -> ActorUI
getActorUI :: ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid SessionUI
sess =
  ActorUI -> ActorId -> ActorDictUI -> ActorUI
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault (String -> ActorUI
forall a. HasCallStack => String -> a
error (String -> ActorUI) -> String -> ActorUI
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ActorId, ActorDictUI) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, SessionUI -> ActorDictUI
sactorUI SessionUI
sess)) ActorId
aid
  (ActorDictUI -> ActorUI) -> ActorDictUI -> ActorUI
forall a b. (a -> b) -> a -> b
$ SessionUI -> ActorDictUI
sactorUI SessionUI
sess

instance Binary SessionUI where
  put :: SessionUI -> Put
put SessionUI{Bool
Int
[KeyMacroFrame]
Maybe Bool
Maybe (CStore, CStore)
Maybe RequestUI
Maybe (ItemId, CStore, Bool)
Maybe Target
Maybe RunParams
Maybe AimMode
Map String Int
Set Msg
EnumMap (ContentId ModeKind) (Map Challenge Int)
ActorDictUI
ItemDictUI
EnumSet (ContentId ModeKind)
EnumSet ActorId
SMGen
POSIXTime
Time
PointUI
History
UIOptions
ChanFrontend
CCUI
ChosenLore
ItemRoles
KeyMacroFrame
ReqDelay
srandomUI :: SMGen
sallNframes :: Int
snframes :: Int
sallTime :: Time
sgstart :: POSIXTime
sstart :: POSIXTime
sreportNull :: Bool
sturnDisplayed :: Bool
sdisplayNeeded :: Bool
schosenLore :: ChosenLore
smenuIxMap :: Map String Int
smuteMessages :: Bool
susedHints :: Set Msg
soverrideTut :: Maybe Bool
snxtTutorial :: Bool
scurTutorial :: Bool
snxtScenario :: Int
smarkSmell :: Bool
smarkVision :: Int
swasAutomated :: Bool
swaitTimes :: Int
slastLost :: EnumSet ActorId
smacroStack :: [KeyMacroFrame]
smacroFrame :: KeyMacroFrame
sautoYes :: Bool
spointer :: PointUI
srestarts :: EnumSet (ContentId ModeKind)
scampings :: EnumSet (ContentId ModeKind)
svictories :: EnumMap (ContentId ModeKind) (Map Challenge Int)
shistory :: History
srunning :: Maybe RunParams
sselected :: EnumSet ActorId
sitemSel :: Maybe (ItemId, CStore, Bool)
sxhairMoused :: Bool
saimMode :: Maybe AimMode
sUIOptions :: UIOptions
sccui :: CCUI
schanF :: ChanFrontend
slastItemMove :: Maybe (CStore, CStore)
sroles :: ItemRoles
sitemUI :: ItemDictUI
sactorUI :: ActorDictUI
sxhairGoTo :: Maybe Target
sxhair :: Maybe Target
sregainControl :: Bool
sreqQueried :: Bool
sreqDelay :: ReqDelay
sreqPending :: Maybe RequestUI
srandomUI :: SessionUI -> SMGen
sallNframes :: SessionUI -> Int
snframes :: SessionUI -> Int
sallTime :: SessionUI -> Time
sgstart :: SessionUI -> POSIXTime
sstart :: SessionUI -> POSIXTime
sreportNull :: SessionUI -> Bool
sturnDisplayed :: SessionUI -> Bool
sdisplayNeeded :: SessionUI -> Bool
schosenLore :: SessionUI -> ChosenLore
smenuIxMap :: SessionUI -> Map String Int
smuteMessages :: SessionUI -> Bool
susedHints :: SessionUI -> Set Msg
soverrideTut :: SessionUI -> Maybe Bool
snxtTutorial :: SessionUI -> Bool
scurTutorial :: SessionUI -> Bool
snxtScenario :: SessionUI -> Int
smarkSmell :: SessionUI -> Bool
smarkVision :: SessionUI -> Int
swasAutomated :: SessionUI -> Bool
swaitTimes :: SessionUI -> Int
slastLost :: SessionUI -> EnumSet ActorId
smacroStack :: SessionUI -> [KeyMacroFrame]
smacroFrame :: SessionUI -> KeyMacroFrame
sautoYes :: SessionUI -> Bool
spointer :: SessionUI -> PointUI
srestarts :: SessionUI -> EnumSet (ContentId ModeKind)
scampings :: SessionUI -> EnumSet (ContentId ModeKind)
svictories :: SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
shistory :: SessionUI -> History
srunning :: SessionUI -> Maybe RunParams
sselected :: SessionUI -> EnumSet ActorId
sitemSel :: SessionUI -> Maybe (ItemId, CStore, Bool)
sxhairMoused :: SessionUI -> Bool
saimMode :: SessionUI -> Maybe AimMode
sUIOptions :: SessionUI -> UIOptions
sccui :: SessionUI -> CCUI
schanF :: SessionUI -> ChanFrontend
slastItemMove :: SessionUI -> Maybe (CStore, CStore)
sroles :: SessionUI -> ItemRoles
sitemUI :: SessionUI -> ItemDictUI
sactorUI :: SessionUI -> ActorDictUI
sxhairGoTo :: SessionUI -> Maybe Target
sxhair :: SessionUI -> Maybe Target
sregainControl :: SessionUI -> Bool
sreqQueried :: SessionUI -> Bool
sreqDelay :: SessionUI -> ReqDelay
sreqPending :: SessionUI -> Maybe RequestUI
..} = do
    Maybe Target -> Put
forall t. Binary t => t -> Put
put Maybe Target
sxhair
    ActorDictUI -> Put
forall t. Binary t => t -> Put
put ActorDictUI
sactorUI
    ItemDictUI -> Put
forall t. Binary t => t -> Put
put ItemDictUI
sitemUI
    ItemRoles -> Put
forall t. Binary t => t -> Put
put ItemRoles
sroles
    UIOptions -> Put
forall t. Binary t => t -> Put
put UIOptions
sUIOptions
    Maybe AimMode -> Put
forall t. Binary t => t -> Put
put Maybe AimMode
saimMode
    Maybe (ItemId, CStore, Bool) -> Put
forall t. Binary t => t -> Put
put Maybe (ItemId, CStore, Bool)
sitemSel
    EnumSet ActorId -> Put
forall t. Binary t => t -> Put
put EnumSet ActorId
sselected
    Maybe RunParams -> Put
forall t. Binary t => t -> Put
put Maybe RunParams
srunning
    History -> Put
forall t. Binary t => t -> Put
put (History -> Put) -> History -> Put
forall a b. (a -> b) -> a -> b
$ History -> History
archiveReport History
shistory
      -- avoid displaying ending messages again at game start
    EnumMap (ContentId ModeKind) (Map Challenge Int) -> Put
forall t. Binary t => t -> Put
put EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
    EnumSet (ContentId ModeKind) -> Put
forall t. Binary t => t -> Put
put EnumSet (ContentId ModeKind)
scampings
    EnumSet (ContentId ModeKind) -> Put
forall t. Binary t => t -> Put
put EnumSet (ContentId ModeKind)
srestarts
    Int -> Put
forall t. Binary t => t -> Put
put Int
smarkVision
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
smarkSmell
    Int -> Put
forall t. Binary t => t -> Put
put Int
snxtScenario
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
scurTutorial
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
snxtTutorial
    Maybe Bool -> Put
forall t. Binary t => t -> Put
put Maybe Bool
soverrideTut
    Set Msg -> Put
forall t. Binary t => t -> Put
put Set Msg
susedHints
    String -> Put
forall t. Binary t => t -> Put
put (SMGen -> String
forall a. Show a => a -> String
show SMGen
srandomUI)
  get :: Get SessionUI
get = do
    Maybe Target
sxhair <- Get (Maybe Target)
forall t. Binary t => Get t
get
    ActorDictUI
sactorUI <- Get ActorDictUI
forall t. Binary t => Get t
get
    ItemDictUI
sitemUI <- Get ItemDictUI
forall t. Binary t => Get t
get
    ItemRoles
sroles <- Get ItemRoles
forall t. Binary t => Get t
get
    UIOptions
sUIOptions <- Get UIOptions
forall t. Binary t => Get t
get  -- is overwritten ASAP, but useful for, e.g., crash debug
    Maybe AimMode
saimMode <- Get (Maybe AimMode)
forall t. Binary t => Get t
get
    Maybe (ItemId, CStore, Bool)
sitemSel <- Get (Maybe (ItemId, CStore, Bool))
forall t. Binary t => Get t
get
    EnumSet ActorId
sselected <- Get (EnumSet ActorId)
forall t. Binary t => Get t
get
    Maybe RunParams
srunning <- Get (Maybe RunParams)
forall t. Binary t => Get t
get
    History
shistory <- Get History
forall t. Binary t => Get t
get
    EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- Get (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall t. Binary t => Get t
get
    EnumSet (ContentId ModeKind)
scampings <- Get (EnumSet (ContentId ModeKind))
forall t. Binary t => Get t
get
    EnumSet (ContentId ModeKind)
srestarts <- Get (EnumSet (ContentId ModeKind))
forall t. Binary t => Get t
get
    Int
smarkVision <- Get Int
forall t. Binary t => Get t
get
    Bool
smarkSmell <- Get Bool
forall t. Binary t => Get t
get
    Int
snxtScenario <- Get Int
forall t. Binary t => Get t
get
    Bool
scurTutorial <- Get Bool
forall t. Binary t => Get t
get
    Bool
snxtTutorial <- Get Bool
forall t. Binary t => Get t
get
    Maybe Bool
soverrideTut <- Get (Maybe Bool)
forall t. Binary t => Get t
get
    Set Msg
susedHints <- Get (Set Msg)
forall t. Binary t => Get t
get
    String
g <- Get String
forall t. Binary t => Get t
get
    let sreqPending :: Maybe a
sreqPending = Maybe a
forall a. Maybe a
Nothing
        sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayNot
        sreqQueried :: Bool
sreqQueried = Bool
False
        sregainControl :: Bool
sregainControl = Bool
False
        sxhairGoTo :: Maybe a
sxhairGoTo = Maybe a
forall a. Maybe a
Nothing
        slastItemMove :: Maybe a
slastItemMove = Maybe a
forall a. Maybe a
Nothing
        schanF :: ChanFrontend
schanF = (forall a. FrontReq a -> IO a) -> ChanFrontend
ChanFrontend ((forall a. FrontReq a -> IO a) -> ChanFrontend)
-> (forall a. FrontReq a -> IO a) -> ChanFrontend
forall a b. (a -> b) -> a -> b
$ IO a -> FrontReq a -> IO a
forall a b. a -> b -> a
const (IO a -> FrontReq a -> IO a) -> IO a -> FrontReq a -> IO a
forall a b. (a -> b) -> a -> b
$
          String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Binary: ChanFrontend" String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()
        sccui :: CCUI
sccui = CCUI
emptyCCUI
        sxhairMoused :: Bool
sxhairMoused = Bool
True
        spointer :: PointUI
spointer = Int -> Int -> PointUI
PointUI Int
0 Int
0
        sautoYes :: Bool
sautoYes = Bool
False
        smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
emptyMacroFrame
        smacroStack :: [a]
smacroStack = []
        slastLost :: EnumSet k
slastLost = EnumSet k
forall k. EnumSet k
ES.empty
        swaitTimes :: Int
swaitTimes = Int
0
        swasAutomated :: Bool
swasAutomated = Bool
False
        smuteMessages :: Bool
smuteMessages = Bool
False
        smenuIxMap :: Map k a
smenuIxMap = Map k a
forall k a. Map k a
M.empty
        schosenLore :: ChosenLore
schosenLore = ChosenLore
ChosenNothing
        sdisplayNeeded :: Bool
sdisplayNeeded = Bool
False  -- displayed regardless
        sturnDisplayed :: Bool
sturnDisplayed = Bool
False
        sreportNull :: Bool
sreportNull = Bool
True
        sstart :: POSIXTime
sstart = POSIXTime
0
        sgstart :: POSIXTime
sgstart = POSIXTime
0
        sallTime :: Time
sallTime = Time
timeZero
        snframes :: Int
snframes = Int
0
        sallNframes :: Int
sallNframes = Int
0
        srandomUI :: SMGen
srandomUI = String -> SMGen
forall a. Read a => String -> a
read String
g
    SessionUI -> Get SessionUI
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionUI -> Get SessionUI) -> SessionUI -> Get SessionUI
forall a b. (a -> b) -> a -> b
$! SessionUI :: Maybe RequestUI
-> ReqDelay
-> Bool
-> Bool
-> Maybe Target
-> Maybe Target
-> ActorDictUI
-> ItemDictUI
-> ItemRoles
-> Maybe (CStore, CStore)
-> ChanFrontend
-> CCUI
-> UIOptions
-> Maybe AimMode
-> Bool
-> Maybe (ItemId, CStore, Bool)
-> EnumSet ActorId
-> Maybe RunParams
-> History
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> EnumSet (ContentId ModeKind)
-> EnumSet (ContentId ModeKind)
-> PointUI
-> Bool
-> KeyMacroFrame
-> [KeyMacroFrame]
-> EnumSet ActorId
-> Int
-> Bool
-> Int
-> Bool
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Set Msg
-> Bool
-> Map String Int
-> ChosenLore
-> Bool
-> Bool
-> Bool
-> POSIXTime
-> POSIXTime
-> Time
-> Int
-> Int
-> SMGen
-> SessionUI
SessionUI{Bool
Int
[KeyMacroFrame]
Maybe Bool
Maybe (CStore, CStore)
Maybe RequestUI
Maybe (ItemId, CStore, Bool)
Maybe Target
Maybe RunParams
Maybe AimMode
Map String Int
Set Msg
EnumMap (ContentId ModeKind) (Map Challenge Int)
ActorDictUI
ItemDictUI
EnumSet (ContentId ModeKind)
EnumSet ActorId
SMGen
POSIXTime
Time
PointUI
History
UIOptions
ChanFrontend
CCUI
ChosenLore
ItemRoles
KeyMacroFrame
ReqDelay
forall a. [a]
forall a. Maybe a
forall k. EnumSet k
forall k a. Map k a
srandomUI :: SMGen
sallNframes :: Int
snframes :: Int
sallTime :: Time
sgstart :: POSIXTime
sstart :: POSIXTime
sreportNull :: Bool
sturnDisplayed :: Bool
sdisplayNeeded :: Bool
schosenLore :: ChosenLore
smenuIxMap :: forall k a. Map k a
smuteMessages :: Bool
swasAutomated :: Bool
swaitTimes :: Int
slastLost :: forall k. EnumSet k
smacroStack :: forall a. [a]
smacroFrame :: KeyMacroFrame
sautoYes :: Bool
spointer :: PointUI
sxhairMoused :: Bool
sccui :: CCUI
schanF :: ChanFrontend
slastItemMove :: forall a. Maybe a
sxhairGoTo :: forall a. Maybe a
sregainControl :: Bool
sreqQueried :: Bool
sreqDelay :: ReqDelay
sreqPending :: forall a. Maybe a
susedHints :: Set Msg
soverrideTut :: Maybe Bool
snxtTutorial :: Bool
scurTutorial :: Bool
snxtScenario :: Int
smarkSmell :: Bool
smarkVision :: Int
srestarts :: EnumSet (ContentId ModeKind)
scampings :: EnumSet (ContentId ModeKind)
svictories :: EnumMap (ContentId ModeKind) (Map Challenge Int)
shistory :: History
srunning :: Maybe RunParams
sselected :: EnumSet ActorId
sitemSel :: Maybe (ItemId, CStore, Bool)
saimMode :: Maybe AimMode
sUIOptions :: UIOptions
sroles :: ItemRoles
sitemUI :: ItemDictUI
sactorUI :: ActorDictUI
sxhair :: Maybe Target
srandomUI :: SMGen
sallNframes :: Int
snframes :: Int
sallTime :: Time
sgstart :: POSIXTime
sstart :: POSIXTime
sreportNull :: Bool
sturnDisplayed :: Bool
sdisplayNeeded :: Bool
schosenLore :: ChosenLore
smenuIxMap :: Map String Int
smuteMessages :: Bool
susedHints :: Set Msg
soverrideTut :: Maybe Bool
snxtTutorial :: Bool
scurTutorial :: Bool
snxtScenario :: Int
smarkSmell :: Bool
smarkVision :: Int
swasAutomated :: Bool
swaitTimes :: Int
slastLost :: EnumSet ActorId
smacroStack :: [KeyMacroFrame]
smacroFrame :: KeyMacroFrame
sautoYes :: Bool
spointer :: PointUI
srestarts :: EnumSet (ContentId ModeKind)
scampings :: EnumSet (ContentId ModeKind)
svictories :: EnumMap (ContentId ModeKind) (Map Challenge Int)
shistory :: History
srunning :: Maybe RunParams
sselected :: EnumSet ActorId
sitemSel :: Maybe (ItemId, CStore, Bool)
sxhairMoused :: Bool
saimMode :: Maybe AimMode
sUIOptions :: UIOptions
sccui :: CCUI
schanF :: ChanFrontend
slastItemMove :: Maybe (CStore, CStore)
sroles :: ItemRoles
sitemUI :: ItemDictUI
sactorUI :: ActorDictUI
sxhairGoTo :: Maybe Target
sxhair :: Maybe Target
sregainControl :: Bool
sreqQueried :: Bool
sreqDelay :: ReqDelay
sreqPending :: Maybe RequestUI
..}

instance Binary RunParams where
  put :: RunParams -> Put
put RunParams{Bool
Int
[ActorId]
Maybe Text
ActorId
runWaiting :: Int
runStopMsg :: Maybe Text
runInitial :: Bool
runMembers :: [ActorId]
runLeader :: ActorId
runWaiting :: RunParams -> Int
runStopMsg :: RunParams -> Maybe Text
runInitial :: RunParams -> Bool
runMembers :: RunParams -> [ActorId]
runLeader :: RunParams -> ActorId
..} = do
    ActorId -> Put
forall t. Binary t => t -> Put
put ActorId
runLeader
    [ActorId] -> Put
forall t. Binary t => t -> Put
put [ActorId]
runMembers
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
runInitial
    Maybe Text -> Put
forall t. Binary t => t -> Put
put Maybe Text
runStopMsg
    Int -> Put
forall t. Binary t => t -> Put
put Int
runWaiting
  get :: Get RunParams
get = do
    ActorId
runLeader <- Get ActorId
forall t. Binary t => Get t
get
    [ActorId]
runMembers <- Get [ActorId]
forall t. Binary t => Get t
get
    Bool
runInitial <- Get Bool
forall t. Binary t => Get t
get
    Maybe Text
runStopMsg <- Get (Maybe Text)
forall t. Binary t => Get t
get
    Int
runWaiting <- Get Int
forall t. Binary t => Get t
get
    RunParams -> Get RunParams
forall (m :: * -> *) a. Monad m => a -> m a
return (RunParams -> Get RunParams) -> RunParams -> Get RunParams
forall a b. (a -> b) -> a -> b
$! RunParams :: ActorId -> [ActorId] -> Bool -> Maybe Text -> Int -> RunParams
RunParams{Bool
Int
[ActorId]
Maybe Text
ActorId
runWaiting :: Int
runStopMsg :: Maybe Text
runInitial :: Bool
runMembers :: [ActorId]
runLeader :: ActorId
runWaiting :: Int
runStopMsg :: Maybe Text
runInitial :: Bool
runMembers :: [ActorId]
runLeader :: ActorId
..}