optimize allocations
This commit is contained in:
parent
744a8ddc55
commit
cde6d15245
10 changed files with 182 additions and 268 deletions
|
@ -55,12 +55,8 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
|
||||||
frames <- V.mapM
|
frames <- V.mapM
|
||||||
(\_ -> do
|
(\_ -> do
|
||||||
|
|
||||||
commandPool <- snd <$> allocate
|
commandPool <- snd <$>
|
||||||
(Vk.createCommandPool logicalDevice poolCreateInfo Nothing)
|
(Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate)
|
||||||
(\commandPool -> do
|
|
||||||
putStrLn "destroying command pool"
|
|
||||||
Vk.destroyCommandPool logicalDevice commandPool Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
let commandBufferAllocationInfo = Vk.zero
|
let commandBufferAllocationInfo = Vk.zero
|
||||||
{ Vk.commandPool = commandPool
|
{ Vk.commandPool = commandPool
|
||||||
|
@ -68,7 +64,7 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
|
||||||
, Vk.commandBufferCount = 1
|
, Vk.commandBufferCount = 1
|
||||||
}
|
}
|
||||||
|
|
||||||
commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo
|
(_, commandBuffer) <- Vk.withCommandBuffers logicalDevice commandBufferAllocationInfo allocate
|
||||||
|
|
||||||
let semaphoreCreateInfo = Vk.zero
|
let semaphoreCreateInfo = Vk.zero
|
||||||
fenceCreateInfo = Vk.zero
|
fenceCreateInfo = Vk.zero
|
||||||
|
@ -76,19 +72,11 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout obj
|
||||||
} :: Vk.FenceCreateInfo '[]
|
} :: Vk.FenceCreateInfo '[]
|
||||||
|
|
||||||
[presentSemaphore, renderSemaphore] <- replicateM 2
|
[presentSemaphore, renderSemaphore] <- replicateM 2
|
||||||
(snd <$> allocate
|
(snd <$>
|
||||||
(Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing)
|
Vk.withSemaphore logicalDevice semaphoreCreateInfo Nothing allocate
|
||||||
(\semaphore -> do
|
|
||||||
putStrLn "destroying semaphore"
|
|
||||||
Vk.destroySemaphore logicalDevice semaphore Nothing
|
|
||||||
)
|
|
||||||
)
|
|
||||||
renderFence <- snd <$> allocate
|
|
||||||
(Vk.createFence logicalDevice fenceCreateInfo Nothing)
|
|
||||||
(\fence -> do
|
|
||||||
putStrLn "destroying fence"
|
|
||||||
Vk.destroyFence logicalDevice fence Nothing
|
|
||||||
)
|
)
|
||||||
|
renderFence <- snd <$>
|
||||||
|
Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
|
||||||
|
|
||||||
cameraBuffer <- createAllocatedBuffer
|
cameraBuffer <- createAllocatedBuffer
|
||||||
allocator
|
allocator
|
||||||
|
@ -207,143 +195,158 @@ recordCommandBuffer
|
||||||
, Vk.inheritanceInfo = Nothing
|
, Vk.inheritanceInfo = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo
|
Vk.useCommandBuffer commandBuffer commandBufferBeginInfo $ do
|
||||||
|
|
||||||
let renderPassInfo = Vk.zero
|
let renderPassInfo = Vk.zero
|
||||||
{ Vk.renderPass = renderPass
|
{ Vk.renderPass = renderPass
|
||||||
, Vk.framebuffer = frameBuffer
|
, Vk.framebuffer = frameBuffer
|
||||||
, Vk.renderArea = Vk.Rect2D
|
, Vk.renderArea = Vk.Rect2D
|
||||||
{ offset = Vk.Offset2D
|
{ offset = Vk.Offset2D
|
||||||
{ Vk.x = 0
|
{ Vk.x = 0
|
||||||
, Vk.y = 0
|
, Vk.y = 0
|
||||||
}
|
}
|
||||||
, extent = Vk.Extent2D
|
, extent = Vk.Extent2D
|
||||||
{ Vk.width = fromIntegral width
|
{ Vk.width = fromIntegral width
|
||||||
, Vk.height = fromIntegral height
|
, Vk.height = fromIntegral height
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
, Vk.clearValues = V.fromList
|
||||||
|
[ Vk.Color (Vk.Float32 0 0 0 1)
|
||||||
|
, Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)
|
||||||
|
]
|
||||||
}
|
}
|
||||||
, Vk.clearValues = V.fromList [ Vk.Color (Vk.Float32 0 0 0 1), Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)]
|
|
||||||
}
|
|
||||||
|
|
||||||
Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
|
Vk.cmdUseRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE $ do
|
||||||
|
|
||||||
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
|
liftIO $
|
||||||
|
prepareRecording width height commandBuffer renderPass frameBuffer graphicsPipeline
|
||||||
|
|
||||||
let viewport = Vk.zero
|
let framed = fromIntegral frameNumber / 120
|
||||||
{ Vk.x = 0
|
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
|
||||||
, Vk.y = 0
|
-- ambient = V4 1 0 1 1
|
||||||
, Vk.width = fromIntegral width
|
ambientParams = sceneParameters
|
||||||
, Vk.height = fromIntegral height
|
{ ambientColor = ambient
|
||||||
, Vk.minDepth = 0
|
|
||||||
, Vk.maxDepth = 1
|
|
||||||
}
|
|
||||||
scissor = Vk.Rect2D
|
|
||||||
{ Vk.offset = Vk.Offset2D
|
|
||||||
{ Vk.x = 0
|
|
||||||
, Vk.y = 0
|
|
||||||
}
|
|
||||||
, Vk.extent = Vk.Extent2D
|
|
||||||
{ Vk.width = fromIntegral width
|
|
||||||
, Vk.height = fromIntegral height
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
|
|
||||||
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
|
|
||||||
|
|
||||||
let framed = fromIntegral frameNumber / 120
|
|
||||||
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
|
|
||||||
-- ambient = V4 1 0 1 1
|
|
||||||
ambientParams = sceneParameters
|
|
||||||
{ ambientColor = ambient
|
|
||||||
}
|
|
||||||
|
|
||||||
liftIO $ do
|
|
||||||
let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
|
|
||||||
|
|
||||||
liftIO $ poke
|
|
||||||
(castPtr scenePointer)
|
|
||||||
ambientParams
|
|
||||||
|
|
||||||
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
|
|
||||||
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
|
|
||||||
|
|
||||||
V.mapM_
|
|
||||||
(\(index, RenderObject meshID materialID modelMatrix) -> do
|
|
||||||
|
|
||||||
let camPosition = V3
|
|
||||||
(-10 * sin (fromIntegral frameNumber / 90))
|
|
||||||
(-2)
|
|
||||||
(-10 * cos (fromIntegral frameNumber / 90))
|
|
||||||
camCenter = V3 0 0 0
|
|
||||||
camUp = V3 0 1 0
|
|
||||||
camView = lookAt camPosition camCenter camUp
|
|
||||||
camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200
|
|
||||||
|
|
||||||
materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
|
|
||||||
|
|
||||||
let cameraData = GPUCameraData
|
|
||||||
{ view = transpose camView
|
|
||||||
, projection = transpose camProjection
|
|
||||||
, viewProjection = transpose $ camProjection !*! camView
|
|
||||||
}
|
}
|
||||||
|
|
||||||
constants = MeshPushConstants
|
liftIO $ do
|
||||||
{ meshPushData = V4 0 0 0 0
|
let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
|
||||||
, meshRenderMatrix = transpose modelMatrix
|
|
||||||
}
|
|
||||||
mesh = meshMap M.! meshID
|
|
||||||
material = materialMap M.! materialID
|
|
||||||
|
|
||||||
liftIO $ VMA.withMappedMemory
|
liftIO $ poke
|
||||||
allocator
|
(castPtr scenePointer)
|
||||||
(bufferAllocation $ frameCameraBuffer frame)
|
ambientParams
|
||||||
bracket
|
|
||||||
$ \memoryPointer ->
|
|
||||||
|
|
||||||
liftIO $ poke (castPtr memoryPointer) cameraData
|
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
|
||||||
|
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
|
||||||
|
|
||||||
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
|
V.mapM_
|
||||||
|
(\(index, RenderObject meshID materialID modelMatrix) -> do
|
||||||
|
|
||||||
Vk.cmdBindDescriptorSets
|
let camPosition = V3
|
||||||
commandBuffer
|
(-10 * sin (fromIntegral frameNumber / 90))
|
||||||
Vk.PIPELINE_BIND_POINT_GRAPHICS
|
(-2)
|
||||||
(materialPipelineLayout material)
|
(-10 * cos (fromIntegral frameNumber / 90))
|
||||||
0
|
camCenter = V3 0 0 0
|
||||||
(V.singleton $ frameGlobalDescriptor frame)
|
camUp = V3 0 1 0
|
||||||
V.empty
|
camView = lookAt camPosition camCenter camUp
|
||||||
|
camProjection = perspective
|
||||||
|
(pi/4)
|
||||||
|
(fromIntegral width / fromIntegral height)
|
||||||
|
0.1
|
||||||
|
200
|
||||||
|
|
||||||
Vk.cmdBindDescriptorSets
|
materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
|
||||||
commandBuffer
|
|
||||||
Vk.PIPELINE_BIND_POINT_GRAPHICS
|
|
||||||
(materialPipelineLayout material)
|
|
||||||
1
|
|
||||||
(V.singleton $ frameObjectDescriptor frame)
|
|
||||||
V.empty
|
|
||||||
|
|
||||||
dataPointer <- liftIO (castPtr <$> new constants)
|
let cameraData = GPUCameraData
|
||||||
|
{ view = transpose camView
|
||||||
|
, projection = transpose camProjection
|
||||||
|
, viewProjection = transpose $ camProjection !*! camView
|
||||||
|
}
|
||||||
|
|
||||||
Vk.cmdPushConstants
|
constants = MeshPushConstants
|
||||||
commandBuffer
|
{ meshPushData = V4 0 0 0 0
|
||||||
(materialPipelineLayout material)
|
, meshRenderMatrix = transpose modelMatrix
|
||||||
Vk.SHADER_STAGE_VERTEX_BIT
|
}
|
||||||
0
|
mesh = meshMap M.! meshID
|
||||||
(fromIntegral $ sizeOf constants)
|
material = materialMap M.! materialID
|
||||||
dataPointer
|
|
||||||
|
|
||||||
Vk.cmdBindVertexBuffers
|
liftIO $ VMA.withMappedMemory
|
||||||
commandBuffer
|
allocator
|
||||||
0
|
(bufferAllocation $ frameCameraBuffer frame)
|
||||||
(V.fromList [ allocatedBuffer $ meshBuffer mesh ])
|
bracket
|
||||||
(V.fromList [ 0 ])
|
$ \memoryPointer ->
|
||||||
|
|
||||||
Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
|
liftIO $ poke (castPtr memoryPointer) cameraData
|
||||||
)
|
|
||||||
(V.zip
|
|
||||||
(V.fromList [0 ..])
|
|
||||||
renderObjects
|
|
||||||
)
|
|
||||||
|
|
||||||
Vk.cmdEndRenderPass commandBuffer
|
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
|
||||||
|
|
||||||
Vk.endCommandBuffer commandBuffer
|
Vk.cmdBindDescriptorSets
|
||||||
|
commandBuffer
|
||||||
|
Vk.PIPELINE_BIND_POINT_GRAPHICS
|
||||||
|
(materialPipelineLayout material)
|
||||||
|
0
|
||||||
|
(V.singleton $ frameGlobalDescriptor frame)
|
||||||
|
V.empty
|
||||||
|
|
||||||
|
Vk.cmdBindDescriptorSets
|
||||||
|
commandBuffer
|
||||||
|
Vk.PIPELINE_BIND_POINT_GRAPHICS
|
||||||
|
(materialPipelineLayout material)
|
||||||
|
1
|
||||||
|
(V.singleton $ frameObjectDescriptor frame)
|
||||||
|
V.empty
|
||||||
|
|
||||||
|
dataPointer <- liftIO (castPtr <$> new constants)
|
||||||
|
|
||||||
|
Vk.cmdPushConstants
|
||||||
|
commandBuffer
|
||||||
|
(materialPipelineLayout material)
|
||||||
|
Vk.SHADER_STAGE_VERTEX_BIT
|
||||||
|
0
|
||||||
|
(fromIntegral $ sizeOf constants)
|
||||||
|
dataPointer
|
||||||
|
|
||||||
|
Vk.cmdBindVertexBuffers
|
||||||
|
commandBuffer
|
||||||
|
0
|
||||||
|
(V.fromList [ allocatedBuffer $ meshBuffer mesh ])
|
||||||
|
(V.fromList [ 0 ])
|
||||||
|
|
||||||
|
Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
|
||||||
|
)
|
||||||
|
(V.zip
|
||||||
|
(V.fromList [0 ..])
|
||||||
|
renderObjects
|
||||||
|
)
|
||||||
|
|
||||||
|
prepareRecording
|
||||||
|
:: CInt
|
||||||
|
-> CInt
|
||||||
|
-> Vk.CommandBuffer
|
||||||
|
-> Vk.RenderPass
|
||||||
|
-> Vk.Framebuffer
|
||||||
|
-> Vk.Pipeline
|
||||||
|
-> IO ()
|
||||||
|
prepareRecording width height commandBuffer renderPass frameBuffer graphicsPipeline = do
|
||||||
|
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
|
||||||
|
|
||||||
|
let viewport = Vk.zero
|
||||||
|
{ Vk.x = 0
|
||||||
|
, Vk.y = 0
|
||||||
|
, Vk.width = fromIntegral width
|
||||||
|
, Vk.height = fromIntegral height
|
||||||
|
, Vk.minDepth = 0
|
||||||
|
, Vk.maxDepth = 1
|
||||||
|
}
|
||||||
|
scissor = Vk.Rect2D
|
||||||
|
{ Vk.offset = Vk.Offset2D
|
||||||
|
{ Vk.x = 0
|
||||||
|
, Vk.y = 0
|
||||||
|
}
|
||||||
|
, Vk.extent = Vk.Extent2D
|
||||||
|
{ Vk.width = fromIntegral width
|
||||||
|
, Vk.height = fromIntegral height
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
|
||||||
|
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
|
||||||
|
|
|
@ -106,12 +106,8 @@ createLogicalDevice physDevice surface = do
|
||||||
, Vk.enabledExtensionNames = extensionNames
|
, Vk.enabledExtensionNames = extensionNames
|
||||||
}
|
}
|
||||||
|
|
||||||
(_, logDevice) <- allocate
|
(_, logDevice) <-
|
||||||
(Vk.createDevice physDevice deviceCreateInfo Nothing)
|
Vk.withDevice physDevice deviceCreateInfo Nothing allocate
|
||||||
(\logDevice -> do
|
|
||||||
putStrLn "destroying logical device"
|
|
||||||
Vk.destroyDevice logDevice Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
(result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface
|
(result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface
|
||||||
unless (result == Vk.SUCCESS) $
|
unless (result == Vk.SUCCESS) $
|
||||||
|
@ -166,12 +162,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
|
||||||
, Vk.clipped = True
|
, Vk.clipped = True
|
||||||
}
|
}
|
||||||
|
|
||||||
swapchain <- snd <$> allocate
|
swapchain <- snd <$>
|
||||||
(Vk.createSwapchainKHR logicalDevice createInfo Nothing)
|
Vk.withSwapchainKHR logicalDevice createInfo Nothing allocate
|
||||||
(\swapchain -> do
|
|
||||||
putStrLn "destroying swapchain"
|
|
||||||
Vk.destroySwapchainKHR logicalDevice swapchain Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
let depthImageExtent =
|
let depthImageExtent =
|
||||||
(\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1)
|
(\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1)
|
||||||
|
@ -187,12 +179,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
|
||||||
, VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
|
, VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
|
||||||
}
|
}
|
||||||
|
|
||||||
(depthImage, depthAllocation, _) <- snd <$> allocate
|
(depthImage, depthAllocation, _) <- snd <$>
|
||||||
(VMA.createImage allocator depthImageInfo depthImageAllocationInfo)
|
VMA.withImage allocator depthImageInfo depthImageAllocationInfo allocate
|
||||||
(\(depthImage, depthAllocation, _) -> do
|
|
||||||
putStrLn "destroying image"
|
|
||||||
VMA.destroyImage allocator depthImage depthAllocation
|
|
||||||
)
|
|
||||||
|
|
||||||
let allocatedImage = AllocatedImage depthImage depthAllocation
|
let allocatedImage = AllocatedImage depthImage depthAllocation
|
||||||
depthImageView = imageviewCreate
|
depthImageView = imageviewCreate
|
||||||
|
@ -200,12 +188,8 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
|
||||||
Vk.FORMAT_D32_SFLOAT
|
Vk.FORMAT_D32_SFLOAT
|
||||||
Vk.IMAGE_ASPECT_DEPTH_BIT
|
Vk.IMAGE_ASPECT_DEPTH_BIT
|
||||||
|
|
||||||
depthImageview <- snd <$> allocate
|
depthImageview <- snd <$>
|
||||||
(Vk.createImageView logicalDevice depthImageView Nothing)
|
Vk.withImageView logicalDevice depthImageView Nothing allocate
|
||||||
(\depthImageview -> do
|
|
||||||
putStrLn "destroying image view"
|
|
||||||
Vk.destroyImageView logicalDevice depthImageview Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage)
|
return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage)
|
||||||
|
|
||||||
|
@ -243,11 +227,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
|
||||||
, layerCount = 1
|
, layerCount = 1
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
snd <$> allocate
|
snd <$>
|
||||||
(Vk.createImageView logicalDevice createInfo Nothing)
|
Vk.withImageView logicalDevice createInfo Nothing allocate
|
||||||
(\imageView -> do
|
|
||||||
putStrLn "destroying image view"
|
|
||||||
Vk.destroyImageView logicalDevice imageView Nothing
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
handles
|
handles
|
||||||
|
|
|
@ -77,7 +77,6 @@ drawFrame engineData frameNumber = do
|
||||||
V.singleton $ framePresentSemaphore frame
|
V.singleton $ framePresentSemaphore frame
|
||||||
}
|
}
|
||||||
|
|
||||||
-- liftIO $ putStrLn "submitting to queue"
|
|
||||||
Vk.queueSubmit
|
Vk.queueSubmit
|
||||||
(engineQueue engineData)
|
(engineQueue engineData)
|
||||||
(V.singleton (Vk.SomeStruct submitInfo))
|
(V.singleton (Vk.SomeStruct submitInfo))
|
||||||
|
@ -89,7 +88,6 @@ drawFrame engineData frameNumber = do
|
||||||
, Khr.imageIndices = V.singleton index
|
, Khr.imageIndices = V.singleton index
|
||||||
}
|
}
|
||||||
|
|
||||||
-- liftIO $ putStrLn "presenting queue"
|
|
||||||
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
|
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
|
||||||
|
|
||||||
unless (presentResult == Vk.SUCCESS) $
|
unless (presentResult == Vk.SUCCESS) $
|
||||||
|
|
|
@ -39,11 +39,6 @@ createFramebuffer
|
||||||
let createInfo = framebufferCreateInfo
|
let createInfo = framebufferCreateInfo
|
||||||
{ Vk.attachments = V.fromList [ imageView, depthImageView ]
|
{ Vk.attachments = V.fromList [ imageView, depthImageView ]
|
||||||
} :: Vk.FramebufferCreateInfo '[]
|
} :: Vk.FramebufferCreateInfo '[]
|
||||||
snd <$> allocate
|
snd <$> Vk.withFramebuffer logicalDevice createInfo Nothing allocate
|
||||||
(Vk.createFramebuffer logicalDevice createInfo Nothing)
|
|
||||||
(\framebuffer -> do
|
|
||||||
putStrLn "destroying framebuffer"
|
|
||||||
Vk.destroyFramebuffer logicalDevice framebuffer Nothing
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
swapchainImageViews
|
swapchainImageViews
|
||||||
|
|
|
@ -49,12 +49,8 @@ loadShader logicalDevice shaderPath stage = do
|
||||||
{ Vk.code = shader
|
{ Vk.code = shader
|
||||||
}
|
}
|
||||||
|
|
||||||
snd <$> allocate
|
snd <$>
|
||||||
(Vk.createShaderModule logicalDevice createInfo Nothing)
|
Vk.withShaderModule logicalDevice createInfo Nothing allocate
|
||||||
(\shaderModule -> do
|
|
||||||
putStrLn "destroying shader module"
|
|
||||||
Vk.destroyShaderModule logicalDevice shaderModule Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
createRenderPass
|
createRenderPass
|
||||||
:: (MonadResource m)
|
:: (MonadResource m)
|
||||||
|
@ -126,12 +122,8 @@ createRenderPass
|
||||||
, Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
|
, Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
|
||||||
} :: Vk.RenderPassCreateInfo '[]
|
} :: Vk.RenderPassCreateInfo '[]
|
||||||
|
|
||||||
snd <$> allocate
|
snd <$>
|
||||||
(Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
|
Vk.withRenderPass logicalDevice renderPassCreateInfo Nothing allocate
|
||||||
(\renderPass -> do
|
|
||||||
putStrLn "destroying render pass"
|
|
||||||
Vk.destroyRenderPass logicalDevice renderPass Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
createShaderStageCreateInfo
|
createShaderStageCreateInfo
|
||||||
:: Vk.ShaderStageFlagBits
|
:: Vk.ShaderStageFlagBits
|
||||||
|
@ -300,25 +292,18 @@ createGraphicsPipelines
|
||||||
, Vk.basePipelineIndex = -1
|
, Vk.basePipelineIndex = -1
|
||||||
}
|
}
|
||||||
|
|
||||||
pipeline <- snd <$> allocate
|
pipeline <-
|
||||||
(do
|
(do
|
||||||
(result, pipelines) <- Vk.createGraphicsPipelines
|
(result, pipelines) <- snd <$> Vk.withGraphicsPipelines
|
||||||
logicalDevice
|
logicalDevice
|
||||||
Vk.NULL_HANDLE
|
Vk.NULL_HANDLE
|
||||||
(V.singleton (Vk.SomeStruct pipelineCreateInfo))
|
(V.singleton (Vk.SomeStruct pipelineCreateInfo))
|
||||||
Nothing
|
Nothing
|
||||||
|
allocate
|
||||||
unless (result == Vk.SUCCESS) $
|
unless (result == Vk.SUCCESS) $
|
||||||
error "createGraphicsPipelines: Failed creating pipelines"
|
error "createGraphicsPipelines: Failed creating pipelines"
|
||||||
return pipelines
|
return pipelines
|
||||||
)
|
)
|
||||||
(\pipelines -> do
|
|
||||||
V.mapM_
|
|
||||||
(\pipeline -> do
|
|
||||||
putStrLn "destroying pipeline"
|
|
||||||
Vk.destroyPipeline logicalDevice pipeline Nothing
|
|
||||||
)
|
|
||||||
pipelines
|
|
||||||
)
|
|
||||||
let material = Material (V.head pipeline) pipelineLayout
|
let material = Material (V.head pipeline) pipelineLayout
|
||||||
matLibraryTMVar <- asks materialLibrary
|
matLibraryTMVar <- asks materialLibrary
|
||||||
matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar
|
matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar
|
||||||
|
@ -333,7 +318,7 @@ createMeshPipelineLayout
|
||||||
createMeshPipelineLayout logicalDevice layouts = do
|
createMeshPipelineLayout logicalDevice layouts = do
|
||||||
let pushConstantRange = Vk.zero
|
let pushConstantRange = Vk.zero
|
||||||
{ Vk.offset = 0
|
{ Vk.offset = 0
|
||||||
, Vk.size = fromIntegral (sizeOf (undefinedMeshPushConstants))
|
, Vk.size = fromIntegral (sizeOf undefinedMeshPushConstants)
|
||||||
, Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
|
, Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
|
||||||
}
|
}
|
||||||
pipelineLayoutCreateInfo = Vk.zero
|
pipelineLayoutCreateInfo = Vk.zero
|
||||||
|
@ -341,9 +326,5 @@ createMeshPipelineLayout logicalDevice layouts = do
|
||||||
, Vk.setLayouts = layouts
|
, Vk.setLayouts = layouts
|
||||||
}
|
}
|
||||||
|
|
||||||
snd <$> allocate
|
snd <$>
|
||||||
(Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
|
Vk.withPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing allocate
|
||||||
(\pipelineLayout -> do
|
|
||||||
putStrLn "destroying pipeline layout"
|
|
||||||
Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
|
|
||||||
)
|
|
||||||
|
|
24
src/Init.hs
24
src/Init.hs
|
@ -229,25 +229,13 @@ initDescriptors device = do
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
(_, descriptorSetLayout1) <- allocate
|
(_, descriptorSetLayout1) <-
|
||||||
(Vk.createDescriptorSetLayout device setInfo Nothing)
|
Vk.withDescriptorSetLayout device setInfo Nothing allocate
|
||||||
(\descriptorLayout -> do
|
|
||||||
putStrLn "destroying descriptor layout"
|
|
||||||
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
(_, descriptorSetLayout2) <- allocate
|
(_, descriptorSetLayout2) <-
|
||||||
(Vk.createDescriptorSetLayout device setInfo2 Nothing)
|
Vk.withDescriptorSetLayout device setInfo2 Nothing allocate
|
||||||
(\descriptorLayout -> do
|
|
||||||
putStrLn "destroying descriptor layout"
|
|
||||||
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
(_, descriptorPool) <- allocate
|
(_, descriptorPool) <-
|
||||||
(Vk.createDescriptorPool device poolInfo Nothing)
|
Vk.withDescriptorPool device poolInfo Nothing allocate
|
||||||
(\descriptorPoolInfo -> do
|
|
||||||
putStrLn "destroying descriptor pool"
|
|
||||||
Vk.destroyDescriptorPool device descriptorPoolInfo Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)
|
return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)
|
||||||
|
|
|
@ -32,11 +32,6 @@ createInstance window = do
|
||||||
, Vk.enabledLayerNames = V.singleton "VK_LAYER_KHRONOS_validation"
|
, Vk.enabledLayerNames = V.singleton "VK_LAYER_KHRONOS_validation"
|
||||||
}
|
}
|
||||||
|
|
||||||
(_, inst) <- allocate
|
(_, inst) <- Vk.withInstance createInfo Nothing allocate
|
||||||
(Vk.createInstance createInfo Nothing)
|
|
||||||
(\inst -> do
|
|
||||||
putStrLn "destroying instance"
|
|
||||||
Vk.destroyInstance inst Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
return inst
|
return inst
|
||||||
|
|
22
src/Main.hs
22
src/Main.hs
|
@ -80,12 +80,8 @@ createBufferView logicalDevice = do
|
||||||
Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
|
Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
|
||||||
, Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
|
, Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
|
||||||
}
|
}
|
||||||
buffer <- snd <$> allocate
|
buffer <- snd <$>
|
||||||
(Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
|
(Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate)
|
||||||
(\buffer -> do
|
|
||||||
putStrLn "destroying buffer"
|
|
||||||
Vk.destroyBuffer logicalDevice buffer Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
let bufferViewCreateInfo = Vk.zero
|
let bufferViewCreateInfo = Vk.zero
|
||||||
{ Vk.buffer = buffer
|
{ Vk.buffer = buffer
|
||||||
|
@ -94,12 +90,7 @@ createBufferView logicalDevice = do
|
||||||
, Vk.range = Vk.WHOLE_SIZE
|
, Vk.range = Vk.WHOLE_SIZE
|
||||||
}
|
}
|
||||||
|
|
||||||
allocate
|
Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate
|
||||||
(Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
|
|
||||||
(\bufferView -> do
|
|
||||||
putStrLn "destroying bufferView"
|
|
||||||
Vk.destroyBufferView logicalDevice bufferView Nothing
|
|
||||||
)
|
|
||||||
|
|
||||||
allocateMemory
|
allocateMemory
|
||||||
:: (MonadResource m)
|
:: (MonadResource m)
|
||||||
|
@ -114,9 +105,4 @@ allocateMemory logicalDevice buffer = do
|
||||||
, Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
|
, Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
|
||||||
}
|
}
|
||||||
|
|
||||||
allocate
|
Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate
|
||||||
(Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
|
|
||||||
(\memory -> do
|
|
||||||
putStrLn "Freeing memory"
|
|
||||||
Vk.freeMemory logicalDevice memory Nothing
|
|
||||||
)
|
|
||||||
|
|
|
@ -68,11 +68,7 @@ createAllocatedBuffer allocator allocationSize usage memoryUsage = do
|
||||||
, VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
|
, VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
|
||||||
} :: VMA.AllocationCreateInfo
|
} :: VMA.AllocationCreateInfo
|
||||||
|
|
||||||
(_, (buffer, newAllocation, info)) <- allocate
|
(_, (buffer, newAllocation, info)) <-
|
||||||
(VMA.createBuffer allocator bufferCreateInfo vmaAllocationInfo)
|
VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate
|
||||||
(\(buffer, newAllocation, _) -> do
|
|
||||||
putStrLn "destroying buffer"
|
|
||||||
VMA.destroyBuffer allocator buffer newAllocation
|
|
||||||
)
|
|
||||||
|
|
||||||
return $ AllocatedBuffer buffer newAllocation info
|
return $ AllocatedBuffer buffer newAllocation info
|
||||||
|
|
18
src/Mesh.hs
18
src/Mesh.hs
|
@ -62,21 +62,13 @@ uploadMesh vertices allocator = do
|
||||||
allocationCreateInfo = Vk.zero
|
allocationCreateInfo = Vk.zero
|
||||||
{ VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
|
{ VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
|
||||||
} :: VMA.AllocationCreateInfo
|
} :: VMA.AllocationCreateInfo
|
||||||
(_, mesh) <- allocate
|
mesh <- do
|
||||||
(do
|
(buffer, bAllocation, bInfo) <- snd <$>
|
||||||
(buffer, bAllocation, bInfo) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
|
VMA.withBuffer allocator bufferCreateInfo allocationCreateInfo allocate
|
||||||
return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
|
return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
|
||||||
)
|
|
||||||
(\(Mesh _ (AllocatedBuffer buffer bAllocation _)) -> do
|
|
||||||
putStrLn "destroying mesh"
|
|
||||||
VMA.destroyBuffer allocator buffer bAllocation
|
|
||||||
)
|
|
||||||
|
|
||||||
(dataReleaseKey, dataPtr) <- allocate
|
(dataReleaseKey, dataPtr) <-
|
||||||
(VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
|
VMA.withMappedMemory allocator (bufferAllocation $ meshBuffer mesh) allocate
|
||||||
(\_ -> do
|
|
||||||
VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh)
|
|
||||||
)
|
|
||||||
|
|
||||||
liftIO $ mapM_ (\(idx, vertex) ->
|
liftIO $ mapM_ (\(idx, vertex) ->
|
||||||
poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex
|
poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex
|
||||||
|
|
Loading…
Reference in a new issue