{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Khr.Surface.PhysicalDevice.Middle (

	-- * GET SUPPORT, CAPABILITIES, FORMATS AND PRESENT MODES

	getSupport, getCapabilities, getFormats, getPresentModes

	) where

import Foreign.Marshal
import Foreign.Storable
import Foreign.Storable.PeekPoke

import Gpu.Vulkan.Base.Middle.Internal
import Gpu.Vulkan.Exception.Middle
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.Khr.Surface.Enum

import qualified Gpu.Vulkan.PhysicalDevice.Middle.Internal as PhysicalDevice
import qualified Gpu.Vulkan.QueueFamily.Middle as QueueFamily
import qualified Gpu.Vulkan.Khr.Surface.PhysicalDevice.Core as C
import qualified Gpu.Vulkan.Khr.Surface.Middle.Internal as M

getSupport :: PhysicalDevice.P -> QueueFamily.Index -> M.S -> IO Bool
getSupport :: P -> Index -> S -> IO Bool
getSupport (PhysicalDevice.P P
phdvc) (QueueFamily.Index Word32
qfi) (M.S S
sfc) =
	Word32 -> Bool
bool32ToBool (Word32 -> Bool) -> IO Word32 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pSupported -> do
		r <- P -> Word32 -> S -> Ptr Word32 -> IO Int32
C.getSupport P
phdvc Word32
qfi S
sfc Ptr Word32
pSupported
		throwUnlessSuccess $ Result r
		peek pSupported

getCapabilities :: PhysicalDevice.P -> M.S -> IO M.Capabilities
getCapabilities :: P -> S -> IO Capabilities
getCapabilities (PhysicalDevice.P P
pdvc) (M.S S
sfc) =
	Capabilities -> Capabilities
M.capabilitiesFromCore (Capabilities -> Capabilities)
-> IO Capabilities -> IO Capabilities
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Capabilities -> IO Capabilities) -> IO Capabilities
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Capabilities
pCapabilities -> do
		r <- P -> S -> Ptr Capabilities -> IO Int32
C.getCapabilities P
pdvc S
sfc Ptr Capabilities
pCapabilities
		throwUnlessSuccess $ Result r
		peek pCapabilities

getFormats :: PhysicalDevice.P -> M.S -> IO [M.Format]
getFormats :: P -> S -> IO [Format]
getFormats (PhysicalDevice.P P
pdvc) (M.S S
sfc) =
	(Format -> Format
M.formatFromCore (Format -> Format) -> [Format] -> [Format]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Format] -> [Format]) -> IO [Format] -> IO [Format]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO [Format]) -> IO [Format]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pFormatCount ->
	P -> S -> Ptr Word32 -> Ptr Format -> IO Int32
C.getFormats P
pdvc S
sfc Ptr Word32
pFormatCount Ptr Format
forall a. Ptr a
NullPtr IO Int32 -> (Int32 -> IO [Format]) -> IO [Format]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pFormatCount IO Word32 -> (Word32 -> IO [Format]) -> IO [Format]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
formatCount) ->
	Int -> (Ptr Format -> IO [Format]) -> IO [Format]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
formatCount \Ptr Format
pFormats -> do
		r' <- P -> S -> Ptr Word32 -> Ptr Format -> IO Int32
C.getFormats P
pdvc S
sfc Ptr Word32
pFormatCount Ptr Format
pFormats
		throwUnlessSuccess $ Result r'
		peekArray formatCount pFormats

getPresentModes :: PhysicalDevice.P -> M.S -> IO [PresentMode]
getPresentModes :: P -> S -> IO [PresentMode]
getPresentModes (PhysicalDevice.P P
pdvc) (M.S S
sfc) =
	 (Word32 -> PresentMode
PresentMode (Word32 -> PresentMode) -> [Word32] -> [PresentMode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Word32] -> [PresentMode]) -> IO [Word32] -> IO [PresentMode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO [Word32]) -> IO [Word32]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pPresentModeCount ->
	P -> S -> Ptr Word32 -> Ptr Word32 -> IO Int32
C.getPresentModes P
pdvc S
sfc Ptr Word32
pPresentModeCount Ptr Word32
forall a. Ptr a
NullPtr IO Int32 -> (Int32 -> IO [Word32]) -> IO [Word32]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pPresentModeCount IO Word32 -> (Word32 -> IO [Word32]) -> IO [Word32]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
presentModeCount) ->
	Int -> (Ptr Word32 -> IO [Word32]) -> IO [Word32]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
presentModeCount \Ptr Word32
pPresentModes -> do
		r' <- P -> S -> Ptr Word32 -> Ptr Word32 -> IO Int32
C.getPresentModes
			P
pdvc S
sfc Ptr Word32
pPresentModeCount Ptr Word32
pPresentModes
		throwUnlessSuccess $ Result r'
		peekArray presentModeCount pPresentModes