use putStrLn for printing messages and some minor adjustemnts

This commit is contained in:
nek0 2022-07-12 16:31:40 +02:00
parent 345942b3be
commit 53c2fa9c92
5 changed files with 22 additions and 14 deletions

View file

@ -46,7 +46,7 @@ pickPhysicalDevice vkInstance = do
discretePhysDevices discretePhysDevices
liftIO $ do liftIO $ do
print ("picked the following device:" :: String) putStrLn "picked the following device:"
print (Vk.deviceName props) print (Vk.deviceName props)
return maxMemdiscretePhysDevice return maxMemdiscretePhysDevice
@ -57,6 +57,13 @@ createLogicalDevice
-> Vk.SurfaceKHR -> Vk.SurfaceKHR
-> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR) -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR)
createLogicalDevice physDevice surface = do 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 let priorities = V.singleton 1
extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME extensionNames = V.singleton Vk.KHR_SWAPCHAIN_EXTENSION_NAME
queueCreateInfo = Vk.zero queueCreateInfo = Vk.zero
@ -71,7 +78,7 @@ createLogicalDevice physDevice surface = do
(_, logDevice) <- allocate (_, logDevice) <- allocate
(Vk.createDevice physDevice deviceCreateInfo Nothing) (Vk.createDevice physDevice deviceCreateInfo Nothing)
(\logDevice -> do (\logDevice -> do
print ("destroying logical device" :: String) putStrLn "destroying logical device"
Vk.destroyDevice logDevice Nothing Vk.destroyDevice logDevice Nothing
) )
@ -91,7 +98,7 @@ createSwapchain
createSwapchain surface surfaceFormats windowDimension logicalDevice = do createSwapchain surface surfaceFormats windowDimension logicalDevice = do
liftIO $ do liftIO $ do
print ("available formats:" :: String) putStrLn "available formats:"
print surfaceFormats print surfaceFormats
(surfaceFormat, colorSpace) <- (surfaceFormat, colorSpace) <-
@ -109,7 +116,7 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice = do
error ("createSwapchain: No suitable surface formats available" :: String) error ("createSwapchain: No suitable surface formats available" :: String)
liftIO $ do liftIO $ do
print ("picking following format and color space:" :: String) putStrLn "picking following format and color space:"
print (surfaceFormat, colorSpace) print (surfaceFormat, colorSpace)
let createInfo = Vk.zero let createInfo = Vk.zero
@ -130,7 +137,7 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice = do
swapchain <- snd <$> allocate swapchain <- snd <$> allocate
(Vk.createSwapchainKHR logicalDevice createInfo Nothing) (Vk.createSwapchainKHR logicalDevice createInfo Nothing)
(\swapchain -> do (\swapchain -> do
print ("destroying swapchain" :: String) putStrLn "destroying swapchain"
Vk.destroySwapchainKHR logicalDevice swapchain Nothing Vk.destroySwapchainKHR logicalDevice swapchain Nothing
) )
@ -170,7 +177,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
snd <$> allocate snd <$> allocate
(Vk.createImageView logicalDevice createInfo Nothing) (Vk.createImageView logicalDevice createInfo Nothing)
(\imageView -> do (\imageView -> do
print ("destroying image view" :: String) putStrLn "destroying image view"
Vk.destroyImageView logicalDevice imageView Nothing Vk.destroyImageView logicalDevice imageView Nothing
) )
) )

View file

@ -25,7 +25,7 @@ initEngine = do
void $ allocate_ void $ allocate_
SDL.initializeAll SDL.initializeAll
(do (do
print ("This is the end!" :: String) putStrLn "This is the end!"
SDL.quit SDL.quit
) )
@ -42,7 +42,7 @@ initEngine = do
allocate allocate
(SDL.createWindow "Haskell ❤️ Vulkan" windowConfig) (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
(\window -> do (\window -> do
liftIO $ print ("destroying window" :: String) liftIO $ putStrLn "destroying window"
SDL.destroyWindow window SDL.destroyWindow window
) )
@ -63,7 +63,7 @@ initVulkan window = do
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance)) SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
) )
(\vulkanSurface -> do (\vulkanSurface -> do
print ("destroying surface" :: String) putStrLn "destroying surface"
Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing Vk.destroySurfaceKHR vulkanInstance vulkanSurface Nothing
) )

View file

@ -17,7 +17,7 @@ createInstance window = do
windowExtensions <- liftIO $ fmap (Vk.EXT_DEBUG_UTILS_EXTENSION_NAME :) $ windowExtensions <- liftIO $ fmap (Vk.EXT_DEBUG_UTILS_EXTENSION_NAME :) $
traverse BS.packCString =<< SDL.vkGetInstanceExtensions window traverse BS.packCString =<< SDL.vkGetInstanceExtensions window
liftIO $ do liftIO $ do
print ("activating followinfg extensions:" :: String) putStrLn "activating followinfg extensions:"
print windowExtensions print windowExtensions
let createInfo = Vk.zero let createInfo = Vk.zero
{ Vk.applicationInfo = Just Vk.zero { Vk.applicationInfo = Just Vk.zero
@ -33,7 +33,7 @@ createInstance window = do
(_, inst) <- allocate (_, inst) <- allocate
(Vk.createInstance createInfo Nothing) (Vk.createInstance createInfo Nothing)
(\inst -> do (\inst -> do
print ("destroying instance" :: String) putStrLn "destroying instance"
Vk.destroyInstance inst Nothing Vk.destroyInstance inst Nothing
) )

View file

@ -59,7 +59,7 @@ createBufferView logicalDevice = do
buffer <- snd <$> allocate buffer <- snd <$> allocate
(Vk.createBuffer logicalDevice bufferCreateInfo Nothing) (Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
(\buffer -> do (\buffer -> do
print ("destroying buffer" :: String) putStrLn "destroying buffer"
Vk.destroyBuffer logicalDevice buffer Nothing Vk.destroyBuffer logicalDevice buffer Nothing
) )
@ -73,7 +73,7 @@ createBufferView logicalDevice = do
allocate allocate
(Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing) (Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
(\bufferView -> do (\bufferView -> do
print ("destroying bufferView" :: String) putStrLn "destroying bufferView"
Vk.destroyBufferView logicalDevice bufferView Nothing Vk.destroyBufferView logicalDevice bufferView Nothing
) )
@ -93,6 +93,6 @@ allocateMemory logicalDevice buffer = do
allocate allocate
(Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing) (Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
(\memory -> do (\memory -> do
print ("Freeing memory" :: String) putStrLn "Freeing memory"
Vk.freeMemory logicalDevice memory Nothing Vk.freeMemory logicalDevice memory Nothing
) )

View file

@ -18,6 +18,7 @@ maintainer: nek0@nek0.eu
-- copyright: -- copyright:
category: Game category: Game
extra-source-files: CHANGELOG.md extra-source-files: CHANGELOG.md
, shadersrc/*
executable vulkan-tutorial executable vulkan-tutorial
main-is: Main.hs main-is: Main.hs