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

-- | Command line arguments
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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> [Char]
$cshow :: Options -> [Char]
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

getOptions :: IO Options
getOptions :: IO Options
getOptions = do
  (Options
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
    forall (f :: * -> *) a. Alternative f => f a
Opt.empty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Options
options
  where
    header :: [Char]
header =
      [Char]
"Another playground"

    description :: [Char]
description =
      forall a. Monoid a => a
mempty

optionsP :: Opt.Parser Options
optionsP :: Parser Options
optionsP = do
  Bool
optionsVerbose <- Mod FlagFields Bool -> Parser Bool
Opt.switch forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"verbose"
    , forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'v'
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Show more and more detailed messages"
    ]

  Maybe Int
optionsMaxFPS <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option forall a. Read a => ReadM a
Opt.auto forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"max-fps"
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Limit the FPS"
    , forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"FPS"
    ]

  Maybe PresentModeKHR
optionsPresent <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM PresentModeKHR
readPresent forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"present"
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Presentation mode"
    ]

  SampleCountFlagBits
optionsMsaa <- forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM SampleCountFlagBits
readMsaa forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"msaa"
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"MSAA level"
    , 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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"fullscreen"
    , forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'f'
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Run in fullscreen mode"
    ]

  Maybe (Int, Int)
optionsSize <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM (Int, Int)
readSize forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"size"
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Initial window size"
    , forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
Opt.metavar [Char]
"WIDTHxHEIGHT"
    ]

  Natural
optionsDisplay <- forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option forall a. Read a => ReadM a
Opt.auto forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"display"
    , forall (f :: * -> *) a. [Char] -> Mod f a
Opt.help [Char]
"Select display number"
    , forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value Natural
0
    ]

  Maybe Int
optionsRecyclerWait <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option forall a. Read a => ReadM a
Opt.auto forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
Opt.long [Char]
"recycler-wait"
    , 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
optionsRecyclerWait :: Maybe Int
optionsDisplay :: Natural
optionsSize :: Maybe (Int, Int)
optionsFullscreen :: Bool
optionsMsaa :: SampleCountFlagBits
optionsPresent :: Maybe PresentModeKHR
optionsMaxFPS :: Maybe Int
optionsVerbose :: Bool
$sel:optionsRecyclerWait:Options :: Maybe Int
$sel:optionsSize:Options :: Maybe (Int, Int)
$sel:optionsDisplay:Options :: Natural
$sel:optionsFullscreen:Options :: Bool
$sel:optionsMsaa:Options :: SampleCountFlagBits
$sel:optionsPresent:Options :: Maybe PresentModeKHR
$sel:optionsMaxFPS:Options :: Maybe Int
$sel:optionsVerbose:Options :: Bool
..}

readPresent :: Opt.ReadM Khr.PresentModeKHR
readPresent :: ReadM PresentModeKHR
readPresent = ReadM PresentModeKHR
named forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM PresentModeKHR
integral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Char] -> ReadM a
Opt.readerError [Char]
oops
  where
    named :: ReadM PresentModeKHR
named = do
      Text
o <- forall s. IsString s => ReadM s
Opt.str
      case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
o [(Text, PresentModeKHR)]
presentModes of
        Just PresentModeKHR
found ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure PresentModeKHR
found
        Maybe PresentModeKHR
Nothing ->
          forall a. [Char] -> ReadM a
Opt.readerError forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected mode name: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
o

    integral :: ReadM PresentModeKHR
integral =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> PresentModeKHR
Khr.PresentModeKHR forall a. Read a => ReadM a
Opt.auto

    oops :: [Char]
oops = [[Char]] -> [Char]
unlines
      [ [Char]
"Available present modes (or use a number): "
      , forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 <- forall a. Read a => ReadM a
Opt.auto
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
samples [(Int, SampleCountFlagBits)]
msaaSamples of
    Just SampleCountFlagBits
found ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure SampleCountFlagBits
found
    Maybe SampleCountFlagBits
Nothing ->
      forall a. [Char] -> ReadM a
Opt.readerError forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ [Char]
"Unexpected MSAA sample count: "
        , 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 <- forall s. IsString s => ReadM s
Opt.str
  let ([Char]
w, [Char]
h) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'x') [Char]
o
  case (forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
w, forall a. Read a => [Char] -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 [Char]
h)) of
    (Just Int
w', Just Int
h') ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
w', Int
h')
    (Maybe Int, Maybe Int)
_ ->
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Can't read window size"