{-# LINE 1 "src/Gpu/Vulkan/Khr/Swapchain/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, OverloadedStrings, TupleSections #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Khr.Swapchain.Middle.Internal (

	-- * EXTENSION NAME

	extensionName,

	-- * CREAET AND DESTROY

	create, recreate, destroy, S, CreateInfo(..),

	-- * GET IMAGES

	getImages,

	-- * INTERNAL USE

	sToCore,

	-- * ACQUIRE NEXT IMAGE

	acquireNextImage, acquireNextImageResult,	-- VK_KHR_swapchain

	-- * QUEUE PRESENT

	queuePresent, PresentInfo(..)			-- VK_KHR_swapchain

	) where

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Word
import Data.IORef

import qualified Data.Text as T

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

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.QueueFamily.Middle as QueueFamily
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.Image.Middle.Internal as Image
import qualified Gpu.Vulkan.Image.Enum as Image
import qualified Gpu.Vulkan.Khr.Surface.Middle.Internal as Surface.M
import qualified Gpu.Vulkan.Core as C
import qualified Gpu.Vulkan.Khr.Swapchain.Core as C

import qualified Gpu.Vulkan.Device.Middle.Internal as Device.M
import qualified Gpu.Vulkan.Fence.Middle.Internal as Fence
import qualified Gpu.Vulkan.Semaphore.Middle.Internal as Semaphore.M
import Gpu.Vulkan.Queue.Middle.Internal as Queue
import Control.Arrow



extensionName :: T.Text
extensionName :: Text
extensionName = Text
"VK_KHR_swapchain"
{-# LINE 78 "src/Gpu/Vulkan/Khr/Swapchain/Middle/Internal.hsc" #-}

newtype S = S { S -> IORef (Extent2d, S)
_unS :: IORef (C.Extent2d, C.S) }

instance Show S where show :: S -> String
show S
_ = String
"Gpu.Vulkan.Khr.Swapchain.Middle.S"

sToCore :: S -> IO C.S
sToCore :: S -> IO S
sToCore (S IORef (Extent2d, S)
s) = (Extent2d, S) -> S
forall a b. (a, b) -> b
snd ((Extent2d, S) -> S) -> IO (Extent2d, S) -> IO S
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Extent2d, S) -> IO (Extent2d, S)
forall a. IORef a -> IO a
readIORef IORef (Extent2d, S)
s

sFromCore :: C.Extent2d -> C.S -> IO S
sFromCore :: Extent2d -> S -> IO S
sFromCore Extent2d
ex S
s = IORef (Extent2d, S) -> S
S (IORef (Extent2d, S) -> S) -> IO (IORef (Extent2d, S)) -> IO S
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Extent2d, S) -> IO (IORef (Extent2d, S))
forall a. a -> IO (IORef a)
newIORef (Extent2d
ex, S
s)

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> S
createInfoSurface :: Surface.M.S,
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoMinImageCount :: Word32,
	forall (mn :: Maybe (*)). CreateInfo mn -> Format
createInfoImageFormat :: Format,
	forall (mn :: Maybe (*)). CreateInfo mn -> ColorSpace
createInfoImageColorSpace :: ColorSpace,
	forall (mn :: Maybe (*)). CreateInfo mn -> Extent2d
createInfoImageExtent :: C.Extent2d,
	forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoImageArrayLayers :: Word32,
	forall (mn :: Maybe (*)). CreateInfo mn -> UsageFlags
createInfoImageUsage :: Image.UsageFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> SharingMode
createInfoImageSharingMode :: SharingMode,
	forall (mn :: Maybe (*)). CreateInfo mn -> [Index]
createInfoQueueFamilyIndices :: [QueueFamily.Index],
	forall (mn :: Maybe (*)). CreateInfo mn -> TransformFlagBits
createInfoPreTransform :: TransformFlagBits,
	forall (mn :: Maybe (*)). CreateInfo mn -> CompositeAlphaFlagBits
createInfoCompositeAlpha :: CompositeAlphaFlagBits,
	forall (mn :: Maybe (*)). CreateInfo mn -> PresentMode
createInfoPresentMode :: PresentMode,
	forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoClipped :: Bool,
	forall (mn :: Maybe (*)). CreateInfo mn -> Maybe S
createInfoOldSwapchain :: Maybe S }

deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn)

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO S
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO S
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = Extent2d -> S -> IO S
sFromCore Extent2d
ex (S -> IO S) -> IO S -> IO S
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Ptr S -> IO S) -> IO S
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr S
psc -> do
		CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCoreOld CreateInfo mn
ci \Ptr CreateInfo
pci ->
			M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
				r <- D -> Ptr CreateInfo -> Ptr A -> Ptr S -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr S
psc
				throwUnlessSuccess $ Result r
		Ptr S -> IO S
forall a. Storable a => Ptr a -> IO a
peek Ptr S
psc
	where ex :: Extent2d
ex = CreateInfo mn -> Extent2d
forall (mn :: Maybe (*)). CreateInfo mn -> Extent2d
createInfoImageExtent CreateInfo mn
ci

recreate :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn ->
	TPMaybe.M AllocationCallbacks.A mc ->
	S -> IO ()
recreate :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> S -> IO ()
recreate (Device.D D
dvc) CreateInfo mn
ci M A mc
macc (S IORef (Extent2d, S)
rs) = (Ptr S -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr S
psc ->
		CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCoreOld CreateInfo mn
ci \Ptr CreateInfo
pci ->
		M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
macc \Ptr A
pacc -> do
			r <- D -> Ptr CreateInfo -> Ptr A -> Ptr S -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pacc Ptr S
psc
			throwUnlessSuccess $ Result r
			(_, sco) <- readIORef rs
			writeIORef rs . (ex ,) =<< peek psc
			C.destroy dvc sco pacc
	where ex :: Extent2d
ex = CreateInfo mn -> Extent2d
forall (mn :: Maybe (*)). CreateInfo mn -> Extent2d
createInfoImageExtent CreateInfo mn
ci

destroy :: Device.D -> S -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> S -> M A md -> IO ()
destroy (Device.D D
dvc) S
sc M A md
mac = M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac \Ptr A
pac -> do
	sc' <- S -> IO S
sToCore S
sc
	C.destroy dvc sc' pac

createInfoToCoreOld :: WithPoked (TMaybe.M mn) => CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCoreOld :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCoreOld CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoSurface :: forall (mn :: Maybe (*)). CreateInfo mn -> S
createInfoSurface = Surface.M.S S
sfc,
	createInfoMinImageCount :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoMinImageCount = Word32
mic,
	createInfoImageFormat :: forall (mn :: Maybe (*)). CreateInfo mn -> Format
createInfoImageFormat = Format Word32
ifmt,
	createInfoImageColorSpace :: forall (mn :: Maybe (*)). CreateInfo mn -> ColorSpace
createInfoImageColorSpace = ColorSpace Word32
ics,
	createInfoImageExtent :: forall (mn :: Maybe (*)). CreateInfo mn -> Extent2d
createInfoImageExtent = Extent2d
iex,
	createInfoImageArrayLayers :: forall (mn :: Maybe (*)). CreateInfo mn -> Word32
createInfoImageArrayLayers = Word32
ials,
	createInfoImageUsage :: forall (mn :: Maybe (*)). CreateInfo mn -> UsageFlags
createInfoImageUsage = Image.UsageFlagBits Word32
iusg,
	createInfoImageSharingMode :: forall (mn :: Maybe (*)). CreateInfo mn -> SharingMode
createInfoImageSharingMode = SharingMode Word32
ism,
	createInfoQueueFamilyIndices :: forall (mn :: Maybe (*)). CreateInfo mn -> [Index]
createInfoQueueFamilyIndices = ((\(QueueFamily.Index Word32
i) -> Word32
i) (Index -> Word32) -> [Index] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> [Word32]
qfis,
	createInfoPreTransform :: forall (mn :: Maybe (*)). CreateInfo mn -> TransformFlagBits
createInfoPreTransform = TransformFlagBits Word32
pt,
	createInfoCompositeAlpha :: forall (mn :: Maybe (*)). CreateInfo mn -> CompositeAlphaFlagBits
createInfoCompositeAlpha = CompositeAlphaFlagBits Word32
caf,
	createInfoPresentMode :: forall (mn :: Maybe (*)). CreateInfo mn -> PresentMode
createInfoPresentMode = PresentMode Word32
pm,
	createInfoClipped :: forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoClipped = Bool
clpd,
	createInfoOldSwapchain :: forall (mn :: Maybe (*)). CreateInfo mn -> Maybe S
createInfoOldSwapchain = Maybe S
mos } Ptr CreateInfo -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	Int -> (Ptr Word32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
qfic \Ptr Word32
pqfis ->
	Ptr Word32 -> [Word32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word32
pqfis [Word32]
qfis IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	let	ci :: S -> CreateInfo
ci S
os = C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoSurface :: S
C.createInfoSurface = S
sfc,
			createInfoMinImageCount :: Word32
C.createInfoMinImageCount = Word32
mic,
			createInfoImageFormat :: Word32
C.createInfoImageFormat = Word32
ifmt,
			createInfoImageColorSpace :: Word32
C.createInfoImageColorSpace = Word32
ics,
			createInfoImageExtent :: Extent2d
C.createInfoImageExtent = Extent2d
iex,
			createInfoImageArrayLayers :: Word32
C.createInfoImageArrayLayers = Word32
ials,
			createInfoImageUsage :: Word32
C.createInfoImageUsage = Word32
iusg,
			createInfoImageSharingMode :: Word32
C.createInfoImageSharingMode = Word32
ism,
			createInfoQueueFamilyIndexCount :: Word32
C.createInfoQueueFamilyIndexCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
qfic,
			createInfoPQueueFamilyIndices :: Ptr Word32
C.createInfoPQueueFamilyIndices = Ptr Word32
pqfis,
			createInfoPreTransform :: Word32
C.createInfoPreTransform = Word32
pt,
			createInfoCompositeAlpha :: Word32
C.createInfoCompositeAlpha = Word32
caf,
			createInfoPresentMode :: Word32
C.createInfoPresentMode = Word32
pm,
			createInfoClipped :: Word32
C.createInfoClipped = Bool -> Word32
boolToBool32 Bool
clpd,
			createInfoOldSwapchain :: S
C.createInfoOldSwapchain = S
os } in
	case Maybe S
mos of
		Maybe S
Nothing -> CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked (S -> CreateInfo
ci (S -> CreateInfo) -> (WordPtr -> S) -> WordPtr -> CreateInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordPtr -> S
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> CreateInfo) -> WordPtr -> CreateInfo
forall a b. (a -> b) -> a -> b
$ Word -> WordPtr
WordPtr Word
0) Ptr CreateInfo -> IO a
f
{-# LINE 180 "src/Gpu/Vulkan/Khr/Swapchain/Middle/Internal.hsc" #-}
		Just S
s -> S -> IO S
sToCore S
s IO S -> (S -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \S
os -> CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked (S -> CreateInfo
ci S
os) Ptr CreateInfo -> IO a
f
	where qfic :: Int
qfic = [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
qfis

getImages :: Device.D -> S -> IO [Image.I]
getImages :: D -> S -> IO [I]
getImages (Device.D D
dvc) S
sc = ((IORef (Extent3d, I) -> I
Image.I (IORef (Extent3d, I) -> I) -> [IORef (Extent3d, I)] -> [I]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([IORef (Extent3d, I)] -> [I])
-> IO [IORef (Extent3d, I)] -> IO [I]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO [IORef (Extent3d, I)] -> IO [I])
-> IO [IORef (Extent3d, I)] -> IO [I]
forall a b. (a -> b) -> a -> b
$ S -> IO S
sToCore S
sc IO S -> (S -> IO [IORef (Extent3d, I)]) -> IO [IORef (Extent3d, I)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \S
sc' ->
	S -> IO Extent2d
sToExtent S
sc IO Extent2d
-> (Extent2d -> IO [IORef (Extent3d, I)])
-> IO [IORef (Extent3d, I)]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Extent2d
ex ->
	(Ptr Word32 -> IO [IORef (Extent3d, I)])
-> IO [IORef (Extent3d, I)]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pSwapchainImageCount ->
	D -> S -> Ptr Word32 -> Ptr I -> IO Int32
C.getImages D
dvc S
sc' Ptr Word32
pSwapchainImageCount Ptr I
forall a. Ptr a
NullPtr IO Int32
-> (Int32 -> IO [IORef (Extent3d, I)]) -> IO [IORef (Extent3d, I)]
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
pSwapchainImageCount IO Word32
-> (Word32 -> IO [IORef (Extent3d, I)]) -> IO [IORef (Extent3d, I)]
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
swapchainImageCount) ->
	Int
-> (Ptr I -> IO [IORef (Extent3d, I)]) -> IO [IORef (Extent3d, I)]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
swapchainImageCount \Ptr I
pSwapchainImages -> do
		r' <- D -> S -> Ptr Word32 -> Ptr I -> IO Int32
C.getImages D
dvc S
sc' Ptr Word32
pSwapchainImageCount Ptr I
pSwapchainImages
		throwUnlessSuccess $ Result r'
		mapM (newIORef . (extent2dTo3d ex ,))
			=<< peekArray swapchainImageCount pSwapchainImages

sToExtent :: S -> IO C.Extent2d
sToExtent :: S -> IO Extent2d
sToExtent (S IORef (Extent2d, S)
s) = (Extent2d, S) -> Extent2d
forall a b. (a, b) -> a
fst ((Extent2d, S) -> Extent2d) -> IO (Extent2d, S) -> IO Extent2d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Extent2d, S) -> IO (Extent2d, S)
forall a. IORef a -> IO a
readIORef IORef (Extent2d, S)
s

extent2dTo3d :: C.Extent2d -> C.Extent3d
extent2dTo3d :: Extent2d -> Extent3d
extent2dTo3d C.Extent2d { extent2dWidth :: Extent2d -> Word32
C.extent2dWidth = Word32
w, extent2dHeight :: Extent2d -> Word32
C.extent2dHeight = Word32
h } =
	C.Extent3d {
		extent3dWidth :: Word32
C.extent3dWidth = Word32
w, extent3dHeight :: Word32
C.extent3dHeight = Word32
h, extent3dDepth :: Word32
C.extent3dDepth = Word32
1 }

acquireNextImage :: Device.M.D ->
	S -> Word64 -> Maybe Semaphore.M.S -> Maybe Fence.F -> IO Word32
acquireNextImage :: D -> S -> Word64 -> Maybe S -> Maybe F -> IO Word32
acquireNextImage = [Result] -> D -> S -> Word64 -> Maybe S -> Maybe F -> IO Word32
acquireNextImageResult [Result
Success]

acquireNextImageResult :: [Result] -> Device.M.D ->
	S -> Word64 -> Maybe Semaphore.M.S -> Maybe Fence.F -> IO Word32
acquireNextImageResult :: [Result] -> D -> S -> Word64 -> Maybe S -> Maybe F -> IO Word32
acquireNextImageResult [Result]
sccs
	(Device.M.D D
dvc) S
sc Word64
to Maybe S
msmp Maybe F
mfnc = (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pii ->
	S -> IO S
sToCore S
sc IO S -> (S -> 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
>>= \S
sc' -> do
		r <- D -> S -> Word64 -> S -> F -> Ptr Word32 -> IO Int32
C.acquireNextImage D
dvc S
sc' Word64
to S
smp F
fnc Ptr Word32
pii
		throwUnless sccs $ Result r
		peek pii
	where
	smp :: S
smp = S -> (S -> S) -> Maybe S -> S
forall b a. b -> (a -> b) -> Maybe a -> b
maybe S
forall a. Ptr a
NullHandle (\(Semaphore.M.S S
s) -> S
s) Maybe S
msmp
	fnc :: F
fnc = F -> (F -> F) -> Maybe F -> F
forall b a. b -> (a -> b) -> Maybe a -> b
maybe F
forall a. Ptr a
NullHandle (\(Fence.F F
f) -> F
f) Maybe F
mfnc

---------------------------------------------------------------------------

queuePresent :: WithPoked (TMaybe.M mn) => Queue.Q -> PresentInfo mn -> IO ()
queuePresent :: forall (mn :: Maybe (*)).
WithPoked (M mn) =>
Q -> PresentInfo mn -> IO ()
queuePresent (Queue.Q Q
q) PresentInfo mn
pi_ =
	PresentInfo mn -> (PresentInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
PresentInfo mn -> (PresentInfo -> IO a) -> IO ()
presentInfoMiddleToCore PresentInfo mn
pi_ \PresentInfo
cpi -> do
	PresentInfo -> (Ptr PresentInfo -> IO ()) -> IO ()
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked PresentInfo
cpi \Ptr PresentInfo
ppi -> do
		r <- Q -> Ptr PresentInfo -> IO Int32
C.queuePresent Q
q Ptr PresentInfo
ppi
		let	(fromIntegral -> rc) = C.presentInfoSwapchainCount cpi
		rs <- peekArray rc $ C.presentInfoPResults cpi
		throwUnlessSuccesses $ Result <$> rs
		throwUnlessSuccess $ Result r

data PresentInfo mn = PresentInfo {
	forall (mn :: Maybe (*)). PresentInfo mn -> M mn
presentInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). PresentInfo mn -> [S]
presentInfoWaitSemaphores :: [Semaphore.M.S],
	forall (mn :: Maybe (*)). PresentInfo mn -> [(S, Word32)]
presentInfoSwapchainImageIndices ::
		[(S, Word32)] }

deriving instance Show (TMaybe.M mn) => Show (PresentInfo mn)

presentInfoMiddleToCore ::
	WithPoked (TMaybe.M mn) => PresentInfo mn -> (C.PresentInfo -> IO a) -> IO ()
presentInfoMiddleToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
PresentInfo mn -> (PresentInfo -> IO a) -> IO ()
presentInfoMiddleToCore PresentInfo {
	presentInfoNext :: forall (mn :: Maybe (*)). PresentInfo mn -> M mn
presentInfoNext = M mn
mnxt,
	presentInfoWaitSemaphores :: forall (mn :: Maybe (*)). PresentInfo mn -> [S]
presentInfoWaitSemaphores =
		([S] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([S] -> Int) -> ([S] -> [S]) -> [S] -> (Int, [S])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [S] -> [S]
forall a. a -> a
id) ([S] -> (Int, [S])) -> ([S] -> [S]) -> [S] -> (Int, [S])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S -> S
Semaphore.M.unS (S -> S) -> [S] -> [S]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
wsc, [S]
wss),
	presentInfoSwapchainImageIndices :: forall (mn :: Maybe (*)). PresentInfo mn -> [(S, Word32)]
presentInfoSwapchainImageIndices =
		([(S, Word32)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(S, Word32)] -> Int)
-> ([(S, Word32)] -> ([S], [Word32]))
-> [(S, Word32)]
-> (Int, ([S], [Word32]))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ([S], [Word32]) -> ([S], [Word32])
forall a. a -> a
id (([S], [Word32]) -> ([S], [Word32]))
-> ([(S, Word32)] -> ([S], [Word32]))
-> [(S, Word32)]
-> ([S], [Word32])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(S, Word32)] -> ([S], [Word32])
forall a b. [(a, b)] -> ([a], [b])
unzip) -> (Int
scc, ([S]
scs, [Word32]
iis)) } PresentInfo -> IO a
f =
	S -> IO S
sToCore (S -> IO S) -> [S] -> IO [S]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [S]
scs IO [S] -> ([S] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[S]
scs' ->
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	Int -> (Ptr S -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
wsc \Ptr S
pwss ->
	Ptr S -> [S] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr S
pwss [S]
wss IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr S -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
scc \Ptr S
pscs ->
	Ptr S -> [S] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr S
pscs [S]
scs' IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr Word32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
scc \Ptr Word32
piis ->
	Ptr Word32 -> [Word32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word32
piis [Word32]
iis IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr Int32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
scc \Ptr Int32
prs -> PresentInfo -> IO a
f C.PresentInfo {
		presentInfoSType :: ()
C.presentInfoSType = (),
		presentInfoPNext :: Ptr ()
C.presentInfoPNext = Ptr ()
pnxt',
		presentInfoWaitSemaphoreCount :: Word32
C.presentInfoWaitSemaphoreCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wsc,
		presentInfoPWaitSemaphores :: Ptr S
C.presentInfoPWaitSemaphores = Ptr S
pwss,
		presentInfoSwapchainCount :: Word32
C.presentInfoSwapchainCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scc,
		presentInfoPSwapchains :: Ptr S
C.presentInfoPSwapchains = Ptr S
pscs,
		presentInfoPImageIndices :: Ptr Word32
C.presentInfoPImageIndices = Ptr Word32
piis,
		presentInfoPResults :: Ptr Int32
C.presentInfoPResults = Ptr Int32
prs }