{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Client.UI.SessionUI
( SessionUI(..), emptySessionUI
, AimMode(..), RunParams(..), LastRecord, KeysHintMode(..)
, toggleMarkVision, toggleMarkSmell, getActorUI
) where
import Prelude ()
import Game.LambdaHack.Common.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 Data.Time.Clock.POSIX
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Config
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.KeyBindings
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
data SessionUI = SessionUI
{ sxhair :: Target
, sactorUI :: ActorDictUI
, sslots :: ItemSlots
, slastSlot :: SlotChar
, slastItemMove :: Maybe (CStore, CStore)
, schanF :: ChanFrontend
, sbinding :: Binding
, sconfig :: Config
, saimMode :: Maybe AimMode
, sxhairMoused :: Bool
, sitemSel :: Maybe (CStore, ItemId)
, sselected :: ES.EnumSet ActorId
, srunning :: Maybe RunParams
, _sreport :: Report
, shistory :: History
, spointer :: Point
, slastRecord :: LastRecord
, slastPlay :: [K.KM]
, slastLost :: ES.EnumSet ActorId
, swaitTimes :: Int
, smarkVision :: Bool
, smarkSmell :: Bool
, smenuIxMap :: M.Map String Int
, sdisplayNeeded :: Bool
, skeysHintMode :: KeysHintMode
, sstart :: POSIXTime
, sgstart :: POSIXTime
, sallTime :: Time
, snframes :: Int
, sallNframes :: Int
}
newtype AimMode = AimMode { aimLevelId :: 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 KeysHintMode =
KeysHintBlocked
| KeysHintAbsent
| KeysHintPresent
deriving (Eq, Enum, Bounded)
emptySessionUI :: Config -> SessionUI
emptySessionUI sconfig =
SessionUI
{ sxhair = TVector $ Vector 0 0
, sactorUI = EM.empty
, sslots = ItemSlots EM.empty EM.empty
, slastSlot = SlotChar 0 'Z'
, slastItemMove = Nothing
, schanF = ChanFrontend $ const $
error $ "emptySessionUI: ChanFrontend" `showFailure` ()
, sbinding = Binding M.empty [] M.empty
, sconfig
, saimMode = Nothing
, sxhairMoused = True
, sitemSel = Nothing
, sselected = ES.empty
, srunning = Nothing
, _sreport = emptyReport
, shistory = emptyHistory 0
, spointer = originPoint
, slastRecord = ([], [], 0)
, slastPlay = []
, slastLost = ES.empty
, swaitTimes = 0
, smarkVision = False
, smarkSmell = True
, smenuIxMap = M.singleton "main" 2
, sdisplayNeeded = False
, skeysHintMode = KeysHintPresent
, sstart = 0
, sgstart = 0
, sallTime = timeZero
, snframes = 0
, sallNframes = 0
}
toggleMarkVision :: SessionUI -> SessionUI
toggleMarkVision s@SessionUI{smarkVision} = s {smarkVision = not smarkVision}
toggleMarkSmell :: SessionUI -> SessionUI
toggleMarkSmell s@SessionUI{smarkSmell} = s {smarkSmell = not smarkSmell}
getActorUI :: ActorId -> SessionUI -> ActorUI
getActorUI aid sess =
EM.findWithDefault (error $ "" `showFailure` (aid, sactorUI sess)) aid
$ sactorUI sess
instance Binary SessionUI where
put SessionUI{..} = do
put sxhair
put sactorUI
put sslots
put slastSlot
put sconfig
put saimMode
put sitemSel
put sselected
put srunning
put _sreport
put shistory
put smarkVision
put smarkSmell
put sdisplayNeeded
get = do
sxhair <- get
sactorUI <- get
sslots <- get
slastSlot <- get
sconfig <- get
saimMode <- get
sitemSel <- get
sselected <- get
srunning <- get
_sreport <- get
shistory <- get
smarkVision <- get
smarkSmell <- get
sdisplayNeeded <- get
let slastItemMove = Nothing
schanF = ChanFrontend $ const $
error $ "Binary: ChanFrontend" `showFailure` ()
sbinding = Binding M.empty [] M.empty
sxhairMoused = True
spointer = originPoint
slastRecord = ([], [], 0)
slastPlay = []
slastLost = ES.empty
swaitTimes = 0
smenuIxMap = M.singleton "main" 7
skeysHintMode = KeysHintAbsent
sstart = 0
sgstart = 0
sallTime = timeZero
snframes = 0
sallNframes = 0
return $! SessionUI{..}
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{..}