{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | The client UI session state.
module Game.LambdaHack.Client.UI.SessionUI
  ( SessionUI(..), ItemDictUI, AimMode(..), KeyMacro(..), KeyMacroFrame(..)
  , RunParams(..), ChosenLore(..)
  , emptySessionUI, emptyMacroFrame
  , toggleMarkVision, 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           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           Game.LambdaHack.Client.UI.ItemSlot
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.Item
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Definition.Defs
import qualified System.Random.SplitMix32 as SM

-- | The information that is used across a client playing session,
-- including many consecutive games in a single session.
-- Some of it is saved, some is reset when a new playing session starts.
-- An important component is the frontend session.
data SessionUI = SessionUI
  { 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 -> ItemSlots
sslots         :: ItemSlots          -- ^ map from slots 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 -> PointUI
spointer       :: PointUI       -- ^ mouse pointer position
  , 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 -> Bool
smarkVision    :: Bool          -- ^ 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 -> 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
  }

-- | 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

-- | 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 sUIOptions :: UIOptions
sUIOptions =
  $WSessionUI :: Maybe Target
-> Maybe Target
-> ActorDictUI
-> ItemDictUI
-> ItemSlots
-> Maybe (CStore, CStore)
-> ChanFrontend
-> CCUI
-> UIOptions
-> Maybe AimMode
-> Bool
-> Maybe (ItemId, CStore, Bool)
-> EnumSet ActorId
-> Maybe RunParams
-> History
-> PointUI
-> KeyMacroFrame
-> [KeyMacroFrame]
-> EnumSet ActorId
-> Int
-> Bool
-> Bool
-> Bool
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Set Msg
-> Map String Int
-> ChosenLore
-> Bool
-> Bool
-> Bool
-> POSIXTime
-> POSIXTime
-> Time
-> Int
-> Int
-> SMGen
-> SessionUI
SessionUI
    { 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
    , sslots :: ItemSlots
sslots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots (EnumMap SLore SingleItemSlots -> ItemSlots)
-> EnumMap SLore SingleItemSlots -> ItemSlots
forall a b. (a -> b) -> a -> b
$ [(SLore, SingleItemSlots)] -> EnumMap SLore SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
               ([(SLore, SingleItemSlots)] -> EnumMap SLore SingleItemSlots)
-> [(SLore, SingleItemSlots)] -> EnumMap SLore SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SLore] -> [SingleItemSlots] -> [(SLore, SingleItemSlots)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound] (SingleItemSlots -> [SingleItemSlots]
forall a. a -> [a]
repeat SingleItemSlots
forall k a. EnumMap k a
EM.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
$ "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 0
    , spointer :: PointUI
spointer = Int -> Int -> PointUI
PointUI 0 0
    , smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
emptyMacroFrame
    , smacroStack :: [KeyMacroFrame]
smacroStack = []
    , slastLost :: EnumSet ActorId
slastLost = EnumSet ActorId
forall k. EnumSet k
ES.empty
    , swaitTimes :: Int
swaitTimes = 0
    , swasAutomated :: Bool
swasAutomated = Bool
False
    , smarkVision :: Bool
smarkVision = Bool
False
    , smarkSmell :: Bool
smarkSmell = Bool
True
    , snxtScenario :: Int
snxtScenario = 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
    , 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 = 0
    , sgstart :: POSIXTime
sgstart = 0
    , sallTime :: Time
sallTime = Time
timeZero
    , snframes :: Int
snframes = 0
    , sallNframes :: Int
sallNframes = 0
    , srandomUI :: SMGen
srandomUI = Word32 -> SMGen
SM.mkSMGen 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

toggleMarkVision :: SessionUI -> SessionUI
toggleMarkVision :: SessionUI -> SessionUI
toggleMarkVision sess :: SessionUI
sess = SessionUI
sess {smarkVision :: Bool
smarkVision = Bool -> Bool
not (SessionUI -> Bool
smarkVision SessionUI
sess)}

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

cycleOverrideTut :: SessionUI -> SessionUI
cycleOverrideTut :: SessionUI -> SessionUI
cycleOverrideTut sess :: SessionUI
sess = SessionUI
sess {soverrideTut :: Maybe Bool
soverrideTut = case SessionUI -> Maybe Bool
soverrideTut SessionUI
sess of
                                Nothing -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                                Just False -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                                Just True -> Maybe Bool
forall a. Maybe a
Nothing}

getActorUI :: ActorId -> SessionUI -> ActorUI
getActorUI :: ActorId -> SessionUI -> ActorUI
getActorUI aid :: ActorId
aid sess :: 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 -> (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{..} = 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
    ItemSlots -> Put
forall t. Binary t => t -> Put
put ItemSlots
sslots
    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
$ Bool -> History -> History
archiveReport Bool
True History
shistory
      -- avoid displaying ending messages again at game start
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
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
    ItemSlots
sslots <- Get ItemSlots
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
    Bool
smarkVision <- Get Bool
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 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
$ "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 0 0
        smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
emptyMacroFrame
        smacroStack :: [a]
smacroStack = []
        slastLost :: EnumSet k
slastLost = EnumSet k
forall k. EnumSet k
ES.empty
        swaitTimes :: Int
swaitTimes = 0
        swasAutomated :: Bool
swasAutomated = 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 = 0
        sgstart :: POSIXTime
sgstart = 0
        sallTime :: Time
sallTime = Time
timeZero
        snframes :: Int
snframes = 0
        sallNframes :: Int
sallNframes = 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
$! $WSessionUI :: Maybe Target
-> Maybe Target
-> ActorDictUI
-> ItemDictUI
-> ItemSlots
-> Maybe (CStore, CStore)
-> ChanFrontend
-> CCUI
-> UIOptions
-> Maybe AimMode
-> Bool
-> Maybe (ItemId, CStore, Bool)
-> EnumSet ActorId
-> Maybe RunParams
-> History
-> PointUI
-> KeyMacroFrame
-> [KeyMacroFrame]
-> EnumSet ActorId
-> Int
-> Bool
-> Bool
-> Bool
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Set Msg
-> Map String Int
-> ChosenLore
-> Bool
-> Bool
-> Bool
-> POSIXTime
-> POSIXTime
-> Time
-> Int
-> Int
-> SMGen
-> SessionUI
SessionUI{..}

instance Binary RunParams where
  put :: RunParams -> Put
put RunParams{..} = 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
$! $WRunParams :: ActorId -> [ActorId] -> Bool -> Maybe Text -> Int -> RunParams
RunParams{..}