{-# LANGUAGE ImportQualifiedPost, PackageImports #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, 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 (

	-- * EXTENSION NAME

	extensionName,

	-- * CREATE

	create, unsafeRecreate, S, CreateInfo(..),

	-- ** Group

	group, Group, create', unsafeDestroy, lookup,

	-- * GET IMAGES

	getImages,

	-- * QUEUE PRESENT

	queuePresent, PresentInfo(..), SwapchainImageIndex(..),		-- VK_KHR_swapchain

	-- * ACQUIRE NEXT IMAGE

	acquireNextImage, acquireNextImageResult,		-- VK_KHR_swapchain


	) where

import Prelude hiding (lookup)
import Foreign.Storable.PeekPoke
import Control.Concurrent.STM
import Control.Concurrent.STM.TSem
import Control.Exception
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry
import Data.Map qualified as Map
import Data.Word
import Data.Fixed.Generic qualified as FixedG

import Gpu.Vulkan
import Gpu.Vulkan.Khr.Surface (
	PresentMode, ColorSpace, TransformFlagBits, CompositeAlphaFlagBits )
import Gpu.Vulkan.Khr.Swapchain.Type
import Gpu.Vulkan.Khr.Swapchain.Enum

import qualified Gpu.Vulkan as C
import qualified Gpu.Vulkan.TypeEnum as T
import qualified Gpu.Vulkan.AllocationCallbacks.Internal as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Internal as Device
import qualified Gpu.Vulkan.Image.Internal as Image
import qualified Gpu.Vulkan.Khr.Swapchain.Middle as M

import qualified Gpu.Vulkan.Image as Image
import qualified Gpu.Vulkan.QueueFamily as QueueFamily
import qualified Gpu.Vulkan.Khr.Surface.Internal as Surface

import Gpu.Vulkan.PhysicalDevice qualified as PhysicalDevice

import qualified Gpu.Vulkan.Semaphore.Internal as Semaphore
import qualified Gpu.Vulkan.Fence.Internal as Fence
import Gpu.Vulkan.Exception
import Data.HeteroParList qualified as HeteroParList
import qualified Gpu.Vulkan.Queue as Queue

extensionName :: PhysicalDevice.ExtensionName
extensionName :: ExtensionName
extensionName = Text -> ExtensionName
PhysicalDevice.ExtensionName Text
M.extensionName

create :: (
	WithPoked (TMaybe.M mn), T.FormatToValue fmt,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> CreateInfo mn ssfc fmt mosas ->
	TPMaybe.M (U2 AllocationCallbacks.A) mac ->
	(forall s . S fmt s -> IO a) -> IO a
create :: forall (mn :: Maybe (*)) (fmt :: Format) (mac :: Maybe (*, *)) sd
       ssfc (mosas :: Maybe (Format, *)) a.
(WithPoked (M mn), FormatToValue fmt, ToMiddle mac) =>
D sd
-> CreateInfo mn ssfc fmt mosas
-> M (U2 A) mac
-> (forall s. S fmt s -> IO a)
-> IO a
create (Device.D D
dvc) CreateInfo mn ssfc fmt mosas
ci (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) forall s. S fmt s -> IO a
f = IO S -> (S -> IO ()) -> (S -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
	(D -> CreateInfo mn -> M A (Snd mac) -> IO S
forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO S
M.create D
dvc (CreateInfo mn ssfc fmt mosas -> CreateInfo mn
forall (n :: Maybe (*)) ss (fmt :: Format)
       (mosas :: Maybe (Format, *)).
FormatToValue fmt =>
CreateInfo n ss fmt mosas -> CreateInfo n
createInfoToMiddle CreateInfo mn ssfc fmt mosas
ci) M A (Snd mac)
mac)
	(\S
sc -> D -> S -> M A (Snd mac) -> IO ()
forall (md :: Maybe (*)). D -> S -> M A md -> IO ()
M.destroy D
dvc S
sc M A (Snd mac)
mac) (S fmt Any -> IO a
forall s. S fmt s -> IO a
f (S fmt Any -> IO a) -> (S -> S fmt Any) -> S -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S -> S fmt Any
forall (fmt :: Format) ss. S -> S fmt ss
S)

unsafeRecreate :: (
	WithPoked (TMaybe.M mn), T.FormatToValue fmt,
	AllocationCallbacks.ToMiddle mac ) =>
	Device.D sd -> CreateInfo mn ssfc fmt mosas ->
	TPMaybe.M (U2 AllocationCallbacks.A) mac -> S fmt ssc -> IO ()
unsafeRecreate :: forall (mn :: Maybe (*)) (fmt :: Format) (mac :: Maybe (*, *)) sd
       ssfc (mosas :: Maybe (Format, *)) ssc.
(WithPoked (M mn), FormatToValue fmt, ToMiddle mac) =>
D sd
-> CreateInfo mn ssfc fmt mosas
-> M (U2 A) mac
-> S fmt ssc
-> IO ()
unsafeRecreate (Device.D D
dvc) CreateInfo mn ssfc fmt mosas
ci (M (U2 A) mac -> M A (Snd mac)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd mac)
mac) (S S
sc) =
	D -> CreateInfo mn -> M A (Snd mac) -> S -> IO ()
forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> S -> IO ()
M.recreate D
dvc (CreateInfo mn ssfc fmt mosas -> CreateInfo mn
forall (n :: Maybe (*)) ss (fmt :: Format)
       (mosas :: Maybe (Format, *)).
FormatToValue fmt =>
CreateInfo n ss fmt mosas -> CreateInfo n
createInfoToMiddle CreateInfo mn ssfc fmt mosas
ci) M A (Snd mac)
mac S
sc

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

deriving instance (Show (TMaybe.M mn), Show (TPMaybe.M (U2 S) mosas)) =>
	Show (CreateInfo mn ss fmt mosas)

createInfoToMiddle :: forall n ss fmt mosas . T.FormatToValue fmt =>
	CreateInfo n ss fmt mosas -> M.CreateInfo n
createInfoToMiddle :: forall (n :: Maybe (*)) ss (fmt :: Format)
       (mosas :: Maybe (Format, *)).
FormatToValue fmt =>
CreateInfo n ss fmt mosas -> CreateInfo n
createInfoToMiddle CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> M mn
createInfoNext = M n
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> CreateFlags
createInfoFlags = CreateFlags
flgs,
	createInfoSurface :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> S ssfc
createInfoSurface = Surface.S S
sfc,
	createInfoMinImageCount :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> Word32
createInfoMinImageCount = Word32
mic,
	createInfoImageColorSpace :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> ColorSpace
createInfoImageColorSpace = ColorSpace
cs,
	createInfoImageExtent :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> Extent2d
createInfoImageExtent = Extent2d
ext,
	createInfoImageArrayLayers :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> Word32
createInfoImageArrayLayers = Word32
ials,
	createInfoImageUsage :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> UsageFlags
createInfoImageUsage = UsageFlags
usg,
	createInfoImageSharingMode :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> SharingMode
createInfoImageSharingMode = SharingMode
sm,
	createInfoQueueFamilyIndices :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> [Index]
createInfoQueueFamilyIndices = [Index]
qfis,
	createInfoPreTransform :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> TransformFlagBits
createInfoPreTransform = TransformFlagBits
ptfm,
	createInfoCompositeAlpha :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> CompositeAlphaFlagBits
createInfoCompositeAlpha = CompositeAlphaFlagBits
calph,
	createInfoPresentMode :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> PresentMode
createInfoPresentMode = PresentMode
pm,
	createInfoClipped :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> Bool
createInfoClipped = Bool
clpd,
	createInfoOldSwapchain :: forall (mn :: Maybe (*)) ssfc (fmt :: Format)
       (mosas :: Maybe (Format, *)).
CreateInfo mn ssfc fmt mosas -> M (U2 S) mosas
createInfoOldSwapchain = M (U2 S) mosas
mosc } = M.CreateInfo {
	createInfoNext :: M n
M.createInfoNext = M n
mnxt,
	createInfoFlags :: CreateFlags
M.createInfoFlags = CreateFlags
flgs,
	createInfoSurface :: S
M.createInfoSurface = S
sfc,
	createInfoMinImageCount :: Word32
M.createInfoMinImageCount = Word32
mic,
	createInfoImageFormat :: Format
M.createInfoImageFormat = forall (t :: Format). FormatToValue t => Format
T.formatToValue @fmt,
	createInfoImageColorSpace :: ColorSpace
M.createInfoImageColorSpace = ColorSpace
cs,
	createInfoImageExtent :: Extent2d
M.createInfoImageExtent = Extent2d
ext,
	createInfoImageArrayLayers :: Word32
M.createInfoImageArrayLayers = Word32
ials,
	createInfoImageUsage :: UsageFlags
M.createInfoImageUsage = UsageFlags
usg,
	createInfoImageSharingMode :: SharingMode
M.createInfoImageSharingMode = SharingMode
sm,
	createInfoQueueFamilyIndices :: [Index]
M.createInfoQueueFamilyIndices = [Index]
qfis,
	createInfoPreTransform :: TransformFlagBits
M.createInfoPreTransform = TransformFlagBits
ptfm,
	createInfoCompositeAlpha :: CompositeAlphaFlagBits
M.createInfoCompositeAlpha = CompositeAlphaFlagBits
calph,
	createInfoPresentMode :: PresentMode
M.createInfoPresentMode = PresentMode
pm,
	createInfoClipped :: Bool
M.createInfoClipped = Bool
clpd,
	createInfoOldSwapchain :: Maybe S
M.createInfoOldSwapchain =
		Maybe S
-> (forall (s :: (Format, *)). U2 S s -> Maybe S)
-> M (U2 S) mosas
-> Maybe S
forall {k} a (t :: k -> *) (ms :: Maybe k).
a -> (forall (s :: k). t s -> a) -> M t ms -> a
TPMaybe.maybe Maybe S
forall a. Maybe a
Nothing (\(U2 (S S
ms)) -> S -> Maybe S
forall a. a -> Maybe a
Just S
ms) M (U2 S) mosas
mosc }

getImages :: Device.D sd -> S fmt ss -> IO [Image.Binded ss ss nm fmt]
getImages :: forall sd (fmt :: Format) ss (nm :: Symbol).
D sd -> S fmt ss -> IO [Binded ss ss nm fmt]
getImages (Device.D D
d) (S S
sc) = (I -> Binded ss ss nm fmt
forall sm si (nm :: Symbol) (fmt :: Format).
I -> Binded sm si nm fmt
Image.Binded (I -> Binded ss ss nm fmt) -> [I] -> [Binded ss ss nm fmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([I] -> [Binded ss ss nm fmt])
-> IO [I] -> IO [Binded ss ss nm fmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> S -> IO [I]
M.getImages D
d S
sc

data Group sd ma fmt ssc k = Group (Device.D sd)
	(TPMaybe.M (U2 AllocationCallbacks.A) ma) TSem (TVar (Map.Map k (S fmt ssc)))

group :: forall fmt k sd ma a .
	AllocationCallbacks.ToMiddle ma =>
	Device.D sd -> TPMaybe.M (U2 AllocationCallbacks.A) ma ->
	(forall ssc . Group sd ma fmt ssc k -> IO a) -> IO a
group :: forall (fmt :: Format) k sd (ma :: Maybe (*, *)) a.
ToMiddle ma =>
D sd
-> M (U2 A) ma
-> (forall ssc. Group sd ma fmt ssc k -> IO a)
-> IO a
group dvc :: D sd
dvc@(Device.D D
mdvc) mac :: M (U2 A) ma
mac@(M (U2 A) ma -> M A (Snd ma)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd ma)
mmac) forall ssc. Group sd ma fmt ssc k -> IO a
f = do
	(sem, m) <- STM (TSem, TVar (Map k (S fmt Any)))
-> IO (TSem, TVar (Map k (S fmt Any)))
forall a. STM a -> IO a
atomically (STM (TSem, TVar (Map k (S fmt Any)))
 -> IO (TSem, TVar (Map k (S fmt Any))))
-> STM (TSem, TVar (Map k (S fmt Any)))
-> IO (TSem, TVar (Map k (S fmt Any)))
forall a b. (a -> b) -> a -> b
$ (,) (TSem
 -> TVar (Map k (S fmt Any)) -> (TSem, TVar (Map k (S fmt Any))))
-> STM TSem
-> STM
     (TVar (Map k (S fmt Any)) -> (TSem, TVar (Map k (S fmt Any))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> STM TSem
newTSem Integer
1 STM (TVar (Map k (S fmt Any)) -> (TSem, TVar (Map k (S fmt Any))))
-> STM (TVar (Map k (S fmt Any)))
-> STM (TSem, TVar (Map k (S fmt Any)))
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map k (S fmt Any) -> STM (TVar (Map k (S fmt Any)))
forall a. a -> STM (TVar a)
newTVar Map k (S fmt Any)
forall k a. Map k a
Map.empty
	rtn <- f $ Group dvc mac sem m
	((\(S S
s) -> D -> S -> M A (Snd ma) -> IO ()
forall (md :: Maybe (*)). D -> S -> M A md -> IO ()
M.destroy D
mdvc S
s M A (Snd ma)
mmac) `mapM_`) =<< atomically (readTVar m)
	pure rtn

create' :: (
	T.FormatToValue fmt,
	Ord k, WithPoked (TMaybe.M mn), AllocationCallbacks.ToMiddle ma ) =>
	Group sd ma fmt ss k -> k -> CreateInfo mn ssfc fmt mosas ->
	IO (Either String (S fmt ss))
create' :: forall (fmt :: Format) k (mn :: Maybe (*)) (ma :: Maybe (*, *)) sd
       ss ssfc (mosas :: Maybe (Format, *)).
(FormatToValue fmt, Ord k, WithPoked (M mn), ToMiddle ma) =>
Group sd ma fmt ss k
-> k
-> CreateInfo mn ssfc fmt mosas
-> IO (Either String (S fmt ss))
create' (Group (Device.D D
mdvc)
	(M (U2 A) ma -> M A (Snd ma)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd ma)
mmac) TSem
sem TVar (Map k (S fmt ss))
ss) k
k
	(CreateInfo mn ssfc fmt mosas -> CreateInfo mn
forall (n :: Maybe (*)) ss (fmt :: Format)
       (mosas :: Maybe (Format, *)).
FormatToValue fmt =>
CreateInfo n ss fmt mosas -> CreateInfo n
createInfoToMiddle -> CreateInfo mn
mci) = do
	ok <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically do
		mx <- k -> Map k (S fmt ss) -> Maybe (S fmt ss)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (Map k (S fmt ss) -> Maybe (S fmt ss))
-> STM (Map k (S fmt ss)) -> STM (Maybe (S fmt ss))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map k (S fmt ss)) -> STM (Map k (S fmt ss))
forall a. TVar a -> STM a
readTVar TVar (Map k (S fmt ss))
ss
		case mx of
			Maybe (S fmt ss)
Nothing -> TSem -> STM ()
waitTSem TSem
sem STM () -> STM Bool -> STM Bool
forall a b. STM a -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
			Just S fmt ss
_ -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
	if ok
	then do	s <- M.create mdvc mci mmac
		let	s' = S -> S fmt ss
forall (fmt :: Format) ss. S -> S fmt ss
S S
s
		atomically $ modifyTVar ss (Map.insert k s') >> signalTSem sem
		pure $ Right s'
	else pure . Left $
		"Gpu.Vulkan.Khr.Swapchain.create': The key already exist"

unsafeDestroy :: (Ord k, AllocationCallbacks.ToMiddle ma) =>
	Group sd ma fmt ssc k -> k -> IO (Either String ())
unsafeDestroy :: forall k (ma :: Maybe (*, *)) sd (fmt :: Format) ssc.
(Ord k, ToMiddle ma) =>
Group sd ma fmt ssc k -> k -> IO (Either String ())
unsafeDestroy (Group (Device.D D
mdvc)
	(M (U2 A) ma -> M A (Snd ma)
forall (msa :: Maybe (*, *)).
ToMiddle msa =>
M (U2 A) msa -> M A (Snd msa)
AllocationCallbacks.toMiddle -> M A (Snd ma)
ma) TSem
sem TVar (Map k (S fmt ssc))
scs) k
k = do
	msc <- STM (Maybe (S fmt ssc)) -> IO (Maybe (S fmt ssc))
forall a. STM a -> IO a
atomically do
		mx <- k -> Map k (S fmt ssc) -> Maybe (S fmt ssc)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (Map k (S fmt ssc) -> Maybe (S fmt ssc))
-> STM (Map k (S fmt ssc)) -> STM (Maybe (S fmt ssc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map k (S fmt ssc)) -> STM (Map k (S fmt ssc))
forall a. TVar a -> STM a
readTVar TVar (Map k (S fmt ssc))
scs
		case mx of
			Maybe (S fmt ssc)
Nothing -> Maybe (S fmt ssc) -> STM (Maybe (S fmt ssc))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (S fmt ssc)
forall a. Maybe a
Nothing
			Just S fmt ssc
_ -> TSem -> STM ()
waitTSem TSem
sem STM () -> STM (Maybe (S fmt ssc)) -> STM (Maybe (S fmt ssc))
forall a b. STM a -> STM b -> STM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (S fmt ssc) -> STM (Maybe (S fmt ssc))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (S fmt ssc)
mx
	case msc of
		Maybe (S fmt ssc)
Nothing -> Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left
			String
"Gpu.Vulkan.Khr.Swapchain.destroy: No such key"
		Just (S S
sc) -> do
			D -> S -> M A (Snd ma) -> IO ()
forall (md :: Maybe (*)). D -> S -> M A md -> IO ()
M.destroy D
mdvc S
sc M A (Snd ma)
ma
			STM (Either String ()) -> IO (Either String ())
forall a. STM a -> IO a
atomically do
				TVar (Map k (S fmt ssc))
-> (Map k (S fmt ssc) -> Map k (S fmt ssc)) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map k (S fmt ssc))
scs ((Map k (S fmt ssc) -> Map k (S fmt ssc)) -> STM ())
-> (Map k (S fmt ssc) -> Map k (S fmt ssc)) -> STM ()
forall a b. (a -> b) -> a -> b
$ k -> Map k (S fmt ssc) -> Map k (S fmt ssc)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k
				TSem -> STM ()
signalTSem TSem
sem
				Either String () -> STM (Either String ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> STM (Either String ()))
-> Either String () -> STM (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()

lookup :: Ord k => Group sd ma fmt ssc k -> k -> IO (Maybe (S fmt ssc))
lookup :: forall k sd (ma :: Maybe (*, *)) (fmt :: Format) ssc.
Ord k =>
Group sd ma fmt ssc k -> k -> IO (Maybe (S fmt ssc))
lookup (Group D sd
_ M (U2 A) ma
_ TSem
_sem TVar (Map k (S fmt ssc))
scs) k
k = STM (Maybe (S fmt ssc)) -> IO (Maybe (S fmt ssc))
forall a. STM a -> IO a
atomically (STM (Maybe (S fmt ssc)) -> IO (Maybe (S fmt ssc)))
-> STM (Maybe (S fmt ssc)) -> IO (Maybe (S fmt ssc))
forall a b. (a -> b) -> a -> b
$ k -> Map k (S fmt ssc) -> Maybe (S fmt ssc)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k (Map k (S fmt ssc) -> Maybe (S fmt ssc))
-> STM (Map k (S fmt ssc)) -> STM (Maybe (S fmt ssc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map k (S fmt ssc)) -> STM (Map k (S fmt ssc))
forall a. TVar a -> STM a
readTVar TVar (Map k (S fmt ssc))
scs

queuePresent :: WithPoked (TMaybe.M mn) =>
	Queue.Q -> PresentInfo mn swss scfmt sscs -> IO ()
queuePresent :: forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
WithPoked (M mn) =>
Q -> PresentInfo mn swss scfmt sscs -> IO ()
queuePresent Q
q = Q -> PresentInfo mn -> IO ()
forall (mn :: Maybe (*)).
WithPoked (M mn) =>
Q -> PresentInfo mn -> IO ()
M.queuePresent Q
q (PresentInfo mn -> IO ())
-> (PresentInfo mn swss scfmt sscs -> PresentInfo mn)
-> PresentInfo mn swss scfmt sscs
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PresentInfo mn swss scfmt sscs -> PresentInfo mn
forall (mn :: Maybe (*)) (sws :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn sws scfmt sscs -> PresentInfo mn
presentInfoToMiddle

data PresentInfo mn swss scfmt sscs = PresentInfo {
	forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs -> M mn
presentInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs -> PL S swss
presentInfoWaitSemaphores :: HeteroParList.PL Semaphore.S swss,
	forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs
-> PL (SwapchainImageIndex scfmt) sscs
presentInfoSwapchainImageIndices ::
		HeteroParList.PL (SwapchainImageIndex scfmt) sscs }

presentInfoToMiddle :: PresentInfo mn sws scfmt sscs -> M.PresentInfo mn
presentInfoToMiddle :: forall (mn :: Maybe (*)) (sws :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn sws scfmt sscs -> PresentInfo mn
presentInfoToMiddle PresentInfo {
	presentInfoNext :: forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs -> M mn
presentInfoNext = M mn
mnxt,
	presentInfoWaitSemaphores :: forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs -> PL S swss
presentInfoWaitSemaphores =
		(forall s. S s -> S) -> PL S sws -> [S]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList (\(Semaphore.S S
s) -> S
s) -> [S]
wss,
	presentInfoSwapchainImageIndices :: forall (mn :: Maybe (*)) (swss :: [*]) (scfmt :: Format)
       (sscs :: [*]).
PresentInfo mn swss scfmt sscs
-> PL (SwapchainImageIndex scfmt) sscs
presentInfoSwapchainImageIndices =
		(forall s. SwapchainImageIndex scfmt s -> (S, Word32))
-> PL (SwapchainImageIndex scfmt) sscs -> [(S, Word32)]
forall k (t :: k -> *) a (ss :: [k]).
(forall (s :: k). t s -> a) -> PL t ss -> [a]
HeteroParList.toList SwapchainImageIndex scfmt s -> (S, Word32)
forall s. SwapchainImageIndex scfmt s -> (S, Word32)
forall (scfmt :: Format) ssc.
SwapchainImageIndex scfmt ssc -> (S, Word32)
swapchainImageIndexToMiddle -> [(S, Word32)]
sciis
	} = M.PresentInfo {
		presentInfoNext :: M mn
M.presentInfoNext = M mn
mnxt,
		presentInfoWaitSemaphores :: [S]
M.presentInfoWaitSemaphores = [S]
wss,
		presentInfoSwapchainImageIndices :: [(S, Word32)]
M.presentInfoSwapchainImageIndices = [(S, Word32)]
sciis }

data SwapchainImageIndex scfmt ssc =
	SwapchainImageIndex (S scfmt ssc) Word32 deriving Int -> SwapchainImageIndex scfmt ssc -> ShowS
[SwapchainImageIndex scfmt ssc] -> ShowS
SwapchainImageIndex scfmt ssc -> String
(Int -> SwapchainImageIndex scfmt ssc -> ShowS)
-> (SwapchainImageIndex scfmt ssc -> String)
-> ([SwapchainImageIndex scfmt ssc] -> ShowS)
-> Show (SwapchainImageIndex scfmt ssc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (scfmt :: Format) ssc.
Int -> SwapchainImageIndex scfmt ssc -> ShowS
forall (scfmt :: Format) ssc.
[SwapchainImageIndex scfmt ssc] -> ShowS
forall (scfmt :: Format) ssc.
SwapchainImageIndex scfmt ssc -> String
$cshowsPrec :: forall (scfmt :: Format) ssc.
Int -> SwapchainImageIndex scfmt ssc -> ShowS
showsPrec :: Int -> SwapchainImageIndex scfmt ssc -> ShowS
$cshow :: forall (scfmt :: Format) ssc.
SwapchainImageIndex scfmt ssc -> String
show :: SwapchainImageIndex scfmt ssc -> String
$cshowList :: forall (scfmt :: Format) ssc.
[SwapchainImageIndex scfmt ssc] -> ShowS
showList :: [SwapchainImageIndex scfmt ssc] -> ShowS
Show

swapchainImageIndexToMiddle ::
	SwapchainImageIndex scfmt ssc -> (M.S, Word32)
swapchainImageIndexToMiddle :: forall (scfmt :: Format) ssc.
SwapchainImageIndex scfmt ssc -> (S, Word32)
swapchainImageIndexToMiddle (SwapchainImageIndex (S S
sc) Word32
idx) =
	(S
sc, Word32
idx)

acquireNextImage :: Device.D sd ->
	S scfmt ssc -> Maybe Sec -> Maybe (Semaphore.S ss) -> Maybe (Fence.F sf) -> IO Word32
acquireNextImage :: forall sd (scfmt :: Format) ssc ss sf.
D sd
-> S scfmt ssc
-> Maybe Sec
-> Maybe (S ss)
-> Maybe (F sf)
-> IO Word32
acquireNextImage = [Result]
-> D sd
-> S scfmt ssc
-> Maybe Sec
-> Maybe (S ss)
-> Maybe (F sf)
-> IO Word32
forall sd (scfmt :: Format) ssc ss sf.
[Result]
-> D sd
-> S scfmt ssc
-> Maybe Sec
-> Maybe (S ss)
-> Maybe (F sf)
-> IO Word32
acquireNextImageResult [Result
Success]

acquireNextImageResult :: [Result] -> Device.D sd ->
	S scfmt ssc -> Maybe Sec -> Maybe (Semaphore.S ss) -> Maybe (Fence.F sf) -> IO Word32
acquireNextImageResult :: forall sd (scfmt :: Format) ssc ss sf.
[Result]
-> D sd
-> S scfmt ssc
-> Maybe Sec
-> Maybe (S ss)
-> Maybe (F sf)
-> IO Word32
acquireNextImageResult [Result]
sccs (Device.D D
mdvc) (S S
msc)
	(Word64 -> (Sec -> Word64) -> Maybe Sec -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
forall a. Bounded a => a
maxBound (\(Sec (FixedG.MkF Word64
ns)) -> Word64
ns) -> Word64
to)
	Maybe (S ss)
msmp (((\(Fence.F F
f) -> F
f) (F sf -> F) -> Maybe (F sf) -> Maybe F
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> Maybe F
mfnc) =
	[Result] -> D -> S -> Word64 -> Maybe S -> Maybe F -> IO Word32
M.acquireNextImageResult
		[Result]
sccs D
mdvc S
msc Word64
to ((\(Semaphore.S S
smp) -> S
smp) (S ss -> S) -> Maybe (S ss) -> Maybe S
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (S ss)
msmp) Maybe F
mfnc