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
  { optionsVerbose      :: Bool
  , optionsMaxFPS       :: Maybe Int
  , optionsPresent      :: Maybe Khr.PresentModeKHR
  , optionsMsaa         :: Vk.SampleCountFlagBits
  , optionsFullscreen   :: Bool
  , optionsDisplay      :: Natural
  , optionsSize         :: Maybe (Int, Int)
  , optionsRecyclerWait :: Maybe Int
  }
  deriving (Show)

getOptions :: IO Options
getOptions = do
  (options, ()) <- Opt.simpleOptions
    $(Opt.simpleVersion Paths_keid_core.version)
    header
    description
    optionsP
    Opt.empty
  pure options
  where
    header =
      "Another playground"

    description =
      mempty

optionsP :: Opt.Parser Options
optionsP = do
  optionsVerbose <- Opt.switch $ mconcat
    [ Opt.long "verbose"
    , Opt.short 'v'
    , Opt.help "Show more and more detailed messages"
    ]

  optionsMaxFPS <- Opt.optional . Opt.option Opt.auto $ mconcat
    [ Opt.long "max-fps"
    , Opt.help "Limit the FPS"
    , Opt.metavar "FPS"
    ]

  optionsPresent <- Opt.optional . Opt.option readPresent $ mconcat
    [ Opt.long "present"
    , Opt.help "Presentation mode"
    ]

  optionsMsaa <- Opt.option readMsaa $ mconcat
    [ Opt.long "msaa"
    , Opt.help "MSAA level"
    , Opt.value Vk.SAMPLE_COUNT_4_BIT
    ]

  optionsFullscreen <- Opt.switch $ mconcat
    [ Opt.long "fullscreen"
    , Opt.short 'f'
    , Opt.help "Run in fullscreen mode"
    ]

  optionsSize <- Opt.optional . Opt.option readSize $ mconcat
    [ Opt.long "size"
    , Opt.help "Initial window size"
    , Opt.metavar "WIDTHxHEIGHT"
    ]

  optionsDisplay <- Opt.option Opt.auto $ mconcat
    [ Opt.long "display"
    , Opt.help "Select display number"
    , Opt.value 0
    ]

  optionsRecyclerWait <- Opt.optional . Opt.option Opt.auto $ mconcat
    [ Opt.long "recycler-wait"
    , Opt.help "Inject a delay before waiting for a timeline semaphore."
    ]

  pure Options{..}

readPresent :: Opt.ReadM Khr.PresentModeKHR
readPresent = named <|> integral <|> Opt.readerError oops
  where
    named = do
      o <- Opt.str
      case lookup o presentModes of
        Just found ->
          pure found
        Nothing ->
          Opt.readerError $ "unexpected mode name: " <> show o

    integral =
      fmap Khr.PresentModeKHR Opt.auto

    oops = unlines
      [ "Available present modes (or use a number): "
      , show $ map fst presentModes
      ]

presentModes :: [(Text, Khr.PresentModeKHR)]
presentModes =
  [ ("immediate", Khr.PRESENT_MODE_IMMEDIATE_KHR)
  , ("mailbox", Khr.PRESENT_MODE_MAILBOX_KHR)
  , ("fifo", Khr.PRESENT_MODE_FIFO_KHR)
  , ("fifo_relaxed", Khr.PRESENT_MODE_FIFO_RELAXED_KHR)
  , ("shared_demand_refresh", Khr.PRESENT_MODE_SHARED_DEMAND_REFRESH_KHR)
  , ("shared_continuous_refresh", Khr.PRESENT_MODE_SHARED_CONTINUOUS_REFRESH_KHR)
  ]

readMsaa :: Opt.ReadM Vk.SampleCountFlagBits
readMsaa = do
  samples <- Opt.auto
  case lookup samples msaaSamples of
    Just found ->
      pure found
    Nothing ->
      Opt.readerError $ mconcat
        [ "Unexpected MSAA sample count: "
        , show samples
        , " (must be a power of 2 in [1..64] range)"
        ]

msaaSamples :: [(Int, Vk.SampleCountFlagBits)]
msaaSamples =
  [ ( 1, Vk.SAMPLE_COUNT_1_BIT)
  , ( 2, Vk.SAMPLE_COUNT_2_BIT)
  , ( 4, Vk.SAMPLE_COUNT_4_BIT)
  , ( 8, Vk.SAMPLE_COUNT_8_BIT)
  , ( 16, Vk.SAMPLE_COUNT_16_BIT)
  , ( 32, Vk.SAMPLE_COUNT_32_BIT)
  , ( 64, Vk.SAMPLE_COUNT_64_BIT)
  ]

readSize :: Opt.ReadM (Int, Int)
readSize = do
  o <- Opt.str
  let (w, h) = break (== 'x') o
  case (readMaybe w, readMaybe (drop 1 h)) of
    (Just w', Just h') ->
      pure (w', h')
    _ ->
      fail "Can't read window size"