{-# LANGUAGE DeriveGeneric #-}
-- | Options that affect the behaviour of the client.
module Game.LambdaHack.Common.ClientOptions
  ( FullscreenMode(..), ClientOptions(..), defClientOptions
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Control.DeepSeq
import Data.Binary
import GHC.Generics (Generic)

import Game.LambdaHack.Common.Misc

-- | Kinds of fullscreen or windowed mode. See <https://hackage.haskell.org/package/sdl2-2.5.3.0/docs/SDL-Video.html#t:WindowMode>.
data FullscreenMode =
    NotFullscreen        -- ^ a normal window instead of fullscreen
  | BigBorderlessWindow  -- ^ fake fullscreen; window the size of the desktop;
                         --   this is the preferred one, if it works
  | ModeChange           -- ^ real fullscreen with a video mode change
  deriving (Int -> FullscreenMode -> ShowS
[FullscreenMode] -> ShowS
FullscreenMode -> String
(Int -> FullscreenMode -> ShowS)
-> (FullscreenMode -> String)
-> ([FullscreenMode] -> ShowS)
-> Show FullscreenMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullscreenMode] -> ShowS
$cshowList :: [FullscreenMode] -> ShowS
show :: FullscreenMode -> String
$cshow :: FullscreenMode -> String
showsPrec :: Int -> FullscreenMode -> ShowS
$cshowsPrec :: Int -> FullscreenMode -> ShowS
Show, ReadPrec [FullscreenMode]
ReadPrec FullscreenMode
Int -> ReadS FullscreenMode
ReadS [FullscreenMode]
(Int -> ReadS FullscreenMode)
-> ReadS [FullscreenMode]
-> ReadPrec FullscreenMode
-> ReadPrec [FullscreenMode]
-> Read FullscreenMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FullscreenMode]
$creadListPrec :: ReadPrec [FullscreenMode]
readPrec :: ReadPrec FullscreenMode
$creadPrec :: ReadPrec FullscreenMode
readList :: ReadS [FullscreenMode]
$creadList :: ReadS [FullscreenMode]
readsPrec :: Int -> ReadS FullscreenMode
$creadsPrec :: Int -> ReadS FullscreenMode
Read, FullscreenMode -> FullscreenMode -> Bool
(FullscreenMode -> FullscreenMode -> Bool)
-> (FullscreenMode -> FullscreenMode -> Bool) -> Eq FullscreenMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullscreenMode -> FullscreenMode -> Bool
$c/= :: FullscreenMode -> FullscreenMode -> Bool
== :: FullscreenMode -> FullscreenMode -> Bool
$c== :: FullscreenMode -> FullscreenMode -> Bool
Eq, (forall x. FullscreenMode -> Rep FullscreenMode x)
-> (forall x. Rep FullscreenMode x -> FullscreenMode)
-> Generic FullscreenMode
forall x. Rep FullscreenMode x -> FullscreenMode
forall x. FullscreenMode -> Rep FullscreenMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FullscreenMode x -> FullscreenMode
$cfrom :: forall x. FullscreenMode -> Rep FullscreenMode x
Generic)

instance NFData FullscreenMode

instance Binary FullscreenMode

-- | Options that affect the behaviour of the client (but not game rules).
data ClientOptions = ClientOptions
  { ClientOptions -> Maybe Text
schosenFontset    :: Maybe Text
      -- ^ Font set chosen by the player for the whole UI.
  , ClientOptions -> Maybe Double
sallFontsScale    :: Maybe Double
      -- ^ The scale applied to all fonts, resizing the whole UI.
  , ClientOptions -> [(Text, FontDefinition)]
sfonts            :: [(Text, FontDefinition)]
      -- ^ Available fonts as defined in config file.
  , ClientOptions -> [(Text, FontSet)]
sfontsets         :: [(Text, FontSet)]
      -- ^ Available font sets as defined in config file.
  , ClientOptions -> Maybe FullscreenMode
sfullscreenMode   :: Maybe FullscreenMode
      -- ^ Whether to start in fullscreen mode and in which one.
  , ClientOptions -> Maybe Int
slogPriority      :: Maybe Int
      -- ^ How much to log (e.g., from SDL). 1 is all, 5 is errors, the default.
  , ClientOptions -> Maybe Double
smaxFps           :: Maybe Double
      -- ^ Maximal frames per second.
      -- This is better low and fixed, to avoid jerkiness and delays
      -- that tell the player there are many intelligent enemies on the level.
      -- That's better than scaling AI sofistication down based
      -- on the FPS setting and machine speed.
  , ClientOptions -> Bool
sdisableAutoYes   :: Bool
      -- ^ Never auto-answer all prompts, even if under AI control.
  , ClientOptions -> Maybe Bool
snoAnim           :: Maybe Bool
      -- ^ Don't show any animations.
  , ClientOptions -> Bool
snewGameCli       :: Bool
      -- ^ Start a new game, overwriting the save file.
  , ClientOptions -> Bool
sbenchmark        :: Bool
      -- ^ Don't create directories and files and show time stats.
  , ClientOptions -> Maybe String
stitle            :: Maybe String
  , ClientOptions -> String
ssavePrefixCli    :: String
      -- ^ Prefix of the save game file name.
  , ClientOptions -> Bool
sfrontendTeletype :: Bool
      -- ^ Whether to use the stdout/stdin frontend.
  , ClientOptions -> Bool
sfrontendNull     :: Bool
      -- ^ Whether to use null (no input/output) frontend.
  , ClientOptions -> Bool
sfrontendLazy     :: Bool
      -- ^ Whether to use lazy (output not even calculated) frontend.
  , ClientOptions -> Bool
sdbgMsgCli        :: Bool
      -- ^ Show clients' internal debug messages.
  , ClientOptions -> Maybe Int
sstopAfterSeconds :: Maybe Int
  , ClientOptions -> Maybe Int
sstopAfterFrames  :: Maybe Int
  , ClientOptions -> Bool
sprintEachScreen  :: Bool
  , ClientOptions -> Bool
sexposePlaces     :: Bool
  , ClientOptions -> Bool
sexposeItems      :: Bool
  , ClientOptions -> Bool
sexposeActors     :: Bool
  }
  deriving (Int -> ClientOptions -> ShowS
[ClientOptions] -> ShowS
ClientOptions -> String
(Int -> ClientOptions -> ShowS)
-> (ClientOptions -> String)
-> ([ClientOptions] -> ShowS)
-> Show ClientOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientOptions] -> ShowS
$cshowList :: [ClientOptions] -> ShowS
show :: ClientOptions -> String
$cshow :: ClientOptions -> String
showsPrec :: Int -> ClientOptions -> ShowS
$cshowsPrec :: Int -> ClientOptions -> ShowS
Show, ClientOptions -> ClientOptions -> Bool
(ClientOptions -> ClientOptions -> Bool)
-> (ClientOptions -> ClientOptions -> Bool) -> Eq ClientOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientOptions -> ClientOptions -> Bool
$c/= :: ClientOptions -> ClientOptions -> Bool
== :: ClientOptions -> ClientOptions -> Bool
$c== :: ClientOptions -> ClientOptions -> Bool
Eq, (forall x. ClientOptions -> Rep ClientOptions x)
-> (forall x. Rep ClientOptions x -> ClientOptions)
-> Generic ClientOptions
forall x. Rep ClientOptions x -> ClientOptions
forall x. ClientOptions -> Rep ClientOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientOptions x -> ClientOptions
$cfrom :: forall x. ClientOptions -> Rep ClientOptions x
Generic)

instance Binary ClientOptions

-- | Default value of client options.
defClientOptions :: ClientOptions
defClientOptions :: ClientOptions
defClientOptions = $WClientOptions :: Maybe Text
-> Maybe Double
-> [(Text, FontDefinition)]
-> [(Text, FontSet)]
-> Maybe FullscreenMode
-> Maybe Int
-> Maybe Double
-> Bool
-> Maybe Bool
-> Bool
-> Bool
-> Maybe String
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Bool
-> ClientOptions
ClientOptions
  { schosenFontset :: Maybe Text
schosenFontset = Maybe Text
forall a. Maybe a
Nothing
  , sallFontsScale :: Maybe Double
sallFontsScale = Maybe Double
forall a. Maybe a
Nothing
  , sfonts :: [(Text, FontDefinition)]
sfonts = []
  , sfontsets :: [(Text, FontSet)]
sfontsets = []
  , sfullscreenMode :: Maybe FullscreenMode
sfullscreenMode = Maybe FullscreenMode
forall a. Maybe a
Nothing
  , slogPriority :: Maybe Int
slogPriority = Maybe Int
forall a. Maybe a
Nothing
  , smaxFps :: Maybe Double
smaxFps = Maybe Double
forall a. Maybe a
Nothing
  , sdisableAutoYes :: Bool
sdisableAutoYes = Bool
False
  , snoAnim :: Maybe Bool
snoAnim = Maybe Bool
forall a. Maybe a
Nothing
  , snewGameCli :: Bool
snewGameCli = Bool
False
  , sbenchmark :: Bool
sbenchmark = Bool
False
  , stitle :: Maybe String
stitle = Maybe String
forall a. Maybe a
Nothing
  , ssavePrefixCli :: String
ssavePrefixCli = ""
  , sfrontendTeletype :: Bool
sfrontendTeletype = Bool
False
  , sfrontendNull :: Bool
sfrontendNull = Bool
False
  , sfrontendLazy :: Bool
sfrontendLazy = Bool
False
  , sdbgMsgCli :: Bool
sdbgMsgCli = Bool
False
  , sstopAfterSeconds :: Maybe Int
sstopAfterSeconds = Maybe Int
forall a. Maybe a
Nothing
  , sstopAfterFrames :: Maybe Int
sstopAfterFrames = Maybe Int
forall a. Maybe a
Nothing
  , sprintEachScreen :: Bool
sprintEachScreen = Bool
False
  , sexposePlaces :: Bool
sexposePlaces = Bool
False
  , sexposeItems :: Bool
sexposeItems = Bool
False
  , sexposeActors :: Bool
sexposeActors = Bool
False
  }