{-# 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       -> forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CInt -> IO ()
testNeg forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). MonadIO m => CString -> m CInt
Raw.vkLoadLibrary forall a. Ptr a
nullPtr
    Just FilePath
filePath -> forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
filePath forall a b. (a -> b) -> a -> b
$ IO CInt -> IO ()
testNeg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type). MonadIO m => CString -> m CInt
Raw.vkLoadLibrary
  where
    testNeg :: IO CInt -> IO ()
testNeg = 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 = 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 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
countPtr -> do
  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" forall a b. (a -> b) -> a -> b
$
    forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CUInt -> Ptr CString -> m Bool
Raw.vkGetInstanceExtensions Window
w Ptr CUInt
countPtr forall a. Ptr a
nullPtr
  Int
count <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
countPtr
  forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
count forall a b. (a -> b) -> a -> b
$ \Ptr CString
sPtr ->
    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"
      (forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CUInt -> Ptr CString -> m Bool
Raw.vkGetInstanceExtensions Window
w Ptr CUInt
countPtr Ptr CString
sPtr) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> 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 = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr VkSurfaceKHR
vkSurfacePtr ->
  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"
    (forall (m :: Type -> Type).
MonadIO m =>
Window -> Window -> Ptr VkSurfaceKHR -> m Bool
Raw.vkCreateSurface Window
w Window
vkInstance Ptr VkSurfaceKHR
vkSurfacePtr) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> 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) = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wptr ->
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hptr -> do
    forall (m :: Type -> Type).
MonadIO m =>
Window -> Ptr CInt -> Ptr CInt -> m ()
Raw.vkGetDrawableSize Window
w Ptr CInt
wptr Ptr CInt
hptr
    forall a. a -> a -> V2 a
V2 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wptr forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hptr