{-# LINE 1 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.ImageView.Core (

	-- * CREATE AND DESTROY

	create, destroy, I, PtrI, CreateInfo, pattern CreateInfo,
	createInfoSType, createInfoPNext, createInfoFlags,
	createInfoImage, createInfoViewType, createInfoFormat,
	createInfoComponents, createInfoSubresourceRange,

	) where

import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Struct
import Foreign.C.Struct.TypeSynonyms
import Data.Word
import Data.Int

import qualified Gpu.Vulkan.AllocationCallbacks.Core as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Core as Device
import qualified Gpu.Vulkan.Image.Core as Image
import qualified Gpu.Vulkan.Component.Core as Component



data ITag
type I = Ptr ITag
type PtrI = Ptr I

strType :: Word32
{-# LINE 36 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
strType = 15
{-# LINE 37 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}

struct "CreateInfo" (80)
{-# LINE 39 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		8 [
{-# LINE 40 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("sType", ''(), [| const $ pure () |],
		[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p strType |]),
{-# LINE 42 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("pNext", ''PtrVoid,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 44 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 45 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("flags", ''Word32,
{-# LINE 46 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 47 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 48 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("image", ''Image.I,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 50 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 51 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("viewType", ''Word32,
{-# LINE 52 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 53 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 54 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("format", ''Word32,
{-# LINE 55 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> peekByteOff hsc_ptr 36) |],
{-# LINE 56 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 36) |]),
{-# LINE 57 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("components", ''Component.Mapping,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 59 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 60 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	("subresourceRange", ''Image.SubresourceRange,
		[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 62 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
		[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 63 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}
	[''Show, ''Storable]

foreign import ccall "vkCreateImageView" create ::
	Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A -> Ptr I ->
	IO Int32
{-# LINE 68 "src/Gpu/Vulkan/ImageView/Core.hsc" #-}

foreign import ccall "vkDestroyImageView" destroy ::
	Device.D -> I -> Ptr AllocationCallbacks.A -> IO ()