{-# 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 Types 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 viú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 dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window (swapchain, surfaceFormat) <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice vertexShader <- loadShader vulkanLogicalDevice "shadersrc/shader.vert" "vert" fragmentShader <- loadShader vulkanLogicalDevice "shadersrc/shader.frag" "frag" renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) pipelineLayout <- createPipelineLayout vulkanLogicalDevice let shaderContainer = ShaderContainer vertexShader fragmentShader pipelines <- createGraphicsPipelines vulkanLogicalDevice renderPass shaderContainer dimensions (length imageViews) pipelineLayout frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions (commandPool, graphicsQueue) <- createCommandPool vulkanPhysicalDevice vulkanLogicalDevice commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool (length frameBuffers) (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <- createSyncObjects vulkanLogicalDevice return $ EngineData window dimensions vulkanLogicalDevice swapchain graphicsQueue commandBuffer frameBuffers pipelines renderPass inFlightFence imageAvailableSemaphore renderFinishedSemaphore