{-# LINE 1 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Cmd.Core (

	-- * BEGIN AND END RENDER PASS

	beginRenderPass, endRenderPass,

	-- * DRAW AND DISPATCH

	draw, drawIndexed, dispatch,

	-- * BIND

	bindPipeline, bindVertexBuffers, bindIndexBuffer,
	bindDescriptorSets,
	pushConstants,

	-- * COPY BUFFER AND IMAGE

	copyBuffer, copyBufferToImage, copyImageToBuffer, blitImage, blitImage2,

	-- * CLEAR COLOR IMAGE

	clearColorImage,

	-- * PIPELINE BARRIER

	pipelineBarrier, pipelineBarrier2,

	-- * QUERY

	beginQuery, endQuery, resetQueryPool, writeTimestamp,

	) where

import Foreign.Ptr
import Data.Word
import Data.Int

import Gpu.Vulkan.Core
import qualified Gpu.Vulkan.RenderPass.Core as RenderPass
import qualified Gpu.Vulkan.Pipeline.Core as Pipeline
import qualified Gpu.Vulkan.CommandBuffer.Core as CommandBuffer
import qualified Gpu.Vulkan.Buffer.Core as Buffer
import qualified Gpu.Vulkan.PipelineLayout.Core as Pipeline.Layout
import qualified Gpu.Vulkan.DescriptorSet.Core as DscSet
import qualified Gpu.Vulkan.Memory.Core as Memory
import qualified Gpu.Vulkan.Image.Core as Image

import Gpu.Vulkan.QueryPool.Core as QueryPool



foreign import ccall "vkCmdBeginRenderPass" beginRenderPass ::
	CommandBuffer.C -> Ptr RenderPass.BeginInfo ->
	Word32 -> IO ()
{-# LINE 58 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdBindPipeline" bindPipeline ::
	CommandBuffer.C -> Word32 -> Pipeline.P -> IO ()
{-# LINE 61 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdDraw" draw ::
	CommandBuffer.C -> Word32 -> Word32 ->
{-# LINE 64 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Word32 -> IO ()
{-# LINE 65 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdDrawIndexed" drawIndexed ::
	CommandBuffer.C -> Word32 -> Word32 ->
{-# LINE 68 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Int32 -> Word32 -> IO ()
{-# LINE 69 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdEndRenderPass" endRenderPass ::
	CommandBuffer.C -> IO ()

foreign import ccall "vkCmdBindVertexBuffers" bindVertexBuffers ::
	CommandBuffer.C -> Word32 -> Word32 ->
{-# LINE 75 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Ptr Buffer.B -> Ptr Word64 -> IO ()
{-# LINE 76 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdCopyBuffer" copyBuffer ::
	CommandBuffer.C -> Buffer.B -> Buffer.B -> Word32 ->
{-# LINE 79 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Ptr Buffer.Copy -> IO ()

foreign import ccall "vkCmdBindIndexBuffer" bindIndexBuffer ::
	CommandBuffer.C -> Buffer.B -> Word64 ->
{-# LINE 83 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> IO ()
{-# LINE 84 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdBindDescriptorSets" bindDescriptorSets ::
	CommandBuffer.C -> Word32 -> Pipeline.Layout.P ->
{-# LINE 87 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Word32 -> Ptr DscSet.D ->
{-# LINE 88 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Word32 -> IO ()
{-# LINE 89 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdPipelineBarrier" pipelineBarrier ::
	CommandBuffer.C ->
	Word32 -> Word32 ->
{-# LINE 93 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 ->
{-# LINE 94 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Memory.Barrier ->
{-# LINE 95 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Buffer.MemoryBarrier ->
{-# LINE 96 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Image.MemoryBarrier -> IO ()
{-# LINE 97 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdCopyBufferToImage" copyBufferToImage ::
	CommandBuffer.C -> Buffer.B -> Image.I -> Word32 ->
{-# LINE 100 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Buffer.ImageCopy -> IO ()
{-# LINE 101 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdCopyImageToBuffer" copyImageToBuffer ::
	CommandBuffer.C -> Image.I -> Word32 -> Buffer.B ->
{-# LINE 104 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Buffer.ImageCopy -> IO ()
{-# LINE 105 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdBlitImage" blitImage ::
	CommandBuffer.C ->
	Image.I -> Word32 -> Image.I -> Word32 ->
{-# LINE 109 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Ptr Image.Blit -> Word32 -> IO ()
{-# LINE 110 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdBlitImage2" blitImage2 ::
	CommandBuffer.C -> Ptr BlitImageInfo2 -> IO()

foreign import ccall "vkCmdDispatch" dispatch ::
	CommandBuffer.C ->
	Word32 -> Word32 -> Word32 -> IO ()
{-# LINE 117 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdPushConstants" pushConstants ::
	CommandBuffer.C -> Pipeline.Layout.P -> Word32 ->
{-# LINE 120 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> Word32 -> Ptr () -> IO ()
{-# LINE 121 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdResetQueryPool" resetQueryPool ::
	CommandBuffer.C -> QueryPool.Q ->
	Word32 -> Word32 -> IO ()
{-# LINE 125 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdBeginQuery" beginQuery ::
	CommandBuffer.C -> QueryPool.Q -> Word32 ->
{-# LINE 128 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> IO ()
{-# LINE 129 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdEndQuery" endQuery ::
	CommandBuffer.C -> QueryPool.Q -> Word32 -> IO ()
{-# LINE 132 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdWriteTimestamp" writeTimestamp ::
	CommandBuffer.C -> Word32 -> QueryPool.Q ->
{-# LINE 135 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Word32 -> IO ()
{-# LINE 136 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}

foreign import ccall "vkCmdPipelineBarrier2" pipelineBarrier2 ::
	CommandBuffer.C -> Ptr DependencyInfo -> IO ()

foreign import ccall "vkCmdClearColorImage" clearColorImage ::
	CommandBuffer.C -> Image.I -> Word32 ->
{-# LINE 142 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	Ptr ClearColorValue -> Word32 -> Ptr Image.SubresourceRange ->
{-# LINE 143 "src/Gpu/Vulkan/Cmd/Core.hsc" #-}
	IO ()