diff --git a/src/Devices.hs b/src/Devices.hs index 304f565..df37e9a 100644 --- a/src/Devices.hs +++ b/src/Devices.hs @@ -46,7 +46,7 @@ pickPhysicalDevice vkInstance = do discretePhysDevices liftIO $ do - print ("picked the following device:" :: String) + putStrLn "picked the following device:" print (Vk.deviceName props) return maxMemdiscretePhysDevice @@ -57,6 +57,13 @@ createLogicalDevice -> Vk.SurfaceKHR -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR) createLogicalDevice physDevice surface = do + + queueFamiliyProperties <- Vk.getPhysicalDeviceQueueFamilyProperties physDevice + + liftIO $ do + putStrLn "There are currently following queue families available" + print queueFamiliyProperties + let priorities = V.singleton 1 extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME queueCreateInfo = Vk.zero @@ -71,7 +78,7 @@ createLogicalDevice physDevice surface = do (_, logDevice) <- allocate (Vk.createDevice physDevice deviceCreateInfo Nothing) (\logDevice -> do - print ("destroying logical device" :: String) + putStrLn "destroying logical device" Vk.destroyDevice logDevice Nothing ) @@ -91,7 +98,7 @@ createSwapchain createSwapchain surface surfaceFormats windowDimension logicalDevice = do liftIO $ do - print ("available formats:" :: String) + putStrLn "available formats:" print surfaceFormats (surfaceFormat, colorSpace) <- @@ -109,7 +116,7 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice = do error ("createSwapchain: No suitable surface formats available" :: String) liftIO $ do - print ("picking following format and color space:" :: String) + putStrLn "picking following format and color space:" print (surfaceFormat, colorSpace) let createInfo = Vk.zero @@ -130,7 +137,7 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice = do swapchain <- snd <$> allocate (Vk.createSwapchainKHR logicalDevice createInfo Nothing) (\swapchain -> do - print ("destroying swapchain" :: String) + putStrLn "destroying swapchain" Vk.destroySwapchainKHR logicalDevice swapchain Nothing ) @@ -170,7 +177,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do snd <$> allocate (Vk.createImageView logicalDevice createInfo Nothing) (\imageView -> do - print ("destroying image view" :: String) + putStrLn "destroying image view" Vk.destroyImageView logicalDevice imageView Nothing ) ) diff --git a/src/Init.hs b/src/Init.hs index 2ae5f27..79f874b 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -25,7 +25,7 @@ initEngine = do void $ allocate_ SDL.initializeAll (do - print ("This is the end!" :: String) + putStrLn "This is the end!" SDL.quit ) @@ -42,7 +42,7 @@ initEngine = do allocate (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig) (\window -> do - liftIO $ print ("destroying window" :: String) + liftIO $ putStrLn "destroying window" SDL.destroyWindow window ) @@ -63,7 +63,7 @@ initVulkan window = do SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance)) ) (\vulkanSurface -> do - print ("destroying surface" :: String) + putStrLn "destroying surface" Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing ) diff --git a/src/Instance.hs b/src/Instance.hs index a306396..b74701b 100644 --- a/src/Instance.hs +++ b/src/Instance.hs @@ -17,7 +17,7 @@ createInstance window = do windowExtensions <- liftIO $ fmap (Vk.EXT_DEBUG_UTILS_EXTENSION_NAME :) $ traverse BS.packCString =<< SDL.vkGetInstanceExtensions window liftIO $ do - print ("activating followinfg extensions:" :: String) + putStrLn "activating followinfg extensions:" print windowExtensions let createInfo = Vk.zero { Vk.applicationInfo = Just Vk.zero @@ -33,7 +33,7 @@ createInstance window = do (_, inst) <- allocate (Vk.createInstance createInfo Nothing) (\inst -> do - print ("destroying instance" :: String) + putStrLn "destroying instance" Vk.destroyInstance inst Nothing ) diff --git a/src/Main.hs b/src/Main.hs index d9c39fc..784dcaf 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -59,7 +59,7 @@ createBufferView logicalDevice = do buffer <- snd <$> allocate (Vk.createBuffer logicalDevice bufferCreateInfo Nothing) (\buffer -> do - print ("destroying buffer" :: String) + putStrLn "destroying buffer" Vk.destroyBuffer logicalDevice buffer Nothing ) @@ -73,7 +73,7 @@ createBufferView logicalDevice = do allocate (Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing) (\bufferView -> do - print ("destroying bufferView" :: String) + putStrLn "destroying bufferView" Vk.destroyBufferView logicalDevice bufferView Nothing ) @@ -93,6 +93,6 @@ allocateMemory logicalDevice buffer = do allocate (Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing) (\memory -> do - print ("Freeing memory" :: String) + putStrLn "Freeing memory" Vk.freeMemory logicalDevice memory Nothing ) diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal index df8df1e..78af06b 100644 --- a/vulkan-tutorial.cabal +++ b/vulkan-tutorial.cabal @@ -18,6 +18,7 @@ maintainer: nek0@nek0.eu -- copyright: category: Game extra-source-files: CHANGELOG.md + , shadersrc/* executable vulkan-tutorial main-is: Main.hs