module Engine.Types.Options
( Options(..)
, getOptions
, optionsP
) where
import RIO
import Options.Applicative.Simple qualified as Opt
import Vulkan.Core10 qualified as Vk
import Vulkan.Extensions.VK_KHR_surface qualified as Khr
import Paths_keid_core qualified
data Options = Options
{ Options -> Bool
optionsVerbose :: Bool
, Options -> Maybe Int
optionsMaxFPS :: Maybe Int
, Options -> Maybe PresentModeKHR
optionsPresent :: Maybe Khr.PresentModeKHR
, Options -> SampleCountFlagBits
optionsMsaa :: Vk.SampleCountFlagBits
, Options -> Bool
optionsFullscreen :: Bool
, Options -> Natural
optionsDisplay :: Natural
, Options -> Maybe (Int, Int)
optionsSize :: Maybe (Int, Int)
, Options -> Maybe Int
optionsRecyclerWait :: Maybe Int
}
deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> [Char]
(Int -> Options -> ShowS)
-> (Options -> [Char]) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> [Char]
show :: Options -> [Char]
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show)
getOptions :: IO Options
getOptions :: IO Options
getOptions = do
(Options
options, ()) <- [Char]
-> [Char]
-> [Char]
-> Parser Options
-> ExceptT () (Writer (Mod CommandFields ())) ()
-> IO (Options, ())
forall a b.
[Char]
-> [Char]
-> [Char]
-> Parser a
-> ExceptT b (Writer (Mod CommandFields b)) ()
-> IO (a, b)
Opt.simpleOptions
$(Opt.simpleVersion Paths_keid_core.version)
[Char]
header
[Char]
description
Parser Options
optionsP
ExceptT () (Writer (Mod CommandFields ())) ()
forall a. ExceptT () (Writer (Mod CommandFields ())) a
forall (f :: * -> *) a. Alternative f => f a
Opt.empty
Options -> IO Options
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Options
options
where
header :: [Char]
header =
[Char]
"Another playground"
description :: [Char]
description =
[Char]
forall a. Monoid a => a
mempty
optionsP :: Opt.Parser Options
optionsP :: Parser Options
optionsP = do
Bool
optionsVerbose <- Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"verbose"
, Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'v'
, [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Show more and more detailed messages"
]
Maybe Int
optionsMaxFPS <- Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Int -> Parser (Maybe Int))
-> Mod OptionFields Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"max-fps"
, [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Limit the FPS"
, [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"FPS"
]
Maybe PresentModeKHR
optionsPresent <- Parser PresentModeKHR -> Parser (Maybe PresentModeKHR)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser PresentModeKHR -> Parser (Maybe PresentModeKHR))
-> (Mod OptionFields PresentModeKHR -> Parser PresentModeKHR)
-> Mod OptionFields PresentModeKHR
-> Parser (Maybe PresentModeKHR)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM PresentModeKHR
-> Mod OptionFields PresentModeKHR -> Parser PresentModeKHR
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM PresentModeKHR
readPresent (Mod OptionFields PresentModeKHR -> Parser (Maybe PresentModeKHR))
-> Mod OptionFields PresentModeKHR -> Parser (Maybe PresentModeKHR)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields PresentModeKHR]
-> Mod OptionFields PresentModeKHR
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields PresentModeKHR
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"present"
, [Char] -> Mod OptionFields PresentModeKHR
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Presentation mode"
]
SampleCountFlagBits
optionsMsaa <- ReadM SampleCountFlagBits
-> Mod OptionFields SampleCountFlagBits
-> Parser SampleCountFlagBits
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM SampleCountFlagBits
readMsaa (Mod OptionFields SampleCountFlagBits
-> Parser SampleCountFlagBits)
-> Mod OptionFields SampleCountFlagBits
-> Parser SampleCountFlagBits
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields SampleCountFlagBits]
-> Mod OptionFields SampleCountFlagBits
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields SampleCountFlagBits
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"msaa"
, [Char] -> Mod OptionFields SampleCountFlagBits
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"MSAA level"
, SampleCountFlagBits -> Mod OptionFields SampleCountFlagBits
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value SampleCountFlagBits
Vk.SAMPLE_COUNT_4_BIT
]
Bool
optionsFullscreen <- Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"fullscreen"
, Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'f'
, [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Run in fullscreen mode"
]
Maybe (Int, Int)
optionsSize <- Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser (Int, Int) -> Parser (Maybe (Int, Int)))
-> (Mod OptionFields (Int, Int) -> Parser (Int, Int))
-> Mod OptionFields (Int, Int)
-> Parser (Maybe (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM (Int, Int)
-> Mod OptionFields (Int, Int) -> Parser (Int, Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Int, Int)
readSize (Mod OptionFields (Int, Int) -> Parser (Maybe (Int, Int)))
-> Mod OptionFields (Int, Int) -> Parser (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (Int, Int)] -> Mod OptionFields (Int, Int)
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields (Int, Int)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"size"
, [Char] -> Mod OptionFields (Int, Int)
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Initial window size"
, [Char] -> Mod OptionFields (Int, Int)
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"WIDTHxHEIGHT"
]
Natural
optionsDisplay <- ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Natural
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Natural -> Parser Natural)
-> Mod OptionFields Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Natural] -> Mod OptionFields Natural
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"display"
, [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Select display number"
, Natural -> Mod OptionFields Natural
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Natural
0
]
Maybe Int
optionsRecyclerWait <- Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Int -> Parser (Maybe Int))
-> Mod OptionFields Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"recycler-wait"
, [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Inject a delay before waiting for a timeline semaphore."
]
pure Options{Bool
Natural
Maybe Int
Maybe (Int, Int)
Maybe PresentModeKHR
SampleCountFlagBits
$sel:optionsVerbose:Options :: Bool
$sel:optionsMaxFPS:Options :: Maybe Int
$sel:optionsPresent:Options :: Maybe PresentModeKHR
$sel:optionsMsaa:Options :: SampleCountFlagBits
$sel:optionsFullscreen:Options :: Bool
$sel:optionsDisplay:Options :: Natural
$sel:optionsSize:Options :: Maybe (Int, Int)
$sel:optionsRecyclerWait:Options :: Maybe Int
optionsVerbose :: Bool
optionsMaxFPS :: Maybe Int
optionsPresent :: Maybe PresentModeKHR
optionsMsaa :: SampleCountFlagBits
optionsFullscreen :: Bool
optionsSize :: Maybe (Int, Int)
optionsDisplay :: Natural
optionsRecyclerWait :: Maybe Int
..}
readPresent :: Opt.ReadM Khr.PresentModeKHR
readPresent :: ReadM PresentModeKHR
readPresent = ReadM PresentModeKHR
named ReadM PresentModeKHR
-> ReadM PresentModeKHR -> ReadM PresentModeKHR
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM PresentModeKHR
integral ReadM PresentModeKHR
-> ReadM PresentModeKHR -> ReadM PresentModeKHR
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> ReadM PresentModeKHR
forall a. [Char] -> ReadM a
Opt.readerError [Char]
oops
where
named :: ReadM PresentModeKHR
named = do
Text
o <- ReadM Text
forall s. IsString s => ReadM s
Opt.str
case Text -> [(Text, PresentModeKHR)] -> Maybe PresentModeKHR
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
o [(Text, PresentModeKHR)]
presentModes of
Just PresentModeKHR
found ->
PresentModeKHR -> ReadM PresentModeKHR
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PresentModeKHR
found
Maybe PresentModeKHR
Nothing ->
[Char] -> ReadM PresentModeKHR
forall a. [Char] -> ReadM a
Opt.readerError ([Char] -> ReadM PresentModeKHR) -> [Char] -> ReadM PresentModeKHR
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected mode name: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
o
integral :: ReadM PresentModeKHR
integral =
(Int32 -> PresentModeKHR) -> ReadM Int32 -> ReadM PresentModeKHR
forall a b. (a -> b) -> ReadM a -> ReadM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> PresentModeKHR
Khr.PresentModeKHR ReadM Int32
forall a. Read a => ReadM a
Opt.auto
oops :: [Char]
oops = [[Char]] -> [Char]
unlines
[ [Char]
"Available present modes (or use a number): "
, [Text] -> [Char]
forall a. Show a => a -> [Char]
show ([Text] -> [Char]) -> [Text] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Text, PresentModeKHR) -> Text)
-> [(Text, PresentModeKHR)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, PresentModeKHR) -> Text
forall a b. (a, b) -> a
fst [(Text, PresentModeKHR)]
presentModes
]
presentModes :: [(Text, Khr.PresentModeKHR)]
presentModes :: [(Text, PresentModeKHR)]
presentModes =
[ (Text
"immediate", PresentModeKHR
Khr.PRESENT_MODE_IMMEDIATE_KHR)
, (Text
"mailbox", PresentModeKHR
Khr.PRESENT_MODE_MAILBOX_KHR)
, (Text
"fifo", PresentModeKHR
Khr.PRESENT_MODE_FIFO_KHR)
, (Text
"fifo_relaxed", PresentModeKHR
Khr.PRESENT_MODE_FIFO_RELAXED_KHR)
, (Text
"shared_demand_refresh", PresentModeKHR
Khr.PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR)
, (Text
"shared_continuous_refresh", PresentModeKHR
Khr.PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR)
]
readMsaa :: Opt.ReadM Vk.SampleCountFlagBits
readMsaa :: ReadM SampleCountFlagBits
readMsaa = do
Int
samples <- ReadM Int
forall a. Read a => ReadM a
Opt.auto
case Int -> [(Int, SampleCountFlagBits)] -> Maybe SampleCountFlagBits
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
samples [(Int, SampleCountFlagBits)]
msaaSamples of
Just SampleCountFlagBits
found ->
SampleCountFlagBits -> ReadM SampleCountFlagBits
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SampleCountFlagBits
found
Maybe SampleCountFlagBits
Nothing ->
[Char] -> ReadM SampleCountFlagBits
forall a. [Char] -> ReadM a
Opt.readerError ([Char] -> ReadM SampleCountFlagBits)
-> [Char] -> ReadM SampleCountFlagBits
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
[ [Char]
"Unexpected MSAA sample count: "
, Int -> [Char]
forall a. Show a => a -> [Char]
show Int
samples
, [Char]
" (must be a power of 2 in [1..64] range)"
]
msaaSamples :: [(Int, Vk.SampleCountFlagBits)]
msaaSamples :: [(Int, SampleCountFlagBits)]
msaaSamples =
[ ( Int
1, SampleCountFlagBits
Vk.SAMPLE_COUNT_1_BIT)
, ( Int
2, SampleCountFlagBits
Vk.SAMPLE_COUNT_2_BIT)
, ( Int
4, SampleCountFlagBits
Vk.SAMPLE_COUNT_4_BIT)
, ( Int
8, SampleCountFlagBits
Vk.SAMPLE_COUNT_8_BIT)
, ( Int
16, SampleCountFlagBits
Vk.SAMPLE_COUNT_16_BIT)
, ( Int
32, SampleCountFlagBits
Vk.SAMPLE_COUNT_32_BIT)
, ( Int
64, SampleCountFlagBits
Vk.SAMPLE_COUNT_64_BIT)
]
readSize :: Opt.ReadM (Int, Int)
readSize :: ReadM (Int, Int)
readSize = do
[Char]
o <- ReadM [Char]
forall s. IsString s => ReadM s
Opt.str
let ([Char]
w, [Char]
h) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x') [Char]
o
case ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
w, [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
h)) of
(Just Int
w', Just Int
h') ->
(Int, Int) -> ReadM (Int, Int)
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
w', Int
h')
(Maybe Int, Maybe Int)
_ ->
[Char] -> ReadM (Int, Int)
forall a. [Char] -> ReadM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Can't read window size"