{-# LINE 1 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Middle.Internal (
	ApplicationInfo(..), applicationInfoToCore,
	ApiVersion(..), makeApiVersion, apiVersion_1_0, apiVersion_1_1,
	LayerProperties(..), layerPropertiesFromCore,
	ExtensionProperties(..), extensionPropertiesFromCore,
	StencilOpState(..), stencilOpStateToCore,
	ClearValue(..), ClearValueListToCore(..),
	ClearValueToCore, ClearColorValueToCore,
	clearValueListToArray,
	ClearType(..), ClearColorType(..),

	C.ClearDepthStencilValue, pattern C.ClearDepthStencilValue,
	C.clearDepthStencilValueDepth, C.clearDepthStencilValueStencil,

	SubmitInfo(..), SubmitInfoListToCore(..), submitInfoToCore,

	FormatProperties(..), formatPropertiesFromCore,

	C.Rect2d, pattern C.Rect2d, C.rect2dExtent, C.rect2dOffset,

	C.Offset2d, pattern C.Offset2d, C.offset2dX, C.offset2dY,
	C.Offset3d, pattern C.Offset3d, C.offset3dX, C.offset3dY, C.offset3dZ,

	C.Extent2d, pattern C.Extent2d, C.extent2dWidth, C.extent2dHeight,
	C.Extent3d,
	pattern C.Extent3d, C.extent3dWidth, C.extent3dHeight, C.extent3dDepth,

	C.Viewport, pattern C.Viewport,
	C.viewportX, C.viewportY, C.viewportWidth, C.viewportHeight,
	C.viewportMinDepth, C.viewportMaxDepth,

	Size(..)

	) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Control.Arrow
import Control.Monad
import Data.Default
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.List qualified as TL
import Data.HeteroParList qualified as HeteroParList
import Data.HeteroParList (pattern (:**))
import Data.Word
import Data.Text.Foreign.MiscYj
import Data.Color.Internal

import qualified Data.Text as T

import Gpu.Vulkan.Enum

import qualified Gpu.Vulkan.Core as C

import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline
import qualified Gpu.Vulkan.Semaphore.Middle.Internal as Semaphore
import {-# SOURCE #-} qualified
	Gpu.Vulkan.CommandBuffer.Middle.Internal as CommandBuffer

import Gpu.Vulkan.Middle.Types



data ApplicationInfo mn = ApplicationInfo {
	forall (mn :: Maybe (*)). ApplicationInfo mn -> M mn
applicationInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). ApplicationInfo mn -> Text
applicationInfoApplicationName :: T.Text,
	forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoApplicationVersion :: ApiVersion,
	forall (mn :: Maybe (*)). ApplicationInfo mn -> Text
applicationInfoEngineName :: T.Text,
	forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoEngineVersion :: ApiVersion,
	forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoApiVersion :: ApiVersion }

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

newtype ApiVersion = ApiVersion C.ApiVersion deriving (Int -> ApiVersion -> ShowS
[ApiVersion] -> ShowS
ApiVersion -> String
(Int -> ApiVersion -> ShowS)
-> (ApiVersion -> String)
-> ([ApiVersion] -> ShowS)
-> Show ApiVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiVersion -> ShowS
showsPrec :: Int -> ApiVersion -> ShowS
$cshow :: ApiVersion -> String
show :: ApiVersion -> String
$cshowList :: [ApiVersion] -> ShowS
showList :: [ApiVersion] -> ShowS
Show, ApiVersion -> ApiVersion -> Bool
(ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool) -> Eq ApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiVersion -> ApiVersion -> Bool
== :: ApiVersion -> ApiVersion -> Bool
$c/= :: ApiVersion -> ApiVersion -> Bool
/= :: ApiVersion -> ApiVersion -> Bool
Eq, Eq ApiVersion
Eq ApiVersion =>
(ApiVersion -> ApiVersion -> Ordering)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> ApiVersion)
-> (ApiVersion -> ApiVersion -> ApiVersion)
-> Ord ApiVersion
ApiVersion -> ApiVersion -> Bool
ApiVersion -> ApiVersion -> Ordering
ApiVersion -> ApiVersion -> ApiVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApiVersion -> ApiVersion -> Ordering
compare :: ApiVersion -> ApiVersion -> Ordering
$c< :: ApiVersion -> ApiVersion -> Bool
< :: ApiVersion -> ApiVersion -> Bool
$c<= :: ApiVersion -> ApiVersion -> Bool
<= :: ApiVersion -> ApiVersion -> Bool
$c> :: ApiVersion -> ApiVersion -> Bool
> :: ApiVersion -> ApiVersion -> Bool
$c>= :: ApiVersion -> ApiVersion -> Bool
>= :: ApiVersion -> ApiVersion -> Bool
$cmax :: ApiVersion -> ApiVersion -> ApiVersion
max :: ApiVersion -> ApiVersion -> ApiVersion
$cmin :: ApiVersion -> ApiVersion -> ApiVersion
min :: ApiVersion -> ApiVersion -> ApiVersion
Ord, Ptr ApiVersion -> IO ApiVersion
Ptr ApiVersion -> Int -> IO ApiVersion
Ptr ApiVersion -> Int -> ApiVersion -> IO ()
Ptr ApiVersion -> ApiVersion -> IO ()
ApiVersion -> Int
(ApiVersion -> Int)
-> (ApiVersion -> Int)
-> (Ptr ApiVersion -> Int -> IO ApiVersion)
-> (Ptr ApiVersion -> Int -> ApiVersion -> IO ())
-> (forall b. Ptr b -> Int -> IO ApiVersion)
-> (forall b. Ptr b -> Int -> ApiVersion -> IO ())
-> (Ptr ApiVersion -> IO ApiVersion)
-> (Ptr ApiVersion -> ApiVersion -> IO ())
-> Storable ApiVersion
forall b. Ptr b -> Int -> IO ApiVersion
forall b. Ptr b -> Int -> ApiVersion -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: ApiVersion -> Int
sizeOf :: ApiVersion -> Int
$calignment :: ApiVersion -> Int
alignment :: ApiVersion -> Int
$cpeekElemOff :: Ptr ApiVersion -> Int -> IO ApiVersion
peekElemOff :: Ptr ApiVersion -> Int -> IO ApiVersion
$cpokeElemOff :: Ptr ApiVersion -> Int -> ApiVersion -> IO ()
pokeElemOff :: Ptr ApiVersion -> Int -> ApiVersion -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ApiVersion
peekByteOff :: forall b. Ptr b -> Int -> IO ApiVersion
$cpokeByteOff :: forall b. Ptr b -> Int -> ApiVersion -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ApiVersion -> IO ()
$cpeek :: Ptr ApiVersion -> IO ApiVersion
peek :: Ptr ApiVersion -> IO ApiVersion
$cpoke :: Ptr ApiVersion -> ApiVersion -> IO ()
poke :: Ptr ApiVersion -> ApiVersion -> IO ()
Storable)

apiVersion_1_0, apiVersion_1_1 :: ApiVersion
apiVersion_1_0 :: ApiVersion
apiVersion_1_0 = Word32 -> ApiVersion
ApiVersion Word32
C.apiVersion_1_0
apiVersion_1_1 :: ApiVersion
apiVersion_1_1 = Word32 -> ApiVersion
ApiVersion Word32
C.apiVersion_1_1

type Variant = Word8	-- 0 <= variant < 8
type Major = Word8	-- 0 <= major < 127
type Minor = Word16	-- 0 <= minor < 1023
type Patch = Word16	-- 0 <= patch < 4095

makeApiVersion :: Variant -> Major -> Minor -> Patch -> ApiVersion
makeApiVersion :: Variant -> Variant -> Minor -> Minor -> ApiVersion
makeApiVersion Variant
v Variant
mj Minor
mn Minor
p = Word32 -> ApiVersion
ApiVersion (Word32 -> ApiVersion) -> Word32 -> ApiVersion
forall a b. (a -> b) -> a -> b
$ Variant -> Variant -> Minor -> Minor -> Word32
C.makeApiVersion Variant
v Variant
mj Minor
mn Minor
p

applicationInfoToCore :: WithPoked (TMaybe.M mn) =>
	ApplicationInfo mn -> (Ptr C.ApplicationInfo -> IO a) -> IO ()
applicationInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
ApplicationInfo mn -> (Ptr ApplicationInfo -> IO a) -> IO ()
applicationInfoToCore ApplicationInfo {
	applicationInfoNext :: forall (mn :: Maybe (*)). ApplicationInfo mn -> M mn
applicationInfoNext = M mn
mnxt,
	applicationInfoApplicationName :: forall (mn :: Maybe (*)). ApplicationInfo mn -> Text
applicationInfoApplicationName = Text
anm,
	applicationInfoApplicationVersion :: forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoApplicationVersion = (\(ApiVersion Word32
v) -> Word32
v) -> Word32
appv,
	applicationInfoEngineName :: forall (mn :: Maybe (*)). ApplicationInfo mn -> Text
applicationInfoEngineName = Text
enm,
	applicationInfoEngineVersion :: forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoEngineVersion = (\(ApiVersion Word32
v) -> Word32
v) -> Word32
engv,
	applicationInfoApiVersion :: forall (mn :: Maybe (*)). ApplicationInfo mn -> ApiVersion
applicationInfoApiVersion = (\(ApiVersion Word32
v) -> Word32
v) -> Word32
apiv
	} Ptr ApplicationInfo -> 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') ->
	Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
textToCString Text
anm \CString
canm -> Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
textToCString Text
enm \CString
cenm ->
	let	appInfo :: ApplicationInfo
appInfo = C.ApplicationInfo {
			applicationInfoSType :: ()
C.applicationInfoSType = (),
			applicationInfoPNext :: Ptr ()
C.applicationInfoPNext = Ptr ()
pnxt',
			applicationInfoPApplicationName :: CString
C.applicationInfoPApplicationName = CString
canm,
			applicationInfoApplicationVersion :: Word32
C.applicationInfoApplicationVersion = Word32
appv,
			applicationInfoPEngineName :: CString
C.applicationInfoPEngineName = CString
cenm,
			applicationInfoEngineVersion :: Word32
C.applicationInfoEngineVersion = Word32
engv,
			applicationInfoApiVersion :: Word32
C.applicationInfoApiVersion = Word32
apiv } in
	ApplicationInfo -> (Ptr ApplicationInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked ApplicationInfo
appInfo Ptr ApplicationInfo -> IO a
f

data ExtensionProperties = ExtensionProperties {
	ExtensionProperties -> Text
extensionPropertiesExtensionName :: T.Text,
	ExtensionProperties -> ApiVersion
extensionPropertiesSpecVersion :: ApiVersion }
	deriving Int -> ExtensionProperties -> ShowS
[ExtensionProperties] -> ShowS
ExtensionProperties -> String
(Int -> ExtensionProperties -> ShowS)
-> (ExtensionProperties -> String)
-> ([ExtensionProperties] -> ShowS)
-> Show ExtensionProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionProperties -> ShowS
showsPrec :: Int -> ExtensionProperties -> ShowS
$cshow :: ExtensionProperties -> String
show :: ExtensionProperties -> String
$cshowList :: [ExtensionProperties] -> ShowS
showList :: [ExtensionProperties] -> ShowS
Show

extensionPropertiesFromCore :: C.ExtensionProperties -> ExtensionProperties
extensionPropertiesFromCore :: ExtensionProperties -> ExtensionProperties
extensionPropertiesFromCore C.ExtensionProperties {
	extensionPropertiesExtensionName :: ExtensionProperties -> Text
C.extensionPropertiesExtensionName = Text
en,
	extensionPropertiesSpecVersion :: ExtensionProperties -> Word32
C.extensionPropertiesSpecVersion = Word32
sv } = ExtensionProperties {
		extensionPropertiesExtensionName :: Text
extensionPropertiesExtensionName = Text
en,
		extensionPropertiesSpecVersion :: ApiVersion
extensionPropertiesSpecVersion = Word32 -> ApiVersion
ApiVersion Word32
sv }

data LayerProperties = LayerProperties {
	LayerProperties -> Text
layerPropertiesLayerName :: T.Text,
	LayerProperties -> ApiVersion
layerPropertiesSpecVersion :: ApiVersion,
	LayerProperties -> ApiVersion
layerPropertiesImplementationVersion :: ApiVersion,
	LayerProperties -> Text
layerPropertiesDescription :: T.Text }
	deriving Int -> LayerProperties -> ShowS
[LayerProperties] -> ShowS
LayerProperties -> String
(Int -> LayerProperties -> ShowS)
-> (LayerProperties -> String)
-> ([LayerProperties] -> ShowS)
-> Show LayerProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerProperties -> ShowS
showsPrec :: Int -> LayerProperties -> ShowS
$cshow :: LayerProperties -> String
show :: LayerProperties -> String
$cshowList :: [LayerProperties] -> ShowS
showList :: [LayerProperties] -> ShowS
Show

layerPropertiesFromCore :: C.LayerProperties -> LayerProperties
layerPropertiesFromCore :: LayerProperties -> LayerProperties
layerPropertiesFromCore C.LayerProperties {
	layerPropertiesLayerName :: LayerProperties -> Text
C.layerPropertiesLayerName = Text
ln,
	layerPropertiesSpecVersion :: LayerProperties -> Word32
C.layerPropertiesSpecVersion = Word32
sv,
	layerPropertiesImplementationVersion :: LayerProperties -> Word32
C.layerPropertiesImplementationVersion = Word32
iv,
	layerPropertiesDescription :: LayerProperties -> Text
C.layerPropertiesDescription = Text
dsc } = LayerProperties {
	layerPropertiesLayerName :: Text
layerPropertiesLayerName = Text
ln,
	layerPropertiesSpecVersion :: ApiVersion
layerPropertiesSpecVersion = Word32 -> ApiVersion
ApiVersion Word32
sv,
	layerPropertiesImplementationVersion :: ApiVersion
layerPropertiesImplementationVersion = Word32 -> ApiVersion
ApiVersion Word32
iv,
	layerPropertiesDescription :: Text
layerPropertiesDescription = Text
dsc }

data StencilOpState = StencilOpState {
	StencilOpState -> StencilOp
stencilOpStateFailOp :: StencilOp,
	StencilOpState -> StencilOp
stencilOpStatePassOp :: StencilOp,
	StencilOpState -> StencilOp
stencilOpStateDepthFailOp :: StencilOp,
	StencilOpState -> CompareOp
stencilOpStateCompareOp :: CompareOp,
	StencilOpState -> Word32
stencilOpStateCompareMask :: Word32,
	StencilOpState -> Word32
stencilOpStateWriteMask :: Word32,
	StencilOpState -> Word32
stencilOpStateReference :: Word32 }
	deriving Int -> StencilOpState -> ShowS
[StencilOpState] -> ShowS
StencilOpState -> String
(Int -> StencilOpState -> ShowS)
-> (StencilOpState -> String)
-> ([StencilOpState] -> ShowS)
-> Show StencilOpState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StencilOpState -> ShowS
showsPrec :: Int -> StencilOpState -> ShowS
$cshow :: StencilOpState -> String
show :: StencilOpState -> String
$cshowList :: [StencilOpState] -> ShowS
showList :: [StencilOpState] -> ShowS
Show

instance Default StencilOpState where def :: StencilOpState
def = StencilOpState
stencilOpStateZero

stencilOpStateZero :: StencilOpState
stencilOpStateZero :: StencilOpState
stencilOpStateZero = StencilOpState {
	stencilOpStateFailOp :: StencilOp
stencilOpStateFailOp = StencilOp
StencilOpKeep,
	stencilOpStatePassOp :: StencilOp
stencilOpStatePassOp = StencilOp
StencilOpKeep,
	stencilOpStateDepthFailOp :: StencilOp
stencilOpStateDepthFailOp = StencilOp
StencilOpKeep,
	stencilOpStateCompareOp :: CompareOp
stencilOpStateCompareOp = CompareOp
CompareOpNever,
	stencilOpStateCompareMask :: Word32
stencilOpStateCompareMask = Word32
0,
	stencilOpStateWriteMask :: Word32
stencilOpStateWriteMask = Word32
0,
	stencilOpStateReference :: Word32
stencilOpStateReference = Word32
0 }

stencilOpStateToCore :: StencilOpState -> C.StencilOpState
stencilOpStateToCore :: StencilOpState -> StencilOpState
stencilOpStateToCore StencilOpState {
	stencilOpStateFailOp :: StencilOpState -> StencilOp
stencilOpStateFailOp = StencilOp Word32
fo,
	stencilOpStatePassOp :: StencilOpState -> StencilOp
stencilOpStatePassOp = StencilOp Word32
po,
	stencilOpStateDepthFailOp :: StencilOpState -> StencilOp
stencilOpStateDepthFailOp = StencilOp Word32
dfo,
	stencilOpStateCompareOp :: StencilOpState -> CompareOp
stencilOpStateCompareOp = CompareOp Word32
co,
	stencilOpStateCompareMask :: StencilOpState -> Word32
stencilOpStateCompareMask = Word32
cm,
	stencilOpStateWriteMask :: StencilOpState -> Word32
stencilOpStateWriteMask = Word32
wm,
	stencilOpStateReference :: StencilOpState -> Word32
stencilOpStateReference = Word32
rf } = C.StencilOpState {
		stencilOpStateFailOp :: Word32
C.stencilOpStateFailOp = Word32
fo,
		stencilOpStatePassOp :: Word32
C.stencilOpStatePassOp = Word32
po,
		stencilOpStateDepthFailOp :: Word32
C.stencilOpStateDepthFailOp = Word32
dfo,
		stencilOpStateCompareOp :: Word32
C.stencilOpStateCompareOp = Word32
co,
		stencilOpStateCompareMask :: Word32
C.stencilOpStateCompareMask = Word32
cm,
		stencilOpStateWriteMask :: Word32
C.stencilOpStateWriteMask = Word32
wm,
		stencilOpStateReference :: Word32
C.stencilOpStateReference = Word32
rf }

data ClearValue (ct :: ClearType) where
	ClearValueColor :: Rgba Float -> ClearValue ('ClearTypeColor cct)
	ClearValueDepthStencil ::
		C.ClearDepthStencilValue -> ClearValue 'ClearTypeDepthStencil

class ClearColorValueToCore (cct :: ClearColorType) where
	clearColorValueToCore ::
		ClearValue ('ClearTypeColor cct) ->
		(Ptr C.ClearColorValue -> IO a) -> IO a

instance ClearColorValueToCore 'ClearColorTypeFloat32 where
	clearColorValueToCore :: forall a.
ClearValue ('ClearTypeColor 'ClearColorTypeFloat32)
-> (Ptr ClearColorValue -> IO a) -> IO a
clearColorValueToCore (ClearValueColor (RgbaDouble Float
r Float
g Float
b Float
a)) Ptr ClearColorValue -> IO a
f =
		Int -> (Ptr Float -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 \Ptr Float
prgba -> do
			Ptr Float -> [Float] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Float
prgba [Float
r, Float
g, Float
b, Float
a]
			Ptr ClearColorValue -> IO a
f (Ptr ClearColorValue -> IO a) -> Ptr ClearColorValue -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Ptr ClearColorValue
C.clearColorValueFromFloats Ptr Float
prgba

instance ClearColorValueToCore 'ClearColorTypeInt32 where
	clearColorValueToCore :: forall a.
ClearValue ('ClearTypeColor 'ClearColorTypeInt32)
-> (Ptr ClearColorValue -> IO a) -> IO a
clearColorValueToCore (ClearValueColor (RgbaInt32 Int32
r Int32
g Int32
b Int32
a)) Ptr ClearColorValue -> IO a
f =
		Int -> (Ptr Int32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 \Ptr Int32
prgba -> do
			Ptr Int32 -> [Int32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Int32
prgba [Int32
r, Int32
g, Int32
b, Int32
a]
			Ptr ClearColorValue -> IO a
f (Ptr ClearColorValue -> IO a) -> Ptr ClearColorValue -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr Int32 -> Ptr ClearColorValue
C.clearColorValueFromInts Ptr Int32
prgba

instance ClearColorValueToCore 'ClearColorTypeUint32 where
	clearColorValueToCore :: forall a.
ClearValue ('ClearTypeColor 'ClearColorTypeUint32)
-> (Ptr ClearColorValue -> IO a) -> IO a
clearColorValueToCore (ClearValueColor (RgbaWord32 Word32
r Word32
g Word32
b Word32
a)) Ptr ClearColorValue -> IO a
f =
		Int -> (Ptr Word32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 \Ptr Word32
prgba -> do
			Ptr Word32 -> [Word32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word32
prgba [Word32
r, Word32
g, Word32
b, Word32
a]
			Ptr ClearColorValue -> IO a
f (Ptr ClearColorValue -> IO a) -> Ptr ClearColorValue -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Ptr ClearColorValue
C.clearColorValueFromUints Ptr Word32
prgba

deriving instance Show (ClearValue ct)

data ClearType = ClearTypeColor ClearColorType | ClearTypeDepthStencil
	deriving Int -> ClearType -> ShowS
[ClearType] -> ShowS
ClearType -> String
(Int -> ClearType -> ShowS)
-> (ClearType -> String)
-> ([ClearType] -> ShowS)
-> Show ClearType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClearType -> ShowS
showsPrec :: Int -> ClearType -> ShowS
$cshow :: ClearType -> String
show :: ClearType -> String
$cshowList :: [ClearType] -> ShowS
showList :: [ClearType] -> ShowS
Show

data ClearColorType
	= ClearColorTypeFloat32 | ClearColorTypeInt32 | ClearColorTypeUint32
	deriving Int -> ClearColorType -> ShowS
[ClearColorType] -> ShowS
ClearColorType -> String
(Int -> ClearColorType -> ShowS)
-> (ClearColorType -> String)
-> ([ClearColorType] -> ShowS)
-> Show ClearColorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClearColorType -> ShowS
showsPrec :: Int -> ClearColorType -> ShowS
$cshow :: ClearColorType -> String
show :: ClearColorType -> String
$cshowList :: [ClearColorType] -> ShowS
showList :: [ClearColorType] -> ShowS
Show

class ClearValueToCore (ct :: ClearType) where
	clearValueToCore :: ClearValue ct -> (Ptr C.ClearValue -> IO a) -> IO a

instance ClearValueToCore 'ClearTypeDepthStencil where
	clearValueToCore :: forall a.
ClearValue 'ClearTypeDepthStencil
-> (Ptr ClearValue -> IO a) -> IO a
clearValueToCore (ClearValueDepthStencil ClearDepthStencilValue
cdsv) =
		ClearDepthStencilValue -> (Ptr ClearValue -> IO a) -> IO a
forall a.
ClearDepthStencilValue -> (Ptr ClearValue -> IO a) -> IO a
C.clearValueFromClearDepthStencilValue ClearDepthStencilValue
cdsv

instance ClearColorValueToCore cct =>
	ClearValueToCore ('ClearTypeColor cct) where
	clearValueToCore :: forall a.
ClearValue ('ClearTypeColor cct)
-> (Ptr ClearValue -> IO a) -> IO a
clearValueToCore cv :: ClearValue ('ClearTypeColor cct)
cv@(ClearValueColor Rgba Float
_) Ptr ClearValue -> IO a
f =
		ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO a) -> IO a
forall a.
ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO a) -> IO a
forall (cct :: ClearColorType) a.
ClearColorValueToCore cct =>
ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO a) -> IO a
clearColorValueToCore ClearValue ('ClearTypeColor cct)
cv ((Ptr ClearColorValue -> IO a) -> IO a)
-> (Ptr ClearColorValue -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr ClearValue -> IO a
f (Ptr ClearValue -> IO a)
-> (Ptr ClearColorValue -> Ptr ClearValue)
-> Ptr ClearColorValue
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ClearColorValue -> Ptr ClearValue
C.clearValueFromClearColorValue

class TL.Length cts => ClearValueListToCore (cts :: [ClearType]) where
	clearValueListToCore ::
		HeteroParList.PL ClearValue cts ->
		([Ptr C.ClearValue] -> IO a) -> IO a

instance ClearValueListToCore '[] where clearValueListToCore :: forall a. PL ClearValue '[] -> ([Ptr ClearValue] -> IO a) -> IO a
clearValueListToCore PL ClearValue '[]
HeteroParList.Nil = (([Ptr ClearValue] -> IO a) -> [Ptr ClearValue] -> IO a
forall a b. (a -> b) -> a -> b
$ [])

instance (ClearValueToCore ct, ClearValueListToCore cts) =>
	ClearValueListToCore (ct ': cts) where
	clearValueListToCore :: forall a.
PL ClearValue (ct : cts) -> ([Ptr ClearValue] -> IO a) -> IO a
clearValueListToCore (ClearValue s
cv :** PL ClearValue ss1
cvs) [Ptr ClearValue] -> IO a
f =
		ClearValue s -> (Ptr ClearValue -> IO a) -> IO a
forall a. ClearValue s -> (Ptr ClearValue -> IO a) -> IO a
forall (ct :: ClearType) a.
ClearValueToCore ct =>
ClearValue ct -> (Ptr ClearValue -> IO a) -> IO a
clearValueToCore ClearValue s
cv \Ptr ClearValue
ccv ->
		PL ClearValue ss1 -> ([Ptr ClearValue] -> IO a) -> IO a
forall (cts :: [ClearType]) a.
ClearValueListToCore cts =>
PL ClearValue cts -> ([Ptr ClearValue] -> IO a) -> IO a
forall a. PL ClearValue ss1 -> ([Ptr ClearValue] -> IO a) -> IO a
clearValueListToCore PL ClearValue ss1
cvs \[Ptr ClearValue]
ccvs -> [Ptr ClearValue] -> IO a
f ([Ptr ClearValue] -> IO a) -> [Ptr ClearValue] -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr ClearValue
ccv Ptr ClearValue -> [Ptr ClearValue] -> [Ptr ClearValue]
forall a. a -> [a] -> [a]
: [Ptr ClearValue]
ccvs

clearValueListToArray :: [Ptr C.ClearValue] -> (Ptr C.ClearValue -> IO a) -> IO a
clearValueListToArray :: forall a. [Ptr ClearValue] -> (Ptr ClearValue -> IO a) -> IO a
clearValueListToArray ([Ptr ClearValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Ptr ClearValue] -> Int)
-> ([Ptr ClearValue] -> [Ptr ClearValue])
-> [Ptr ClearValue]
-> (Int, [Ptr ClearValue])
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')
&&& [Ptr ClearValue] -> [Ptr ClearValue]
forall a. a -> a
id -> (Int
pcvc, [Ptr ClearValue]
pcvl)) Ptr ClearValue -> IO a
f =
	Int -> (Ptr ClearValue -> IO a) -> IO a
forall a. Int -> (Ptr ClearValue -> IO a) -> IO a
allocaClearValueArray Int
pcvc \Ptr ClearValue
pcva -> do
		Ptr ClearValue -> [Ptr ClearValue] -> IO ()
pokeClearValueArray Ptr ClearValue
pcva [Ptr ClearValue]
pcvl
		Ptr ClearValue -> IO a
f Ptr ClearValue
pcva

allocaClearValueArray :: Int -> (Ptr C.ClearValue -> IO a) -> IO a
allocaClearValueArray :: forall a. Int -> (Ptr ClearValue -> IO a) -> IO a
allocaClearValueArray Int
n = Int -> Int -> (Ptr ClearValue -> IO a) -> IO a
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned
	(Int -> Int -> Int
alignedSize (Int
16) Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
{-# LINE 265 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}
	Int
4
{-# LINE 266 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}

alignedSize :: Int -> Int -> Int
alignedSize :: Int -> Int -> Int
alignedSize Int
sz Int
al = (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

pokeClearValueArray :: Ptr C.ClearValue -> [Ptr C.ClearValue] -> IO ()
pokeClearValueArray :: Ptr ClearValue -> [Ptr ClearValue] -> IO ()
pokeClearValueArray Ptr ClearValue
p [Ptr ClearValue]
lst = (Ptr ClearValue -> Ptr ClearValue -> IO ())
-> [Ptr ClearValue] -> [Ptr ClearValue] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Ptr ClearValue -> Ptr ClearValue -> IO ()
pokeClearValue (Ptr ClearValue -> [Ptr ClearValue]
clearValueArrayPtrs Ptr ClearValue
p) [Ptr ClearValue]
lst

clearValueArrayPtrs :: Ptr C.ClearValue -> [Ptr C.ClearValue]
clearValueArrayPtrs :: Ptr ClearValue -> [Ptr ClearValue]
clearValueArrayPtrs = (Ptr ClearValue -> Ptr ClearValue)
-> Ptr ClearValue -> [Ptr ClearValue]
forall a. (a -> a) -> a -> [a]
iterate (
	(Ptr ClearValue -> Int -> Ptr ClearValue
forall a. Ptr a -> Int -> Ptr a
`alignPtr` Int
4)
{-# LINE 276 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}
		(Ptr ClearValue -> Ptr ClearValue)
-> (Ptr ClearValue -> Ptr ClearValue)
-> Ptr ClearValue
-> Ptr ClearValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr ClearValue -> Int -> Ptr ClearValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16)) )
{-# LINE 277 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}

pokeClearValue :: Ptr C.ClearValue -> Ptr C.ClearValue -> IO ()
pokeClearValue :: Ptr ClearValue -> Ptr ClearValue -> IO ()
pokeClearValue Ptr ClearValue
dst Ptr ClearValue
src = Ptr ClearValue -> Ptr ClearValue -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr ClearValue
dst Ptr ClearValue
src (Int
16)
{-# LINE 280 "src/Gpu/Vulkan/Middle/Internal.hsc" #-}

data SubmitInfo mn = SubmitInfo {
	forall (mn :: Maybe (*)). SubmitInfo mn -> M mn
submitInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). SubmitInfo mn -> [(S, StageFlags)]
submitInfoWaitSemaphoreDstStageMasks ::
		[(Semaphore.S, Pipeline.StageFlags)],
	forall (mn :: Maybe (*)). SubmitInfo mn -> [C]
submitInfoCommandBuffers :: [CommandBuffer.C],
	forall (mn :: Maybe (*)). SubmitInfo mn -> [S]
submitInfoSignalSemaphores :: [Semaphore.S] }

class SubmitInfoListToCore ns where
	submitInfoListToCore :: HeteroParList.PL SubmitInfo ns ->
		([C.SubmitInfo] -> IO a) -> IO ()

instance SubmitInfoListToCore '[] where
	submitInfoListToCore :: forall a. PL SubmitInfo '[] -> ([SubmitInfo] -> IO a) -> IO ()
submitInfoListToCore PL SubmitInfo '[]
HeteroParList.Nil [SubmitInfo] -> IO a
f = () () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [SubmitInfo] -> IO a
f []

instance (WithPoked (TMaybe.M n), SubmitInfoListToCore ns) =>
	SubmitInfoListToCore (n ': ns) where
	submitInfoListToCore :: forall a. PL SubmitInfo (n : ns) -> ([SubmitInfo] -> IO a) -> IO ()
submitInfoListToCore (SubmitInfo s
ci :** PL SubmitInfo ss1
cis) [SubmitInfo] -> IO a
f = forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
SubmitInfo mn -> (SubmitInfo -> IO a) -> IO ()
submitInfoToCore @n SubmitInfo n
SubmitInfo s
ci \SubmitInfo
cci ->
		PL SubmitInfo ss1 -> ([SubmitInfo] -> IO a) -> IO ()
forall (ns :: [Maybe (*)]) a.
SubmitInfoListToCore ns =>
PL SubmitInfo ns -> ([SubmitInfo] -> IO a) -> IO ()
forall a. PL SubmitInfo ss1 -> ([SubmitInfo] -> IO a) -> IO ()
submitInfoListToCore PL SubmitInfo ss1
cis \[SubmitInfo]
ccis -> [SubmitInfo] -> IO a
f ([SubmitInfo] -> IO a) -> [SubmitInfo] -> IO a
forall a b. (a -> b) -> a -> b
$ SubmitInfo
cci SubmitInfo -> [SubmitInfo] -> [SubmitInfo]
forall a. a -> [a] -> [a]
: [SubmitInfo]
ccis

submitInfoToCore :: WithPoked (TMaybe.M mn) =>
	SubmitInfo mn -> (C.SubmitInfo -> IO a) -> IO ()
submitInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
SubmitInfo mn -> (SubmitInfo -> IO a) -> IO ()
submitInfoToCore SubmitInfo {
	submitInfoNext :: forall (mn :: Maybe (*)). SubmitInfo mn -> M mn
submitInfoNext = M mn
mnxt,
	submitInfoWaitSemaphoreDstStageMasks :: forall (mn :: Maybe (*)). SubmitInfo mn -> [(S, StageFlags)]
submitInfoWaitSemaphoreDstStageMasks =
		[(S, StageFlags)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(S, StageFlags)] -> Int)
-> ([(S, StageFlags)] -> ([S], [Word32]))
-> [(S, StageFlags)]
-> (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 -> S
Semaphore.unS (S -> S) -> [S] -> [S]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([S] -> [S])
-> ([StageFlags] -> [Word32])
-> ([S], [StageFlags])
-> ([S], [Word32])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
			(StageFlags -> Word32
Pipeline.unStageFlagBits (StageFlags -> Word32) -> [StageFlags] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (([S], [StageFlags]) -> ([S], [Word32]))
-> ([(S, StageFlags)] -> ([S], [StageFlags]))
-> [(S, StageFlags)]
-> ([S], [Word32])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(S, StageFlags)] -> ([S], [StageFlags])
forall a b. [(a, b)] -> ([a], [b])
unzip ->
		(Int
wsc, ([S]
wss, [Word32]
wdsms)),
	submitInfoCommandBuffers :: forall (mn :: Maybe (*)). SubmitInfo mn -> [C]
submitInfoCommandBuffers = ([C] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([C] -> Int) -> ([C] -> [C]) -> [C] -> (Int, [C])
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')
&&& [C] -> [C]
forall a. a -> a
id) ([C] -> (Int, [C])) -> ([C] -> [C]) -> [C] -> (Int, [C])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (C -> C) -> [C] -> [C]
forall a b. (a -> b) -> [a] -> [b]
map C -> C
CommandBuffer.unC -> (Int
cbc, [C]
cbs),
	submitInfoSignalSemaphores :: forall (mn :: Maybe (*)). SubmitInfo mn -> [S]
submitInfoSignalSemaphores =
		[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
Semaphore.unS (S -> S) -> [S] -> [S]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
ssc, [S]
sss) } SubmitInfo -> 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 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 Word32 -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
wsc \Ptr Word32
pwdsms ->
	Ptr Word32 -> [Word32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word32
pwdsms [Word32]
wdsms 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 C -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
cbc \Ptr C
pcbs ->
	Ptr C -> [C] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr C
pcbs [C]
cbs 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
ssc \Ptr S
psss ->
	Ptr S -> [S] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr S
psss [S]
sss 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
>>
	SubmitInfo -> IO a
f C.SubmitInfo {
		submitInfoSType :: ()
C.submitInfoSType = (),
		submitInfoPNext :: Ptr ()
C.submitInfoPNext = Ptr ()
pnxt',
		submitInfoWaitSemaphoreCount :: Word32
C.submitInfoWaitSemaphoreCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wsc,
		submitInfoPWaitSemaphores :: Ptr S
C.submitInfoPWaitSemaphores = Ptr S
pwss,
		submitInfoPWaitDstStageMask :: Ptr Word32
C.submitInfoPWaitDstStageMask = Ptr Word32
pwdsms,
		submitInfoCommandBufferCount :: Word32
C.submitInfoCommandBufferCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cbc,
		submitInfoPCommandBuffers :: Ptr C
C.submitInfoPCommandBuffers = Ptr C
pcbs,
		submitInfoSignalSemaphoreCount :: Int32
C.submitInfoSignalSemaphoreCount = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ssc,
		submitInfoPSignalSemaphores :: Ptr S
C.submitInfoPSignalSemaphores = Ptr S
psss }

data FormatProperties = FormatProperties {
	FormatProperties -> FormatFeatureFlags
formatPropertiesLinearTilingFeatures :: FormatFeatureFlags,
	FormatProperties -> FormatFeatureFlags
formatPropertiesOptimalTilingFeatures :: FormatFeatureFlags,
	FormatProperties -> FormatFeatureFlags
formatPropertiesBufferFeatures :: FormatFeatureFlags }
	deriving Int -> FormatProperties -> ShowS
[FormatProperties] -> ShowS
FormatProperties -> String
(Int -> FormatProperties -> ShowS)
-> (FormatProperties -> String)
-> ([FormatProperties] -> ShowS)
-> Show FormatProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatProperties -> ShowS
showsPrec :: Int -> FormatProperties -> ShowS
$cshow :: FormatProperties -> String
show :: FormatProperties -> String
$cshowList :: [FormatProperties] -> ShowS
showList :: [FormatProperties] -> ShowS
Show

formatPropertiesFromCore :: C.FormatProperties -> FormatProperties
formatPropertiesFromCore :: FormatProperties -> FormatProperties
formatPropertiesFromCore C.FormatProperties {
	formatPropertiesLinearTilingFeatures :: FormatProperties -> Word32
C.formatPropertiesLinearTilingFeatures = Word32
ltfs,
	formatPropertiesOptimalTilingFeatures :: FormatProperties -> Word32
C.formatPropertiesOptimalTilingFeatures = Word32
otfs,
	formatPropertiesBufferFeatures :: FormatProperties -> Word32
C.formatPropertiesBufferFeatures = Word32
bfs
	} = FormatProperties {
		formatPropertiesLinearTilingFeatures :: FormatFeatureFlags
formatPropertiesLinearTilingFeatures =
			Word32 -> FormatFeatureFlags
FormatFeatureFlagBits Word32
ltfs,
		formatPropertiesOptimalTilingFeatures :: FormatFeatureFlags
formatPropertiesOptimalTilingFeatures =
			Word32 -> FormatFeatureFlags
FormatFeatureFlagBits Word32
otfs,
		formatPropertiesBufferFeatures :: FormatFeatureFlags
formatPropertiesBufferFeatures = Word32 -> FormatFeatureFlags
FormatFeatureFlagBits Word32
bfs }