{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} module Init where import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource import qualified Data.Vector as V import qualified SDL hiding (V2) import qualified SDL.Video.Vulkan as SDL import Foreign.Ptr import qualified Vulkan as Vk -- internal imports import Instance import Devices initEngine :: MonadResource m => m (SDL.Window, Vk.Instance, Vk.SurfaceKHR, Vk.SwapchainKHR, V.Vector Vk.ImageView) initEngine = do -- initialize SDL2 with all subsystems void $ allocate_ SDL.initializeAll (do print ("This is the end!" :: String) 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 $ print ("destroying window" :: String) SDL.destroyWindow window ) -- create vulkan surface and vulkan instance from window (surface, inst, swapchain, images) <- initVulkan window return (window, inst, surface, swapchain, images) initVulkan :: MonadResource m => SDL.Window -> m (Vk.SurfaceKHR, Vk.Instance, Vk.SwapchainKHR, V.Vector Vk.ImageView) initVulkan window = do vulkanInstance <- createInstance window (_, vulkanSurface) <- allocate (Vk.SurfaceKHR <$> SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance)) ) (\vulkanSurface -> do print ("destroying surface" :: String) Vk.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 return (vulkanSurface, vulkanInstance, swapchain, imageViews)