{-# LINE 1 "src/Gpu/Vulkan/Attachment/Middle/Internal.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Attachment.Middle.Internal where

import Foreign.Storable
import Foreign.C.Enum
import Data.Word

import Gpu.Vulkan.Enum
import Gpu.Vulkan.Attachment.Enum

import qualified Gpu.Vulkan.Sample.Enum as Sample
import qualified Gpu.Vulkan.Image.Enum as Image
import qualified Gpu.Vulkan.Attachment.Core as C



data Description = Description {
	Description -> DescriptionFlags
descriptionFlags :: DescriptionFlags,
	Description -> Format
descriptionFormat :: Format,
	Description -> CountFlagBits
descriptionSamples :: Sample.CountFlagBits,
	Description -> LoadOp
descriptionLoadOp :: LoadOp,
	Description -> StoreOp
descriptionStoreOp :: StoreOp,
	Description -> LoadOp
descriptionStencilLoadOp :: LoadOp,
	Description -> StoreOp
descriptionStencilStoreOp :: StoreOp,
	Description -> Layout
descriptionInitialLayout :: Image.Layout,
	Description -> Layout
descriptionFinalLayout :: Image.Layout }
	deriving Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
(Int -> Description -> ShowS)
-> (Description -> String)
-> ([Description] -> ShowS)
-> Show Description
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Description -> ShowS
showsPrec :: Int -> Description -> ShowS
$cshow :: Description -> String
show :: Description -> String
$cshowList :: [Description] -> ShowS
showList :: [Description] -> ShowS
Show

descriptionToCore :: Description -> C.Description
descriptionToCore :: Description -> Description
descriptionToCore Description {
	descriptionFlags :: Description -> DescriptionFlags
descriptionFlags = DescriptionFlagBits Word32
flgs,
	descriptionFormat :: Description -> Format
descriptionFormat = Format Word32
fmt,
	descriptionSamples :: Description -> CountFlagBits
descriptionSamples = Sample.CountFlagBits Word32
smps,
	descriptionLoadOp :: Description -> LoadOp
descriptionLoadOp = LoadOp Word32
lo,
	descriptionStoreOp :: Description -> StoreOp
descriptionStoreOp = StoreOp Word32
so,
	descriptionStencilLoadOp :: Description -> LoadOp
descriptionStencilLoadOp = LoadOp Word32
slo,
	descriptionStencilStoreOp :: Description -> StoreOp
descriptionStencilStoreOp = StoreOp Word32
sso,
	descriptionInitialLayout :: Description -> Layout
descriptionInitialLayout = Image.Layout Word32
il,
	descriptionFinalLayout :: Description -> Layout
descriptionFinalLayout = Image.Layout Word32
fl
	} = C.Description {
		descriptionFlags :: Word32
C.descriptionFlags = Word32
flgs,
		descriptionFormat :: Word32
C.descriptionFormat = Word32
fmt,
		descriptionSamples :: Word32
C.descriptionSamples = Word32
smps,
		descriptionLoadOp :: Word32
C.descriptionLoadOp = Word32
lo,
		descriptionStoreOp :: Word32
C.descriptionStoreOp = Word32
so,
		descriptionStencilLoadOp :: Word32
C.descriptionStencilLoadOp = Word32
slo,
		descriptionStencilStoreOp :: Word32
C.descriptionStencilStoreOp = Word32
sso,
		descriptionInitialLayout :: Word32
C.descriptionInitialLayout = Word32
il,
		descriptionFinalLayout :: Word32
C.descriptionFinalLayout = Word32
fl }

enum "A" ''Word32 [''Show, ''Storable, ''Num]
{-# LINE 60 "src/Gpu/Vulkan/Attachment/Middle/Internal.hsc" #-}
	[("AUnused", 4294967295)]
{-# LINE 61 "src/Gpu/Vulkan/Attachment/Middle/Internal.hsc" #-}

data Reference = Reference {
	Reference -> A
referenceAttachment :: A,
	Reference -> Layout
referenceLayout :: Image.Layout }
	deriving Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> String
show :: Reference -> String
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
Show

referenceToCore :: Reference -> C.Reference
referenceToCore :: Reference -> Reference
referenceToCore Reference {
	referenceAttachment :: Reference -> A
referenceAttachment = A Word32
a,
	referenceLayout :: Reference -> Layout
referenceLayout = Image.Layout Word32
lyt } = C.Reference {
		referenceAttachment :: Word32
C.referenceAttachment = Word32
a,
		referenceLayout :: Word32
C.referenceLayout = Word32
lyt }