    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE LambdaCase #-}

    module SDL.Video.Vulkan (
      -- * Vulkan types
      VkInstance, VkSurfaceKHR, VkGetInstanceProcAddrFunc,
      -- * Vulkan loader
      vkLoadLibrary, vkUnloadLibrary, vkGetVkGetInstanceProcAddr,
      -- * Vulkan surface
      vkGetInstanceExtensions, vkCreateSurface,
      -- * Querying for the drawable size
      vkGetDrawableSize
    ) where

    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Foreign hiding (throwIf_, throwIfNeg_)
    import Foreign.C.Types (CInt)
    import Foreign.C.String (CString, withCString)
    import SDL.Vect (V2 (V2))
    import SDL.Internal.Exception (throwIf_, throwIfNeg_)
    import SDL.Internal.Types (Window (Window))
    import SDL.Raw.Types (VkInstance, VkSurfaceKHR, VkGetInstanceProcAddrFunc)
    import qualified SDL.Raw as Raw

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative
    #endif

    -- | Dynamically load a Vulkan loader library.
    --
    -- If a filePath is 'Nothing', SDL will use the value of the environment variable
    -- SDL_VULKAN_LIBRARY, if set, otherwise it loads the default Vulkan
    -- loader library.
    --
    -- This function should be called after initializing the video driver
    -- (i.e. 'SDL.Init.initialize' ['SDL.Init.InitVideo']), but before
    -- creating any windows with 'SDL.Video.windowGraphicsContext' = 'SDL.Video.VulkanContext'.
    --
    -- If no Vulkan loader library is loaded, analogue of 'vkLoadLibrary' 'Nothing'
    -- will be automatically called by SDL C library upon creation of the first Vulkan window.
    --
    -- Throws 'SDL.Exception.SDLException' if there are no working Vulkan drivers installed.
    vkLoadLibrary :: MonadIO m => Maybe FilePath -> m ()
    vkLoadLibrary :: forall (m :: Type -> Type). MonadIO m => Maybe FilePath -> m ()
    vkLoadLibrary = \case
        Maybe FilePath
    Nothing       -> IO () -> m ()
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (IO CInt -> IO ()) -> IO CInt -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO CInt -> IO ()
    testNeg (IO CInt -> m ()) -> IO CInt -> m ()
    forall a b. (a -> b) -> a -> b
    $ CString -> IO CInt
    forall (m :: Type -> Type). MonadIO m => CString -> m CInt
    Raw.vkLoadLibrary CString
    forall a. Ptr a
    nullPtr
        Just FilePath
    filePath -> IO () -> m ()
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ())
    -> ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> (CString -> IO ()) -> IO ()
    forall a. FilePath -> (CString -> IO a) -> IO a
    withCString FilePath
    filePath ((CString -> IO ()) -> m ()) -> (CString -> IO ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $ IO CInt -> IO ()
    testNeg (IO CInt -> IO ()) -> (CString -> IO CInt) -> CString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CString -> IO CInt
    forall (m :: Type -> Type). MonadIO m => CString -> m CInt
    Raw.vkLoadLibrary
      where
        testNeg :: IO CInt -> IO ()
    testNeg = Text -> Text -> IO CInt -> IO ()
    forall (m :: Type -> Type) a.
    (MonadIO m, Num a, Ord a) =>
    Text -> Text -> m a -> m ()
    throwIfNeg_ Text
    "SDL.Video.Vulkan.vkLoadLibrary" Text
    "SDL_Vulkan_LoadLibrary"

    -- | Unload the Vulkan loader library previously loaded by 'vkLoadLibrary'.
    --
    -- Analogue of this function will be automatically called by SDL C library
    -- after destruction of the last window with
    -- 'SDL.Video.windowGraphicsContext' = 'SDL.Video.VulkanContext'.
    vkUnloadLibrary :: MonadIO m => m ()
    vkUnloadLibrary :: forall (m :: Type -> Type). MonadIO m => m ()
    vkUnloadLibrary = m ()
    forall (m :: Type -> Type). MonadIO m => m ()
    Raw.vkUnloadLibrary

    foreign import ccall "dynamic" mkVkGetInstanceProcAddrFunc ::
      FunPtr VkGetInstanceProcAddrFunc -> VkGetInstanceProcAddrFunc

    -- | Get the vkGetInstanceProcAddr function, which can be used to obtain another Vulkan functions
    -- (see <https://www.khronos.org/registry/vulkan/specs/1.0/man/html/vkGetInstanceProcAddr.html>).
    --
    -- The 'vkGetVkGetInstanceProcAddr' function should be called after either calling 'vkLoadLibrary'
    -- function or creating first Vulkan window.
    vkGetVkGetInstanceProcAddr :: (Functor m, MonadIO m) => m VkGetInstanceProcAddrFunc
    vkGetVkGetInstanceProcAddr :: forall (m :: Type -> Type).
    (Functor m, MonadIO m) =>
    m VkGetInstanceProcAddrFunc
    vkGetVkGetInstanceProcAddr = FunPtr VkGetInstanceProcAddrFunc -> VkGetInstanceProcAddrFunc
    mkVkGetInstanceProcAddrFunc (FunPtr VkGetInstanceProcAddrFunc -> VkGetInstanceProcAddrFunc)
    -> m (FunPtr VkGetInstanceProcAddrFunc)
    -> m VkGetInstanceProcAddrFunc
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> m (FunPtr VkGetInstanceProcAddrFunc)
    forall (m :: Type -> Type).
    MonadIO m =>
    m (FunPtr VkGetInstanceProcAddrFunc)
    Raw.vkGetVkGetInstanceProcAddr

    -- | Get the names of the Vulkan instance extensions needed to create
    -- a surface with 'vkCreateSurface'.
    --
    -- The extension names queried here must be enabled when calling vkCreateInstance
    -- (see <https://www.khronos.org/registry/vulkan/specs/1.0/man/html/vkCreateInstance.html>),
    -- otherwise 'vkCreateSurface' will fail.
    --
    -- Window should have been created with 'SDL.Video.windowGraphicsContext' = 'SDL.Video.VulkanContext'.
    --
    -- Throws 'SDL.Exception.SDLException' on failure.
    vkGetInstanceExtensions :: MonadIO m => Window -> m [CString]
    vkGetInstanceExtensions :: forall (m :: Type -> Type). MonadIO m => Window -> m [CString]
    vkGetInstanceExtensions (Window Window
    w) = IO [CString] -> m [CString]
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [CString] -> m [CString])
    -> ((Ptr CUInt -> IO [CString]) -> IO [CString])
    -> (Ptr CUInt -> IO [CString])
    -> m [CString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ptr CUInt -> IO [CString]) -> IO [CString]
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CUInt -> IO [CString]) -> m [CString])
    -> (Ptr CUInt -> IO [CString]) -> m [CString]
    forall a b. (a -> b) -> a -> b
    $ \Ptr CUInt
    countPtr -> do
      (Bool -> Bool) -> Text -> Text -> IO Bool -> IO ()
    forall (m :: Type -> Type) a.
    MonadIO m =>
    (a -> Bool) -> Text -> Text -> m a -> m ()
    throwIf_ Bool -> Bool
    not Text
    "SDL.Video.Vulkan.vkGetInstanceExtensions (1)" Text
    "SDL_Vulkan_GetInstanceExtensions" (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Window -> Ptr CUInt -> Ptr CString -> IO Bool
    forall (m :: Type -> Type).
    MonadIO m =>
    Window -> Ptr CUInt -> Ptr CString -> m Bool
    Raw.vkGetInstanceExtensions Window
    w Ptr CUInt
    countPtr Ptr CString
    forall a. Ptr a
    nullPtr
      count <- CUInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr CUInt -> IO CUInt
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CUInt
    countPtr
      allocaArray count $ \Ptr CString
    sPtr ->
        (Bool -> Bool) -> Text -> Text -> IO Bool -> IO ()
    forall (m :: Type -> Type) a.
    MonadIO m =>
    (a -> Bool) -> Text -> Text -> m a -> m ()
    throwIf_ Bool -> Bool
    not Text
    "SDL.Video.Vulkan.vkGetInstanceExtensions (2)" Text
    "SDL_Vulkan_GetInstanceExtensions"
          (Window -> Ptr CUInt -> Ptr CString -> IO Bool
    forall (m :: Type -> Type).
    MonadIO m =>
    Window -> Ptr CUInt -> Ptr CString -> m Bool
    Raw.vkGetInstanceExtensions Window
    w Ptr CUInt
    countPtr Ptr CString
    sPtr) IO () -> IO [CString] -> IO [CString]
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> Int -> Ptr CString -> IO [CString]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    count Ptr CString
    sPtr

    -- | Create a Vulkan rendering surface for a window.
    --
    -- Window should have been created with 'SDL.Video.windowGraphicsContext' = 'SDL.Video.VulkanContext'.
    --
    -- Instance should have been created with the extensions returned
    -- by 'vkGetInstanceExtensions' enabled.
    --
    -- Throws 'SDL.Exception.SDLException' on failure.
    vkCreateSurface :: MonadIO m => Window -> VkInstance -> m VkSurfaceKHR
    vkCreateSurface :: forall (m :: Type -> Type).
    MonadIO m =>
    Window -> Window -> m VkSurfaceKHR
    vkCreateSurface (Window Window
    w) Window
    vkInstance = IO VkSurfaceKHR -> m VkSurfaceKHR
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO VkSurfaceKHR -> m VkSurfaceKHR)
    -> ((Ptr VkSurfaceKHR -> IO VkSurfaceKHR) -> IO VkSurfaceKHR)
    -> (Ptr VkSurfaceKHR -> IO VkSurfaceKHR)
    -> m VkSurfaceKHR
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ptr VkSurfaceKHR -> IO VkSurfaceKHR) -> IO VkSurfaceKHR
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr VkSurfaceKHR -> IO VkSurfaceKHR) -> m VkSurfaceKHR)
    -> (Ptr VkSurfaceKHR -> IO VkSurfaceKHR) -> m VkSurfaceKHR
    forall a b. (a -> b) -> a -> b
    $ \Ptr VkSurfaceKHR
    vkSurfacePtr ->
      (Bool -> Bool) -> Text -> Text -> IO Bool -> IO ()
    forall (m :: Type -> Type) a.
    MonadIO m =>
    (a -> Bool) -> Text -> Text -> m a -> m ()
    throwIf_ Bool -> Bool
    not Text
    "SDL.Video.Vulkan.vkCreateSurface" Text
    "SDL_Vulkan_CreateSurface"
        (Window -> Window -> Ptr VkSurfaceKHR -> IO Bool
    forall (m :: Type -> Type).
    MonadIO m =>
    Window -> Window -> Ptr VkSurfaceKHR -> m Bool
    Raw.vkCreateSurface Window
    w Window
    vkInstance Ptr VkSurfaceKHR
    vkSurfacePtr) IO () -> IO VkSurfaceKHR -> IO VkSurfaceKHR
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> Ptr VkSurfaceKHR -> IO VkSurfaceKHR
    forall a. Storable a => Ptr a -> IO a
    peek Ptr VkSurfaceKHR
    vkSurfacePtr

    -- | Get the size of a window's underlying drawable area in pixels (for use
    -- with setting viewport, scissor & etc).
    --
    -- It may differ from 'SDL.Video.windowSize' if window was created with 'SDL.Video.windowHighDPI' flag.
    vkGetDrawableSize :: MonadIO m => Window -> m (V2 CInt)
    vkGetDrawableSize :: forall (m :: Type -> Type). MonadIO m => Window -> m (V2 CInt)
    vkGetDrawableSize (Window Window
    w) = IO (V2 CInt) -> m (V2 CInt)
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (V2 CInt) -> m (V2 CInt))
    -> ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
    -> (Ptr CInt -> IO (V2 CInt))
    -> m (V2 CInt)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CInt -> IO (V2 CInt)) -> m (V2 CInt))
    -> (Ptr CInt -> IO (V2 CInt)) -> m (V2 CInt)
    forall a b. (a -> b) -> a -> b
    $ \Ptr CInt
    wptr ->
      (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
    -> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
    forall a b. (a -> b) -> a -> b
    $ \Ptr CInt
    hptr -> do
        Window -> Ptr CInt -> Ptr CInt -> IO ()
    forall (m :: Type -> Type).
    MonadIO m =>
    Window -> Ptr CInt -> Ptr CInt -> m ()
    Raw.vkGetDrawableSize Window
    w Ptr CInt
    wptr Ptr CInt
    hptr
        CInt -> CInt -> V2 CInt
    forall a. a -> a -> V2 a
    V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr CInt -> IO CInt
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CInt
    wptr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> Ptr CInt -> IO CInt
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CInt
    hptr