2022-07-10 23:58:58 +00:00
|
|
|
{-# 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
|
2022-07-11 11:14:59 +00:00
|
|
|
=> m (SDL.Window, Vk.Instance, Vk.SurfaceKHR, Vk.SwapchainKHR, V.Vector Vk.ImageView)
|
2022-07-10 23:58:58 +00:00
|
|
|
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
|
2022-07-11 11:14:59 +00:00
|
|
|
-> m (Vk.SurfaceKHR, Vk.Instance, Vk.SwapchainKHR, V.Vector Vk.ImageView)
|
2022-07-10 23:58:58 +00:00
|
|
|
initVulkan window = do
|
|
|
|
|
|
|
|
vulkanInstance <- createInstance window
|
|
|
|
|
|
|
|
(_, vulkanSurface) <- allocate
|
|
|
|
(Vk.SurfaceKHR <$>
|
|
|
|
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
|
|
|
|
)
|
|
|
|
(\vulkanSurface -> do
|
2022-07-11 12:01:04 +00:00
|
|
|
print ("destroying surface" :: String)
|
2022-07-10 23:58:58 +00:00
|
|
|
Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing
|
|
|
|
)
|
|
|
|
|
2022-07-11 11:14:59 +00:00
|
|
|
vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
|
|
|
|
(vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
|
|
|
|
|
2022-07-10 23:58:58 +00:00
|
|
|
dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
|
2022-07-11 12:01:04 +00:00
|
|
|
(swapchain, surfaceFormat) <- createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice
|
|
|
|
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
|
2022-07-10 23:58:58 +00:00
|
|
|
|
2022-07-11 12:01:04 +00:00
|
|
|
return (vulkanSurface, vulkanInstance, swapchain, imageViews)
|