132 lines
3.8 KiB
Haskell
132 lines
3.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
module Init where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class
|
|
import Control.Monad.Trans.Resource
|
|
import qualified SDL hiding (V2)
|
|
import qualified SDL.Video.Vulkan as SDL
|
|
import Foreign.Ptr
|
|
import qualified Vulkan.Core10 as Vk
|
|
import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
|
|
import qualified Vulkan.Extensions.VK_KHR_surface as Khr
|
|
|
|
-- internal imports
|
|
|
|
import Instance
|
|
import Devices
|
|
import GraphicsPipeline
|
|
import Framebuffers
|
|
import CommandBuffer
|
|
import Memory
|
|
import Types
|
|
import Mesh
|
|
|
|
initEngine
|
|
:: (MonadResource m, MonadFail m)
|
|
=> m 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
|
|
}
|
|
|
|
-- load vulkan library
|
|
SDL.vkLoadLibrary Nothing
|
|
|
|
-- create the window
|
|
(_, window) <-
|
|
allocate
|
|
(SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
|
|
(\window -> do
|
|
liftIO $ putStrLn "destroying window"
|
|
SDL.destroyWindow window
|
|
)
|
|
|
|
-- initialize vúlkan data structures
|
|
initVulkan window
|
|
|
|
|
|
initVulkan
|
|
:: (MonadResource m, MonadFail m)
|
|
=> SDL.Window
|
|
-> m EngineData
|
|
initVulkan window = do
|
|
|
|
vulkanInstance <- createInstance window
|
|
|
|
(_, vulkanSurface) <- allocate
|
|
(Khr.SurfaceKHR <$>
|
|
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
|
|
)
|
|
(\vulkanSurface -> do
|
|
putStrLn "destroying surface"
|
|
Khr.destroySurfaceKHR vulkanInstance vulkanSurface Nothing
|
|
)
|
|
|
|
vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
|
|
(vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
|
|
|
|
allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance
|
|
|
|
maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator
|
|
|
|
dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
|
|
(swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <-
|
|
createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator
|
|
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
|
|
meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
|
|
meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.frag" "frag"
|
|
renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT
|
|
meshLayout <- createMeshPipelineLayout vulkanLogicalDevice
|
|
let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
|
|
meshPipelines <-
|
|
createGraphicsPipelines
|
|
vulkanLogicalDevice
|
|
renderPass
|
|
meshContainer
|
|
dimensions
|
|
(length imageViews)
|
|
meshLayout
|
|
(Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
|
|
|
|
frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions
|
|
|
|
(commandPool, graphicsQueue) <- createCommandPool vulkanPhysicalDevice vulkanLogicalDevice
|
|
commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool (length frameBuffers)
|
|
|
|
(imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <-
|
|
createSyncObjects vulkanLogicalDevice
|
|
|
|
return $ EngineData
|
|
window
|
|
dimensions
|
|
vulkanPhysicalDevice
|
|
vulkanLogicalDevice
|
|
vulkanInstance
|
|
swapchain
|
|
graphicsQueue
|
|
commandBuffer
|
|
frameBuffers
|
|
meshLayout
|
|
meshPipelines
|
|
renderPass
|
|
inFlightFence
|
|
imageAvailableSemaphore
|
|
renderFinishedSemaphore
|
|
maskMesh
|
|
maskMesh
|
|
allocator
|
|
depthImageView
|
|
depthAllocatedImage
|
|
Vk.FORMAT_D32_SFLOAT
|