vulkan-tutorial/src/Init.hs

257 lines
7.4 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
2023-01-05 22:07:21 +00:00
{-# LANGUAGE FlexibleContexts #-}
module Init where
2023-01-05 22:07:21 +00:00
import qualified Control.Concurrent.STM as STM
2023-01-16 00:10:23 +00:00
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
2023-01-05 22:07:21 +00:00
import Control.Monad.Reader
import Control.Monad.Trans.Resource
2023-01-05 22:07:21 +00:00
import qualified Data.Vector as V
import qualified SDL hiding (V2)
import qualified SDL.Video.Vulkan as SDL
import Foreign.Ptr
2023-01-05 22:07:21 +00:00
import Linear as L
2022-07-14 05:02:10 +00:00
import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
import qualified Vulkan.Extensions.VK_KHR_surface as Khr
2023-01-06 19:02:17 +00:00
import qualified Vulkan.Zero as Vk
-- internal imports
import Instance
import Devices
2022-07-14 05:02:10 +00:00
import GraphicsPipeline
import Framebuffers
2022-12-01 12:17:13 +00:00
import Memory
2022-07-16 19:50:22 +00:00
import Types
2022-12-01 12:17:13 +00:00
import Mesh
2023-01-06 15:54:30 +00:00
import CommandBuffer
2023-05-14 11:28:19 +00:00
import Sync
import Textures
2023-04-02 08:46:02 +00:00
import Util
initEngine
2023-01-02 01:18:06 +00:00
:: Render EngineData
initEngine = do
-- initialize SDL2 with all subsystems
void $ allocate_
SDL.initializeAll
(do
putStrLn "This is the end!"
SDL.quit
)
-- create a window configuration
let windowConfig = SDL.defaultWindow
{ SDL.windowGraphicsContext = SDL.VulkanContext -- enable Vulkan support
2023-01-06 19:02:17 +00:00
, SDL.windowInitialSize = V2 1280 1024
}
-- load vulkan library
SDL.vkLoadLibrary Nothing
-- create the window
(_, window) <-
allocate
2023-01-16 00:10:23 +00:00
(do
eexcept <- try (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
case eexcept of
Left err -> error $ "here's your exception: " <> show (err :: SDL.SDLException)
Right a -> return a
)
(\window -> do
liftIO $ putStrLn "destroying window"
SDL.destroyWindow window
)
2022-12-02 15:58:43 +00:00
-- initialize vúlkan data structures
2022-07-14 05:02:10 +00:00
initVulkan window
2022-12-01 12:17:13 +00:00
initVulkan
2023-01-02 01:18:06 +00:00
:: SDL.Window
-> Render EngineData
initVulkan window = do
vulkanInstance <- createInstance window
(_, vulkanSurface) <- allocate
2022-07-14 05:02:10 +00:00
(Khr.SurfaceKHR <$>
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
)
(\vulkanSurface -> do
putStrLn "destroying surface"
2022-07-14 05:02:10 +00:00
Khr.destroySurfaceKHR vulkanInstance vulkanSurface Nothing
)
vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
(vulkanLogicalDevice, surfaceFormats, queueIndex) <-
createLogicalDevice vulkanPhysicalDevice vulkanSurface
uploadContext <- initSyncStructures vulkanLogicalDevice queueIndex
2023-05-14 11:28:19 +00:00
2023-04-12 11:41:00 +00:00
(descriptorSetLayout1, descriptorSetLayout2, descriptorPool) <- initDescriptors vulkanLogicalDevice
2023-01-06 19:02:17 +00:00
2022-12-01 12:17:13 +00:00
allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance
dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
2022-12-28 03:18:54 +00:00
(swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <-
createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator
2022-07-11 12:01:04 +00:00
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
2023-05-12 11:30:00 +00:00
meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/tri_mesh.vert" "vert"
2023-04-02 08:46:02 +00:00
meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag"
2022-12-28 03:18:54 +00:00
renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT
2023-04-12 11:41:00 +00:00
meshLayout <- createMeshPipelineLayout
vulkanLogicalDevice
(V.fromList
[ descriptorSetLayout1
, descriptorSetLayout2
]
)
2022-12-28 03:18:54 +00:00
let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
2023-01-05 22:07:21 +00:00
createGraphicsPipelines
vulkanLogicalDevice
renderPass
meshContainer
dimensions
meshLayout
(Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
2022-12-28 03:18:54 +00:00
frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions
2022-07-14 05:02:10 +00:00
2023-05-14 11:28:19 +00:00
(frames, queue) <-
createFrames
vulkanLogicalDevice
allocator
descriptorPool
descriptorSetLayout1
descriptorSetLayout2
queueIndex
2022-07-14 05:02:10 +00:00
2023-05-14 11:28:19 +00:00
loadMeshes allocator uploadContext queue vulkanLogicalDevice
2023-01-05 22:07:21 +00:00
loadImages allocator uploadContext queue vulkanLogicalDevice
2023-01-05 22:07:21 +00:00
initScene
2023-04-20 04:21:43 +00:00
return $ EngineData
2022-07-16 19:50:22 +00:00
window
dimensions
2022-12-03 00:44:06 +00:00
vulkanPhysicalDevice
2022-07-16 19:50:22 +00:00
vulkanLogicalDevice
2022-12-03 00:44:06 +00:00
vulkanInstance
2022-07-16 19:50:22 +00:00
swapchain
2023-01-06 15:54:30 +00:00
queue
2022-07-16 19:50:22 +00:00
frameBuffers
renderPass
2022-12-03 00:44:06 +00:00
allocator
2022-12-28 03:18:54 +00:00
depthImageView
depthAllocatedImage
Vk.FORMAT_D32_SFLOAT
2023-01-06 15:54:30 +00:00
frames
2023-04-12 11:41:00 +00:00
descriptorSetLayout1
descriptorSetLayout2
2023-01-06 19:02:17 +00:00
descriptorPool
2023-04-20 04:21:43 +00:00
(GPUSceneData
2023-04-02 08:46:02 +00:00
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
)
2023-05-14 11:28:19 +00:00
uploadContext
2023-04-02 08:46:02 +00:00
2023-01-05 22:07:21 +00:00
initScene :: (MonadReader ReadState m, MonadIO m) => m ()
initScene = do
2023-04-20 04:21:43 +00:00
let catMask = RenderObject
2023-01-05 22:07:21 +00:00
{ objectMesh = "mask"
, objectMaterial = "defaultMesh"
, objectMatrix = identity
}
2023-01-06 04:04:14 +00:00
triangles = V.concatMap
(\y ->
V.map
(\x ->
let
translationMatrix = mkTransformation (Quaternion 1 (V3 0 0 0)) (V3 x 0 y)
scaleMatrix = scaled (V4 0.2 0.2 0.2 1)
in
RenderObject
{ objectMesh = "triangle"
, objectMaterial = "defaultMesh"
, objectMatrix = translationMatrix !*! scaleMatrix
}
)
(V.fromList [-20 .. 20])
)
(V.fromList [-20 .. 20])
2023-01-05 22:07:21 +00:00
renderableContainer <- asks renderables
renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer
void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $
2023-04-20 04:21:43 +00:00
(renderableVector `V.snoc` catMask) V.++ triangles
2023-01-06 19:02:17 +00:00
initDescriptors
:: (MonadResource m)
=> Vk.Device
2023-04-12 11:41:00 +00:00
-> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool)
2023-01-06 19:02:17 +00:00
initDescriptors device = do
2023-04-02 08:46:02 +00:00
let cameraBind = descriptorsetLayoutBinding
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
Vk.SHADER_STAGE_VERTEX_BIT
0
sceneBind = descriptorsetLayoutBinding
2023-04-19 15:26:33 +00:00
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
2023-04-19 13:20:44 +00:00
Vk.SHADER_STAGE_FRAGMENT_BIT
2023-04-02 08:46:02 +00:00
1
2023-04-12 11:41:00 +00:00
objectBind = descriptorsetLayoutBinding
Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
Vk.SHADER_STAGE_VERTEX_BIT
0
2023-01-06 19:02:17 +00:00
setInfo = Vk.zero
2023-01-16 00:10:23 +00:00
{ Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
2023-04-02 08:46:02 +00:00
, Vk.bindings = V.fromList
[ cameraBind
, sceneBind
]
2023-01-06 19:02:17 +00:00
}
2023-04-12 11:41:00 +00:00
setInfo2 = Vk.zero
{ Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
, Vk.bindings = V.singleton objectBind
}
2023-01-06 19:02:17 +00:00
poolInfo = Vk.zero
2023-01-16 00:10:23 +00:00
{ Vk.flags = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
2023-01-06 19:02:17 +00:00
, Vk.maxSets = 10
2023-04-12 11:41:00 +00:00
, Vk.poolSizes = V.fromList
[ Vk.zero
2023-01-17 04:35:57 +00:00
{ Vk.type' = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, Vk.descriptorCount = 10
2023-01-16 00:10:23 +00:00
}
2023-04-12 11:41:00 +00:00
, Vk.zero
2023-05-12 11:30:00 +00:00
{ Vk.type' = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
2023-04-12 11:41:00 +00:00
, Vk.descriptorCount = 10
}
, Vk.zero
{ Vk.type' = Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
, Vk.descriptorCount = 10
}
]
2023-01-06 19:02:17 +00:00
}
2023-04-29 00:10:27 +00:00
(_, descriptorSetLayout1) <-
Vk.withDescriptorSetLayout device setInfo Nothing allocate
2023-01-06 19:02:17 +00:00
2023-04-29 00:10:27 +00:00
(_, descriptorSetLayout2) <-
Vk.withDescriptorSetLayout device setInfo2 Nothing allocate
2023-04-12 11:41:00 +00:00
2023-04-29 00:10:27 +00:00
(_, descriptorPool) <-
Vk.withDescriptorPool device poolInfo Nothing allocate
2023-01-06 19:02:17 +00:00
2023-04-12 11:41:00 +00:00
return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)