{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Client.UI.SessionUI
( SessionUI(..), AimMode(..), RunParams(..), LastRecord(..), HintMode(..)
, emptySessionUI, 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.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.Client.UI.UIOptions
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
, slastItemMove :: Maybe (CStore, CStore)
, schanF :: ChanFrontend
, sbinding :: Binding
, sUIOptions :: UIOptions
, saimMode :: Maybe AimMode
, sxhairMoused :: Bool
, sitemSel :: Maybe (ItemId, CStore, Bool)
, sselected :: ES.EnumSet ActorId
, srunning :: Maybe RunParams
, 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
, shintMode :: HintMode
, sreportNull :: Bool
, 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)
data LastRecord = LastRecord
{ currentKeys :: [K.KM]
, previousKeys :: [K.KM]
, freeSpace :: Int
}
data HintMode =
HintAbsent
| HintShown
| HintWiped
deriving (Eq, Enum, Bounded)
emptySessionUI :: UIOptions -> SessionUI
emptySessionUI sUIOptions =
SessionUI
{ sxhair = TVector $ Vector 0 0
, sactorUI = EM.empty
, sslots = ItemSlots $ EM.fromAscList
$ zip [minBound..maxBound] (repeat EM.empty)
, slastItemMove = Nothing
, schanF = ChanFrontend $ const $
error $ "emptySessionUI: ChanFrontend" `showFailure` ()
, sbinding = Binding M.empty [] M.empty
, sUIOptions
, saimMode = Nothing
, sxhairMoused = True
, sitemSel = Nothing
, sselected = ES.empty
, srunning = Nothing
, shistory = emptyHistory 0
, spointer = originPoint
, slastRecord = LastRecord [] [] 0
, slastPlay = []
, slastLost = ES.empty
, swaitTimes = 0
, smarkVision = False
, smarkSmell = True
, smenuIxMap = M.singleton "main" 2
, sdisplayNeeded = False
, sreportNull = True
, shintMode = HintAbsent
, 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 sUIOptions
put saimMode
put sitemSel
put sselected
put srunning
put shistory
put smarkVision
put smarkSmell
put sdisplayNeeded
get = do
sxhair <- get
sactorUI <- get
sslots <- get
sUIOptions <- get
saimMode <- get
sitemSel <- get
sselected <- get
srunning <- 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 = LastRecord [] [] 0
slastPlay = []
slastLost = ES.empty
swaitTimes = 0
smenuIxMap = M.singleton "main" 7
sreportNull = True
shintMode = HintAbsent
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{..}