unit uMainForm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, Vulkan, VulkanUtils, ugluVector, ugluMatrix, uglcCamera; type ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TCustomAllocHandler = class(TvkuAllocationHandler) protected function AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override; function ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override; procedure FreeMemory(const aMemory: PVkVoid); override; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// type TUniforms = packed record ProjectionMat: TgluMatrix4f; ModelMatrix: TgluMatrix4f; ViewMatrix: TgluMatrix4f; end; TMainForm = class(TForm) ApplicationProperties: TApplicationProperties; RenderPanel: TPanel; procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private fGraphicsQueueFamilyIndex: VkUint32; fGraphicsQueueNodeIndex: VkUint32; fPresentQueueNodeIndex: VkUint32; fColorFormat: TVkFormat; fSurfaceColorSpace: TVkColorSpaceKHR; fDepthFormat: TVkFormat; fCamera: TglcCamera; fAllocHandler: TCustomAllocHandler; fDebugReporter: TvkuConsoleDebugReporter; fInstance: TvkuInstance; fPhyDevice: TvkuPhysicalDevice; fDevice: TvkuDevice; fQueue: TvkuQueue; fSurface: TvkuSurface; fSwapChain: TvkuSwapChain; fImages: array of TvkuImage; fImageViews: array of TvkuImageView; fRenderPass: TvkuRenderPass; fFrameBuffers: array of TvkuFrameBuffer; fDescSetLayout: TvkuDescriptorSetLayout; fPipelineLayout: TvkuPipelineLayout; fVertexShader: TvkuShaderModule; fFragmentShader: TvkuShaderModule; fPipeline: TvkuGraphicsPipeline; fCommandPool: TvkuCommandPool; fDrawCommandBuffers: array of TvkuCommandBuffer; fPostPresentCommandBuffer: TvkuCommandBuffer; fDepthStencilImage: TvkuImage; fDepthStencilImageView: TvkuImageView; fPipelineCache: TvkuPipelineCache; fDescriptorPool: TvkuDescriptorPool; fDescriptorSet: TvkuDescriptorSet; fVertex: packed record DataMemory: TvkuDeviceMemory; DataBuffer: TvkuBuffer; IndexMemory: TvkuDeviceMemory; IndexBuffer: TvkuBuffer; end; fUniform: packed record Values: TUniforms; Memory: TvkuDeviceMemory; Buffer: TvkuBuffer; end; procedure UpdateUniformBuffers; procedure Render; end; var MainForm: TMainForm; implementation {$R *.lfm} {$I Vulkan.inc} uses uvkuUtils; const VERTEX_BUFFER_BIND_ID = 0; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TCustomAllocHandler//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TCustomAllocHandler.AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; begin result := inherited AllocateMemory(aSize, aAlignment, aScope); WriteLn(Format(' MEM - %d bytes of memory allocated at %p', [ aSize, result ])); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TCustomAllocHandler.ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; var p: PVkVoid; begin p := aOriginal; result := inherited ReallocateMemory(aOriginal, aSize, aAlignment, aScope); WriteLn(Format(' MEM - %d bytes of memory (from %p) reallocated at %p', [ aSize, p, result ])); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TCustomAllocHandler.FreeMemory(const aMemory: PVkVoid); begin WriteLn(Format(' MEM - free memory at %p', [ aMemory ])); inherited FreeMemory(aMemory); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TMainForm////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TMainForm.FormCreate(Sender: TObject); type TVertex = packed record position: array[0..2] of VkFloat; color: array[0..2] of VkFloat; end; TVertexData = array[0..2] of TVertex; TIndexData = array[0..2] of VkUint32; const ClearColor: TVkClearValue = ( color: ( float32: ( 0.0, 0.0, 0.0, 1.0 ) ) ); ClearDepthStencil: TVkClearValue = ( depthStencil: ( depth: 1.0; stencil: 0 ) ); VertexData: TVertexData = ( ( position: ( 1.0, 1.0, 0.0 ); color: ( 1.0, 0.0, 0.0 ) ), ( position: (-1.0, 1.0, 0.0 ); color: ( 0.0, 1.0, 0.0 ) ), ( position: ( 0.0,-1.0, 0.0 ); color: ( 0.0, 0.0, 1.0 ) ) ); IndexData: TIndexData = ( 0, 1, 2 ); var PhyDevices: TVkPhysicalDeviceArr; InstanceFactory: TvkuInstanceFactory; DeviceFactory: TvkuDeviceFactory; SurfaceFactory: TvkuSurfaceFactory; CommandPoolFactory: TvkuCommandPoolFactory; SwapChainFactory: TvkuSwapChainFactory; ImageFactory: TvkuImageFactory; ImageViewFactory: TvkuImageViewFactory; RenderPassFactory: TvkuRenderPassFactory; FrameBufferFactory: TvkuFrameBufferFactory; DescSetLayoutFactory: TvkuDescriptorSetLayoutFactory; PipelineLayoutFactory: TvkuPipelineLayoutFactory; ShaderModuleFactory: TvkuShaderModuleFactory; PipelineFactory: TvkuGraphicsPipelineFactory; PipelineCacheFactory: TvkuPipelineCacheFactory; BufferFactory: TvkuBufferFactory; DescriptorPoolFactory: TvkuDescriptorPoolFactory; SetupCommandBuffer: TvkuCommandBuffer; QueueFamProps: TVkQueueFamilyPropertiesArr; f: TVkFormat; i: Integer; p: PVkVoid; SrfFormats: TVkSurfaceFormatArr; SurfaceCapabilities: TVkSurfaceCapabilitiesKHR; PresentModes: TVkPresentModeArr; pm: TVkPresentModeKHR; Images: TVkImageArr; AllocCallbacks: TVkAllocationCallbacks; ImageMemoryBarrier: TVkImageMemoryBarrier; CommandBuffers: TVkCommandBufferArr; MemReq: TVkMemoryRequirements; vp: TVkViewport; r2D: TVkRect2D; begin try SetupCommandBuffer := nil; fCamera := TglcCamera.Create; fAllocHandler := TCustomAllocHandler.Create; AllocCallbacks := fAllocHandler.GetStructure; ////////////////////////////////////////////////////////////////////////////// WriteLn('create instance: '); InstanceFactory := TvkuInstanceFactory.Create; try InstanceFactory.AllocHandler := fAllocHandler; InstanceFactory.EnabledExtensionNames.Add(VK_KHR_SURFACE_EXTENSION_NAME); InstanceFactory.EnabledExtensionNames.Add(VK_EXT_DEBUG_REPORT_EXTENSION_NAME); InstanceFactory.EnabledExtensionNames.Add(TvkuSurface.GetPlatformSurfaceExtensionName); fInstance := InstanceFactory.CreateInstance; WriteLn(' handle: ', PtrUInt(fInstance.Handle)); WriteLn(' done'); finally FreeAndNil(InstanceFactory); end; fDebugReporter := TvkuConsoleDebugReporter.Create(fInstance.InstanceCommands, fAllocHandler); ////////////////////////////////////////////////////////////////////////////// WriteLn('find suitable physical device'); PhyDevices := fInstance.GetPhysicalDevices; if (Length(PhyDevices) <= 0) then raise TvkuException.Create('unable to get physical device'); fPhyDevice := TvkuPhysicalDevice.Create(PhyDevices[0], fInstance.InstanceCommands); WriteLn(' handle: ', PtrUInt(fPhyDevice.Handle)); Write(' find suitable graphics queue index... '); QueueFamProps := fPhyDevice.GetQueueFamilyProperties; fGraphicsQueueFamilyIndex := high(fGraphicsQueueFamilyIndex); for i := low(QueueFamProps) to high(QueueFamProps) do begin if (VK_QUEUE_GRAPHICS_BIT in QueueFamProps[i].queueFlags) then begin fGraphicsQueueFamilyIndex := i; WriteLn(fGraphicsQueueFamilyIndex); break; end; end; if (fGraphicsQueueFamilyIndex = high(fGraphicsQueueFamilyIndex)) then raise TvkuException.Create('unable to find graphics queue index'); Write(' find suitable depth format... '); f := VK_FORMAT_UNDEFINED; for f in [ VK_FORMAT_D24_UNORM_S8_UINT, VK_FORMAT_D16_UNORM_S8_UINT, VK_FORMAT_D16_UNORM ] do begin if (VK_FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT in fPhyDevice.GetFormatProperties(f).optimalTilingFeatures) then begin fDepthFormat := f; break; end; end; WriteLn(fDepthFormat); WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('create device'); DeviceFactory := TvkuDeviceFactory.Create(fInstance); try DeviceFactory.AllocHandler := fAllocHandler; DeviceFactory.EnabledExtensionNames.Add('VK_KHR_swapchain'); DeviceFactory.QueueCreateInfos.Length := 1; with DeviceFactory.QueueCreateInfos[0] do begin Flags := 0; QueueFamilyIndex := fGraphicsQueueFamilyIndex; QueuePriorities.Length := 1; QueuePriorities[0] := 1.0; end; fDevice := DeviceFactory.CreateDevice(fPhyDevice.Handle); WriteLn(' handle: ', PtrUInt(fDevice.Handle)); WriteLn(' done'); finally FreeAndNil(DeviceFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('find suitable queue'); fQueue := TvkuQueue.Create(fDevice.GetQueue(fGraphicsQueueFamilyIndex, 0), fDevice.DeviceCommands); WriteLn(' handle: ', PtrUInt(fQueue.Handle)); WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('create surface: '); SurfaceFactory := TvkuSurfaceFactory.Create(fInstance); try SurfaceFactory.AllocHandler := fAllocHandler; SurfaceFactory.WinControl := RenderPanel; fSurface := SurfaceFactory.CreateSurface; WriteLn(' handle: ', PtrUInt(fSurface.Handle)); WriteLn(' find suitable graphics and present queue node index'); fGraphicsQueueNodeIndex := high(fGraphicsQueueNodeIndex); fPresentQueueNodeIndex := high(fPresentQueueNodeIndex); QueueFamProps := fPhyDevice.GetQueueFamilyProperties; for i := low(QueueFamProps) to high(QueueFamProps) do begin if (VK_QUEUE_GRAPHICS_BIT in QueueFamProps[i].queueFlags) then begin if (fGraphicsQueueNodeIndex = high(fGraphicsQueueNodeIndex)) then fGraphicsQueueNodeIndex := i; if fPhyDevice.GetSurfaceSupport(i, fSurface.Handle) then begin fGraphicsQueueNodeIndex := i; fPresentQueueNodeIndex := i; break; end; end; end; if (fPresentQueueNodeIndex = high(fPresentQueueNodeIndex)) then begin for i := low(QueueFamProps) to high(QueueFamProps) do begin if fPhyDevice.GetSurfaceSupport(i, fSurface.Handle) then begin fPresentQueueNodeIndex := i; break; end; end; end; WriteLn(' graphics queue node index: ', fGraphicsQueueNodeIndex); WriteLn(' present queue node index: ', fPresentQueueNodeIndex); if (fGraphicsQueueNodeIndex = high(fGraphicsQueueNodeIndex)) or (fPresentQueueNodeIndex = high(fPresentQueueNodeIndex)) or (fPresentQueueNodeIndex <> fGraphicsQueueNodeIndex) then raise TvkuException.Create('different graphic and present queue node index is not supported yet'); WriteLn(' find suitable image format'); SrfFormats := fPhyDevice.GetSurfaceFormats(fSurface.Handle); if (Length(SrfFormats) = 0) then raise TvkuException.Create('no suitable formats found'); if (Length(SrfFormats) = 1) and (SrfFormats[0].format = VK_FORMAT_UNDEFINED) then begin fColorFormat := VK_FORMAT_B8G8R8A8_UNORM; fSurfaceColorSpace := VK_COLORSPACE_SRGB_NONLINEAR_KHR; end else begin fColorFormat := SrfFormats[0].format; fSurfaceColorSpace := SrfFormats[0].colorSpace; end; WriteLn(' format: ', fColorFormat); WriteLn(' color space: ', fSurfaceColorSpace); WriteLn(' done'); finally FreeAndNil(SurfaceFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create command pool'); CommandPoolFactory := TvkuCommandPoolFactory.Create(fDevice); try CommandPoolFactory.Flags := [ VK_COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT ]; CommandPoolFactory.QueueFamilyIndex := fGraphicsQueueNodeIndex; fCommandPool := CommandPoolFactory.CreateCommandPool; WriteLn(' handle: ', PtrUInt(fCommandPool.Handle)); WriteLn(' alloc setup command buffer'); SetupCommandBuffer := TvkuCommandBuffer.Create( fCommandPool.AllocateCommandBuffer(VK_COMMAND_BUFFER_LEVEL_PRIMARY), true, fCommandPool.Handle, fDevice.DeviceCommands); SetupCommandBuffer.BeginCommand; WriteLn(' handle: ', PtrUInt(SetupCommandBuffer.Handle)); WriteLn(' done'); finally FreeAndNil(CommandPoolFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create swap chain'); SwapChainFactory := TvkuSwapChainFactory.Create(fDevice); try SwapChainFactory.AllocHandler := fAllocHandler; SwapChainFactory.Surface := fSurface.Handle; SwapChainFactory.ImageUsage := [ VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT ]; SwapChainFactory.ImageArrayLayers := 1; SwapChainFactory.ImageSharingMode := VK_SHARING_MODE_EXCLUSIVE; SwapChainFactory.Clipped := true; SwapChainFactory.ComposideAlpha := [ VK_COMPOSITE_ALPHA_OPAQUE_BIT_KHR ]; SwapChainFactory.ImageFormat := fColorFormat; SwapChainFactory.ImageColorSpace := fSurfaceColorSpace; WriteLn(' get surface capabilities'); SurfaceCapabilities := fPhyDevice.GetSurfaceCapabilities(fSurface.Handle); if (SurfaceCapabilities.currentExtent.width = High(VkUint32)) then begin SurfaceCapabilities.currentExtent.width := ClientWidth; SurfaceCapabilities.currentExtent.height := ClientHeight; end else begin ClientWidth := SurfaceCapabilities.currentExtent.width; ClientHeight := SurfaceCapabilities.currentExtent.height; end; WriteLn(' width: ', SurfaceCapabilities.currentExtent.width); WriteLn(' height: ', SurfaceCapabilities.currentExtent.height); SwapChainFactory.ImageExtent := SurfaceCapabilities.currentExtent; Write(' set min image count... '); SwapChainFactory.MinImageCount := SurfaceCapabilities.minImageCount + 1; if (SurfaceCapabilities.maxImageCount > 0) and (SwapChainFactory.MinImageCount > SurfaceCapabilities.maxImageCount) then SwapChainFactory.MinImageCount := SurfaceCapabilities.maxImageCount; WriteLn(SwapChainFactory.MinImageCount); WriteLn(' set pre transform...'); SwapChainFactory.PreTransform := SurfaceCapabilities.currentTransform; if (VK_SURFACE_TRANSFORM_IDENTITY_BIT_KHR in SurfaceCapabilities.supportedTransforms) then SwapChainFactory.PreTransform := [ VK_SURFACE_TRANSFORM_IDENTITY_BIT_KHR ]; Write(' find suitable present mode... '); PresentModes := fPhyDevice.GetSurfacePresentModes(fSurface.Handle); if (Length(PresentModes) = 0) then raise TvkuException.Create('unable to get present modes'); for pm in PresentModes do begin if (pm = VK_PRESENT_MODE_MAILBOX_KHR) then begin SwapChainFactory.PresentMode := pm; break; end; if (SwapChainFactory.PresentMode <> VK_PRESENT_MODE_MAILBOX_KHR) and (pm = VK_PRESENT_MODE_IMMEDIATE_KHR) then SwapChainFactory.PresentMode := pm; end; WriteLn(SwapChainFactory.PresentMode); fSwapChain := SwapChainFactory.CreateSwapchain; WriteLn(' handle: ', PtrUInt(fSwapChain.Handle)); WriteLn(' done'); finally FreeAndNil(SwapChainFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create images and image views'); Images := fSwapChain.GetImages; SetLength(fImages, Length(Images)); SetLength(fImageViews, Length(Images)); ImageViewFactory := TvkuImageViewFactory.Create(fDevice); try ImageViewFactory.AllocHandler := fAllocHandler; ImageViewFactory.Format := fColorFormat; ImageViewFactory.ViewType := VK_IMAGE_VIEW_TYPE_2D; with ImageViewFactory.SubresourceRange do begin AspectMask := [ VK_IMAGE_ASPECT_COLOR_BIT ]; BaseMipLevel := 0; LevelCount := 1; BaseArrayLayer := 0; LayerCount := 1; end; with ImageViewFactory.Components do begin r := VK_COMPONENT_SWIZZLE_R; g := VK_COMPONENT_SWIZZLE_G; b := VK_COMPONENT_SWIZZLE_B; a := VK_COMPONENT_SWIZZLE_A; end; for i := Low(fImageViews) to High(fImageViews) do begin fImages[i] := TvkuImage.Create(Images[i], false, fDevice.DeviceCommands, @AllocCallbacks); WriteLn(' image handle: ', PtrUInt(fImages[i].Handle)); ImageMemoryBarrier := fImages[i].GetMemoryBarrier( [ VK_IMAGE_ASPECT_COLOR_BIT ], VK_IMAGE_LAYOUT_UNDEFINED, VK_IMAGE_LAYOUT_PRESENT_SRC_KHR); SetupCommandBuffer.PipelineBarrier( [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [], [], [], [ ImageMemoryBarrier ]); ImageViewFactory.Image := fImages[i].Handle; fImageViews[i] := ImageViewFactory.CreateImageView; WriteLn(' view handle: ', PtrUInt(fImageViews[i].Handle)); end; WriteLn(' done'); finally FreeAndNil(ImageViewFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create draw command buffers'); SetLength(fDrawCommandBuffers, Length(fImageViews)); CommandBuffers := fCommandPool.AllocateCommandBuffers( VK_COMMAND_BUFFER_LEVEL_PRIMARY, Length(fDrawCommandBuffers)); for i := low(CommandBuffers) to high(CommandBuffers) do begin fDrawCommandBuffers[i] := TvkuCommandBuffer.Create( CommandBuffers[i], true, fCommandPool.Handle, fDevice.DeviceCommands); WriteLn(' handle: ', PtrUInt(fDrawCommandBuffers[i].Handle)); end; WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('create post present command buffers'); fPostPresentCommandBuffer := TvkuCommandBuffer.Create( fCommandPool.AllocateCommandBuffer(VK_COMMAND_BUFFER_LEVEL_PRIMARY), true, fCommandPool.Handle, fDevice.DeviceCommands); WriteLn(' handle: ', PtrUInt(fPostPresentCommandBuffer.Handle)); WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('create depth stencil image and image view'); ImageFactory := TvkuImageFactory.Create(fDevice); ImageViewFactory := TvkuImageViewFactory.Create(fDevice); try ImageFactory.ImageType := VK_IMAGE_TYPE_2D; ImageFactory.Format := fDepthFormat; ImageFactory.Extent := vkExtent3D( SurfaceCapabilities.currentExtent.width, SurfaceCapabilities.currentExtent.height, 1); ImageFactory.MipLevels := 1; ImageFactory.ArrayLayers := 1; ImageFactory.Samples := [ VK_SAMPLE_COUNT_1_BIT ]; ImageFactory.Tiling := VK_IMAGE_TILING_OPTIMAL; ImageFactory.Usage := [ VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT, VK_IMAGE_USAGE_TRANSFER_SRC_BIT ]; fDepthStencilImage := ImageFactory.CreateImage; fDepthStencilImage.AllocateAndBindImageMemory( fPhyDevice.GetMemoryProperties, @AllocCallbacks); WriteLn(' image handle: ', PtrUInt(fDepthStencilImage.Handle)); WriteLn(' create image memory barrier'); ImageMemoryBarrier := fImages[i].GetMemoryBarrier( [ VK_IMAGE_ASPECT_DEPTH_BIT ], VK_IMAGE_LAYOUT_UNDEFINED, VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL); SetupCommandBuffer.PipelineBarrier( [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [], [], [], [ ImageMemoryBarrier ]); ImageViewFactory.Image := fDepthStencilImage.Handle; ImageViewFactory.ViewType := VK_IMAGE_VIEW_TYPE_2D; ImageViewFactory.Format := fDepthFormat; with ImageViewFactory.SubresourceRange do begin AspectMask := [ VK_IMAGE_ASPECT_DEPTH_BIT, VK_IMAGE_ASPECT_STENCIL_BIT ]; BaseMipLevel := 0; LevelCount := 1; BaseArrayLayer := 0; LayerCount := 1; end; fDepthStencilImageView := ImageViewFactory.CreateImageView; WriteLn(' view handle: ', PtrUInt(fDepthStencilImageView.Handle)); WriteLn(' done'); finally FreeAndNil(ImageViewFactory); FreeAndNil(ImageFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create render pass'); RenderPassFactory := TvkuRenderPassFactory.Create(fDevice); try RenderPassFactory.Attachments.Length := 2; with RenderPassFactory.Attachments[0] do begin Format := fColorFormat; Samples := [ VK_SAMPLE_COUNT_1_BIT ]; LoadOp := VK_ATTACHMENT_LOAD_OP_CLEAR; StoreOp := VK_ATTACHMENT_STORE_OP_STORE; StencilLoadOp := VK_ATTACHMENT_LOAD_OP_DONT_CARE; StencilStoreOp := VK_ATTACHMENT_STORE_OP_DONT_CARE; InitialLayout := VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL; FinalLayout := VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL; end; with RenderPassFactory.Attachments[1] do begin Format := fDepthFormat; Samples := [ VK_SAMPLE_COUNT_1_BIT ]; LoadOp := VK_ATTACHMENT_LOAD_OP_CLEAR; StoreOp := VK_ATTACHMENT_STORE_OP_STORE; StencilLoadOp := VK_ATTACHMENT_LOAD_OP_DONT_CARE; StencilStoreOp := VK_ATTACHMENT_STORE_OP_DONT_CARE; InitialLayout := VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL; FinalLayout := VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL; end; RenderPassFactory.Subpasses.Length := 1; with RenderPassFactory.Subpasses[0] do begin PipelineBindPoint := VK_PIPELINE_BIND_POINT_GRAPHICS; ColorAttachments.Length := 1; ColorAttachments[0].Attachment := 0; ColorAttachments[0].Layout := VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL; DepthStencilAttachments.Length := 1; DepthStencilAttachments[0].Attachment := 1; DepthStencilAttachments[0].Layout := VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL; end; RenderPassFactory.AllocHandler := fAllocHandler; fRenderPass := RenderPassFactory.CreateRenderPass; WriteLn(' handle: ', PtrUInt(fRenderPass.Handle)); WriteLn(' done'); finally FreeAndNil(RenderPassFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create pipeline cache'); PipelineCacheFactory := TvkuPipelineCacheFactory.Create(fDevice); try fPipelineCache := PipelineCacheFactory.CreatePipelineCache; WriteLn(' handle: ', PtrUInt(fPipelineCache.Handle)); WriteLn(' done'); finally FreeAndNil(PipelineCacheFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create frame buffers'); FrameBufferFactory := TvkuFrameBufferFactory.Create(fDevice); try SetLength(fFrameBuffers, Length(fImageViews)); FrameBufferFactory.AllocHandler := fAllocHandler; FrameBufferFactory.RenderPass := fRenderPass.Handle; FrameBufferFactory.Width := SurfaceCapabilities.currentExtent.width; FrameBufferFactory.Height := SurfaceCapabilities.currentExtent.height; FrameBufferFactory.Layers := 1; FrameBufferFactory.Attachments.Length := 2; FrameBufferFactory.Attachments[1] := fDepthStencilImageView.Handle; for i := low(fFrameBuffers) to high(fFrameBuffers) do begin FrameBufferFactory.Attachments[0] := fImageViews[i].Handle; fFrameBuffers[i] := FrameBufferFactory.CreateFrameBuffer; WriteLn(' handle: ', PtrUInt(fFrameBuffers[i].Handle)); end; WriteLn(' done'); finally FreeAndNil(FrameBufferFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('flush setup command buffer'); SetupCommandBuffer.EndCommand; fQueue.Submit([], [], [ SetupCommandBuffer.Handle ], [], VK_INVALID_NDP_HANDLE); fQueue.WaitIdle; FreeAndNil(SetupCommandBuffer); WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('recreate setup command buffer'); SetupCommandBuffer := TvkuCommandBuffer.Create( fCommandPool.AllocateCommandBuffer(VK_COMMAND_BUFFER_LEVEL_PRIMARY), true, fCommandPool.Handle, fDevice.DeviceCommands); SetupCommandBuffer.BeginCommand; WriteLn(' handle: ', PtrUInt(SetupCommandBuffer.Handle)); WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// BufferFactory := TvkuBufferFactory.Create(fDevice); try WriteLn('create vertex data buffer'); BufferFactory.Size := SizeOf(VertexData); BufferFactory.Usage := [ VK_BUFFER_USAGE_VERTEX_BUFFER_BIT ]; fVertex.DataBuffer := BufferFactory.CreateBuffer; WriteLn(' buffer handle: ', PtrUInt(fVertex.DataBuffer.Handle)); MemReq := fVertex.DataBuffer.GetMemoryRequirements; fVertex.DataMemory := TvkuDeviceMemory.Create( fDevice.AllocateMemory( MemReq.size, vkuGetMemoryTypeIndex( fPhyDevice.GetMemoryProperties, MemReq.memoryTypeBits, VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT), @AllocCallbacks), true, fDevice.DeviceCommands, @AllocCallbacks); WriteLn(' memory handle: ', PtrUInt(fVertex.DataMemory.Handle)); p := fVertex.DataMemory.Map(0, MemReq.size, 0); try Move(VertexData, p^, SizeOf(VertexData)); finally fVertex.DataMemory.Unmap; end; fVertex.DataBuffer.BindMemory(fVertex.DataMemory.Handle, 0); WriteLn(' done'); WriteLn('create vertex index buffer'); BufferFactory.Size := SizeOf(IndexData); BufferFactory.Usage := [ VK_BUFFER_USAGE_INDEX_BUFFER_BIT ]; fVertex.IndexBuffer := BufferFactory.CreateBuffer; WriteLn(' buffer handle: ', PtrUInt(fVertex.IndexBuffer.Handle)); MemReq := fVertex.IndexBuffer.GetMemoryRequirements; fVertex.IndexMemory := TvkuDeviceMemory.Create( fDevice.AllocateMemory( MemReq.size, vkuGetMemoryTypeIndex( fPhyDevice.GetMemoryProperties, MemReq.memoryTypeBits, VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT), @AllocCallbacks), true, fDevice.DeviceCommands, @AllocCallbacks); WriteLn(' memory handle: ', PtrUInt(fVertex.IndexMemory.Handle)); p := fVertex.IndexMemory.Map(0, MemReq.size, 0); try Move(IndexData, p^, SizeOf(IndexData)); finally fVertex.IndexMemory.Unmap; end; fVertex.IndexBuffer.BindMemory(fVertex.IndexMemory.Handle, 0); WriteLn(' done'); WriteLn('create uniform buffer'); BufferFactory.Size := SizeOf(IndexData); BufferFactory.Usage := [ VK_BUFFER_USAGE_UNIFORM_BUFFER_BIT ]; fUniform.Buffer := BufferFactory.CreateBuffer; WriteLn(' buffer handle: ', PtrUInt(fUniform.Buffer.Handle)); MemReq := fUniform.Buffer.GetMemoryRequirements; fUniform.Memory := TvkuDeviceMemory.Create( fDevice.AllocateMemory( MemReq.size, vkuGetMemoryTypeIndex( fPhyDevice.GetMemoryProperties, MemReq.memoryTypeBits, VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT), @AllocCallbacks), true, fDevice.DeviceCommands, @AllocCallbacks); WriteLn(' memory handle: ', PtrUInt(fUniform.Memory.Handle)); fUniform.Buffer.BindMemory(fUniform.Memory.Handle, 0); UpdateUniformBuffers; WriteLn(' done'); finally FreeAndNil(BufferFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create descriptor set layout'); DescSetLayoutFactory := TvkuDescriptorSetLayoutFactory.Create(fDevice); try DescSetLayoutFactory.Bindings.Length := 1; with DescSetLayoutFactory.Bindings[0] do begin Binding := 0; // binding 0 (Uniform Buffer/Vertex Shader) DescriptorType := VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER; DescriptorCount := 1; StageFlags := [ VK_SHADER_STAGE_VERTEX_BIT ]; end; DescSetLayoutFactory.AllocHandler := fAllocHandler; fDescSetLayout := DescSetLayoutFactory.CreateDescriptorSetLayout; WriteLn(' handle: ', PtrUInt(fDescSetLayout.Handle)); WriteLn(' done'); finally FreeAndNil(DescSetLayoutFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create pipeline layout'); PipelineLayoutFactory := TvkuPipelineLayoutFactory.Create(fDevice); try PipelineLayoutFactory.AllocHandler := fAllocHandler; PipelineLayoutFactory.SetLayouts.Length := 1; PipelineLayoutFactory.SetLayouts[0] := fDescSetLayout.Handle; fPipelineLayout := PipelineLayoutFactory.CreatePipelineLayout; WriteLn(' handle: ', PtrUInt(fPipelineLayout.Handle)); WriteLn(' done'); finally FreeAndNil(PipelineLayoutFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create shader modules'); ShaderModuleFactory := TvkuShaderModuleFactory.Create(fDevice); try ShaderModuleFactory.AllocHandler := fAllocHandler; ShaderModuleFactory.LoadSpvCode(ExtractFilePath(Application.ExeName) + '../../data/shaders/triangle.vert.spv'); fVertexShader := ShaderModuleFactory.CreateShaderModule; WriteLn(' vertex handle: ', PtrUInt(fVertexShader.Handle)); ShaderModuleFactory.LoadSpvCode(ExtractFilePath(Application.ExeName) + '../../data/shaders/triangle.frag.spv'); fFragmentShader := ShaderModuleFactory.CreateShaderModule; WriteLn(' fragment handle: ', PtrUInt(fFragmentShader.Handle)); WriteLn(' done'); finally FreeAndNil(ShaderModuleFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create graphics pipeline'); PipelineFactory := TvkuGraphicsPipelineFactory.Create(fDevice); try PipelineFactory.AllocHandler := fAllocHandler; PipelineFactory.Stages.Length := 2; with PipelineFactory.Stages[0] do begin Stage := [ VK_SHADER_STAGE_VERTEX_BIT ]; Module := fVertexShader.Handle; Name := 'main'; end; with PipelineFactory.Stages[1] do begin Stage := [ VK_SHADER_STAGE_FRAGMENT_BIT ]; Module := fFragmentShader.Handle; Name := 'main'; end; with PipelineFactory.VertexInputState do begin VertexBindingDescriptions.Length := 1; VertexBindingDescriptions[0].Binding := VERTEX_BUFFER_BIND_ID; VertexBindingDescriptions[0].Stride := SizeOf(TVertex); VertexBindingDescriptions[0].InputRate := VK_VERTEX_INPUT_RATE_VERTEX; VertexAttributeDescriptions.Length := 2; // Location 0: Position VertexAttributeDescriptions[0].Binding := VERTEX_BUFFER_BIND_ID; VertexAttributeDescriptions[0].Location := 0; VertexAttributeDescriptions[0].Format := VK_FORMAT_R32G32B32_SFLOAT; VertexAttributeDescriptions[0].Offset := 0; VertexAttributeDescriptions[0].Binding := 0; // Location 1: Color VertexAttributeDescriptions[1].Binding := VERTEX_BUFFER_BIND_ID; VertexAttributeDescriptions[1].Location := 1; VertexAttributeDescriptions[1].Format := VK_FORMAT_R32G32B32_SFLOAT; VertexAttributeDescriptions[1].Offset := 3 * SizeOf(VkFloat); VertexAttributeDescriptions[1].Binding := 0; end; with PipelineFactory.InputAssemblyState do begin Topology := VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST; end; with PipelineFactory.RasterizationState do begin PolygonMode := VK_POLYGON_MODE_FILL; CullMode := VK_CULL_MODE_NONE; FrontFace := VK_FRONT_FACE_COUNTER_CLOCKWISE; DepthClampEnable := false; RasterizerDiscardEnable := false; DepthBiasEnable := false; end; with PipelineFactory.ColorBlendState do begin Attachments.Length := 1; Attachments[0].ColorWriteMask := [ VK_COLOR_COMPONENT_R_BIT, VK_COLOR_COMPONENT_G_BIT, VK_COLOR_COMPONENT_B_BIT, VK_COLOR_COMPONENT_A_BIT]; Attachments[0].BlendEnable := false; end; with PipelineFactory.ViewportState do begin Viewports.Length := 1; Scissors.Length := 1; end; with PipelineFactory.DynamicState do begin DynamicStates.Length := 2; DynamicStates[0] := VK_DYNAMIC_STATE_VIEWPORT; DynamicStates[1] := VK_DYNAMIC_STATE_SCISSOR; end; with PipelineFactory.DepthStencilState do begin DepthTestEnable := true; DepthWriteEnable := true; DepthCompareOp := VK_COMPARE_OP_LESS_OR_EQUAL; DepthBoundsTestEnable := false; StencilTestEnable := false; Back.failOp := VK_STENCIL_OP_KEEP; Back.passOp := VK_STENCIL_OP_KEEP; Back.compareOp := VK_COMPARE_OP_ALWAYS; Front := Back; end; with PipelineFactory.MultiSampleState do begin RasterizationSamples := [ VK_SAMPLE_COUNT_1_BIT ]; end; PipelineFactory.Layout := fPipelineLayout.Handle; PipelineFactory.RenderPass := fRenderPass.Handle; PipelineFactory.SubPass := 0; fPipeline := PipelineFactory.CreateGraphicsPipeline(VK_INVALID_NDP_HANDLE); WriteLn(' handle: ', PtrUInt(fPipeline.Handle)); WriteLn(' done'); finally FreeAndNil(PipelineFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('create descriptor pool'); DescriptorPoolFactory := TvkuDescriptorPoolFactory.Create(fDevice.DeviceCommands); try DescriptorPoolFactory.MaxSets := 1; DescriptorPoolFactory.PoolSizes.Length := 1; DescriptorPoolFactory.PoolSizes[0].DescriptorType := VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER; DescriptorPoolFactory.PoolSizes[0].DescriptorCount := 1; fDescriptorPool := DescriptorPoolFactory.CreateDescriptorPool; WriteLn(' handle: ', PtrUInt(fDescriptorPool.Handle)); WriteLn(' done'); finally FreeAndNil(DescriptorPoolFactory); end; ////////////////////////////////////////////////////////////////////////////// WriteLn('setup/update descriptor sets'); fDescriptorSet := TvkuDescriptorSet.Create( fDescriptorPool.AllocateDescriptorSet(fDescSetLayout.Handle), true, fDescriptorPool.Handle, fDevice.DeviceCommands); WriteLn(' handle: ', PtrUInt(fDescriptorSet.Handle)); WriteLn(' update descriptor set'); with fDevice.UpdateDescriptorSet do try WriteDescriptorSets.Length := 1; WriteDescriptorSets[0].DstSet := fDescriptorSet.Handle; WriteDescriptorSets[0].DstBinding := 0; WriteDescriptorSets[0].DescriptorType := VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER; WriteDescriptorSets[0].BufferInfos.Length := 1; WriteDescriptorSets[0].BufferInfos[0].Buffer := fUniform.Buffer.Handle; WriteDescriptorSets[0].BufferInfos[0].Offset := 0; WriteDescriptorSets[0].BufferInfos[0].Range := SizeOf(fUniform.Values); Execute; finally Free; end; WriteLn(' done'); ////////////////////////////////////////////////////////////////////////////// WriteLn('build command buffers'); for i := low(fDrawCommandBuffers) to high(fDrawCommandBuffers) do begin WriteLn(' command buffer: ', PtrUInt(fDrawCommandBuffers[i].Handle)); with fDrawCommandBuffers[i] do begin BeginCommand; with BeginRenderPass do try RenderPassBeginInfo.RenderPass := fRenderPass.Handle; RenderPassBeginInfo.Framebuffer := fFrameBuffers[i].Handle; RenderPassBeginInfo.RenderArea.offset.x := 0; RenderPassBeginInfo.RenderArea.offset.y := 0; RenderPassBeginInfo.RenderArea.extent.width := ClientWidth; RenderPassBeginInfo.RenderArea.extent.height := ClientHeight; RenderPassBeginInfo.ClearValues.Length := 2; RenderPassBeginInfo.ClearValues[0] := ClearColor; RenderPassBeginInfo.ClearValues[1] := ClearDepthStencil; Execute(VK_SUBPASS_CONTENTS_INLINE); finally Free; end; FillByte(vp, SizeOf(vp), 0); vp.height := ClientHeight; vp.width := ClientWidth; vp.minDepth := 0.0; vp.maxDepth := 1.0; SetViewport(0, [ vp ]); FillByte(r2D, SizeOf(r2D), 0); r2D.extent.width := ClientWidth; r2D.extent.height := ClientHeight; r2D.offset.x := 0; r2D.offset.y := 0; SetScissors(1, [ r2D ]); BindDescriptorSet( VK_PIPELINE_BIND_POINT_GRAPHICS, fPipelineLayout.Handle, 0, [ fDescriptorSet.Handle ], [ ]); BindPipeline( VK_PIPELINE_BIND_POINT_GRAPHICS, fPipeline.Handle); BindVertexBuffers( VERTEX_BUFFER_BIND_ID, [ fVertex.DataBuffer.Handle ], [ 0 ]); BindIndexBuffers( fVertex.IndexBuffer.Handle, 0, VK_INDEX_TYPE_UINT32); DrawIndexed( 3, 1, 0, 0, 1); FillByte(ImageMemoryBarrier, SizeOf(ImageMemoryBarrier), 0); with ImageMemoryBarrier do begin sType := VK_STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER; pNext := nil; srcAccessMask := [ VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT ]; dstAccessMask := [ ]; oldLayout := VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL; newLayout := VK_IMAGE_LAYOUT_PRESENT_SRC_KHR; srcQueueFamilyIndex := VK_QUEUE_FAMILY_IGNORED; dstQueueFamilyIndex := VK_QUEUE_FAMILY_IGNORED; subresourceRange.aspectMask := [ VK_IMAGE_ASPECT_COLOR_BIT ]; subresourceRange.baseMipLevel := 0; subresourceRange.levelCount := 1; subresourceRange.baseArrayLayer := 0; subresourceRange.layerCount := 1; end; PipelineBarrier( [ VK_PIPELINE_STAGE_ALL_COMMANDS_BIT ], [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [], [], [], [ ImageMemoryBarrier ]); EndCommand; end; end; WriteLn(' done'); finally FreeAndNil(SetupCommandBuffer); end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); begin Render; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TMainForm.FormDestroy(Sender: TObject); procedure FreeAndNilFrameBuffers; var i: Integer; begin for i := Low(fFrameBuffers) to High(fFrameBuffers) do FreeAndNil(fFrameBuffers[i]); SetLength(fFrameBuffers, 0); end; procedure FreeAndNilImages; var i: Integer; begin for i := low(fImages) to high(fImages) do FreeAndNil(fImages[i]); SetLength(fImages, 0); end; procedure FreeAndNilImageViews; var i: Integer; begin for i := Low(fImageViews) to High(fImageViews) do FreeAndNil(fImageViews[i]); SetLength(fImageViews, 0); end; procedure FreeAndNilDrawCommandBuffers; var i: Integer; begin for i := Low(fDrawCommandBuffers) to High(fDrawCommandBuffers) do FreeAndNil(fDrawCommandBuffers[i]); SetLength(fDrawCommandBuffers, 0); end; begin FreeAndNil(fDescriptorSet); FreeAndNil(fDescriptorPool); FreeAndNil(fPipeline); FreeAndNil(fFragmentShader); FreeAndNil(fVertexShader); FreeAndNil(fPipelineLayout); FreeAndNil(fDescSetLayout); FreeAndNil(fUniform.Buffer); FreeAndNil(fUniform.Memory); FreeAndNil(fVertex.DataBuffer); FreeAndNil(fVertex.DataMemory); FreeAndNil(fVertex.IndexBuffer); FreeAndNil(fVertex.IndexMemory); FreeAndNilFrameBuffers; FreeAndNil(fPipelineCache); FreeAndNil(fRenderPass); FreeAndNil(fDepthStencilImageView); FreeAndNil(fDepthStencilImage); FreeAndNil(fPostPresentCommandBuffer); FreeAndNilDrawCommandBuffers; FreeAndNilImageViews; FreeAndNilImages; FreeAndNil(fSwapChain); FreeAndNil(fCommandPool); FreeAndNil(fSurface); FreeAndNil(fQueue); FreeAndNil(fDevice); FreeAndNil(fPhyDevice); FreeAndNil(fDebugReporter); FreeAndNil(fInstance); FreeAndNil(fAllocHandler); FreeAndNil(fCamera); end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TMainForm.UpdateUniformBuffers; var p: PVkVoid; begin fCamera.Perspective(45, ClientWidth/ClientHeight, 0.001, 1000); fCamera.Position := gluMatrixIdentity * gluMatrixTranslate(gluVector3f(0, 0, -5)); fUniform.Values.ProjectionMat := fCamera.ProjMatrix; fUniform.Values.ModelMatrix := fCamera.Position; fUniform.Values.ViewMatrix := gluMatrixIdentity; p := fUniform.Memory.Map(0, SizeOf(fUniform.Values), 0); try move(fUniform.Values, p^, SizeOf(fUniform.Values)); finally fUniform.Memory.Unmap; end; end; ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TMainForm.Render; var Semaphore: TvkuSemaphore; AllocCallbacks: TVkAllocationCallbacks; CurrentImage: VkUint32; PostPresentBarrier: TVkImageMemoryBarrier; begin fDevice.WaitIdle; // present queue AllocCallbacks := fAllocHandler.GetStructure; Semaphore := TvkuSemaphore.Create( VkSemaphoreCreateFlags([ VK_FENCE_CREATE_SIGNALED_BIT ]), fDevice.DeviceCommands, @AllocCallbacks); try CurrentImage := fSwapChain.AcquireNextImage(High(VkUint64), Semaphore.Handle, VK_INVALID_NDP_HANDLE); fQueue.Submit( [ Semaphore.Handle ], [ ], [ fDrawCommandBuffers[CurrentImage].Handle ], [ ], VK_INVALID_NDP_HANDLE); fQueue.Present( [ ], [ fSwapChain.Handle ], [ CurrentImage ]); finally FreeAndNil(Semaphore); end; // post present image PostPresentBarrier := fImages[CurrentImage].GetMemoryBarrier( [ VK_IMAGE_ASPECT_COLOR_BIT ], VK_IMAGE_LAYOUT_PRESENT_SRC_KHR, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL); PostPresentBarrier.srcAccessMask := []; PostPresentBarrier.dstAccessMask := [ VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT ]; fPostPresentCommandBuffer.BeginCommand; try fPostPresentCommandBuffer.PipelineBarrier( [ VK_PIPELINE_STAGE_ALL_COMMANDS_BIT ], [ VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT ], [ ], [ ], [ ], [ PostPresentBarrier ]); finally fPostPresentCommandBuffer.EndCommand; end; // submit queue fQueue.Submit( [ ], [ ], [ fPostPresentCommandBuffer.Handle ], [ ], VK_INVALID_NDP_HANDLE); fQueue.WaitIdle; fDevice.WaitIdle; end; end.