mew

shadersrc/mesh.vert

@@ -1,9 +1,9 @@
 #version 450
 layout (location = 0) in vec3 vPosition;
 layout (location = 1) in vec3 vNormal;
-layout (location = 2) in vec3 vColor;
+layout (location = 2) in vec4 vColor;
 
-layout (location = 0) out vec3 outColor;
+layout (location = 0) out vec4 outColor;
 
 layout(set = 0, binding = 0) uniform  CameraBuffer{
 	mat4 view;

src/Devices.hs

@@ -38,8 +38,8 @@ pickPhysicalDevice vkInstance = do
     physDevices
 
   let discretePhysDevices = V.filter
-        (\(_, _, devFeatures) ->
+        (\(_, devProps, devFeatures) ->
-          -- Vk.deviceType devProp == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
+          Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
           Vk.geometryShader devFeatures
           )
         devicesWithPropsAndFeatures

src/Init.hs

@@ -5,6 +5,7 @@
 module Init where
 
 import qualified Control.Concurrent.STM as STM
+import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Reader
@@ -55,7 +56,12 @@ initEngine = do
   -- create the window
   (_, window) <-
     allocate
-      (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
+      (do
+        eexcept <- try (SDL.createWindow "Haskell ❤️ Vulkan" windowConfig)
+        case eexcept of
+          Left err -> error $ "here's your exception: " <> show (err :: SDL.SDLException)
+          Right a  -> return a
+        )
       (\window -> do
         liftIO $ putStrLn "destroying window"
         SDL.destroyWindow window
@@ -175,13 +181,18 @@ initDescriptors device = do
         , Vk.stageFlags      = Vk.SHADER_STAGE_VERTEX_BIT
         }
       setInfo = Vk.zero
-        { Vk.flags = bit 0
+        { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
         , Vk.bindings = V.singleton cameraBufferBinding
         }
       poolInfo = Vk.zero
-        { Vk.flags     = bit 0
+        { Vk.flags     = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
         , Vk.maxSets   = 10
-        , Vk.poolSizes = V.singleton (Vk.DescriptorPoolSize Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER 10)
+        , Vk.poolSizes = V.singleton
+          ( Vk.zero
+            { Vk.type' = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
+            , Vk.descriptorCount = 1
+            }
+          )
         }
 
   (_, descriptorSetLayout) <- allocate

src/Instance.hs

@@ -10,29 +10,67 @@ import qualified Data.Vector as V
 import qualified SDL hiding (V2)
 import qualified SDL.Video.Vulkan as SDL
 import qualified Vulkan as Vk
+import qualified Vulkan.Requirement as Vk
 import qualified Vulkan.Zero as Vk
+import qualified Vulkan.Utils.Initialization as VkU
 
 createInstance :: MonadResource m => SDL.Window -> m Vk.Instance
 createInstance window = do
   windowExtensions <-
-    (++) [Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME, Vk.EXT_DEBUG_UTILS_EXTENSION_NAME] <$>
+    (++)
+      -- [ Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME
+      -- , Vk.EXT_DEBUG_UTILS_EXTENSION_NAME
+      -- ]
+      [ Vk.EXT_DEBUG_UTILS_EXTENSION_NAME
+      ]
+      <$>
       ((liftIO . mapM BS.packCString) =<< SDL.vkGetInstanceExtensions window)
-  liftIO $ do
+  -- liftIO $ do
-    putStrLn "activating followinfg extensions:"
+  --   putStrLn "activating followinfg extensions:"
-    print windowExtensions
+  --   print windowExtensions
   let createInfo = Vk.zero
         { Vk.applicationInfo       = Just Vk.zero
           { Vk.applicationName = Just "Haskell ❤️ Vulkan"
-          , Vk.apiVersion      = Vk.API_VERSION_1_3
+          , Vk.apiVersion      = Vk.API_VERSION_1_2
           }
           -- enable debug util extension for debugging purposes
         , Vk.enabledExtensionNames = V.fromList windowExtensions
           -- enable validation layer for debugging purposes
-        , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
+        , Vk.enabledLayerNames     = V.fromList
+          [ "VK_LAYER_KHRONOS_validation"
+          ]
         }
+      requirements =
+        [ Vk.RequireInstanceExtension
+          { Vk.instanceExtensionLayerName  = Nothing
+          , Vk.instanceExtensionName       = Vk.KHR_GET_DISPLAY_PROPERTIES_2_EXTENSION_NAME
+          , Vk.instanceExtensionMinVersion = Vk.KHR_GET_DISPLAY_PROPERTIES_2_SPEC_VERSION
+          }
+        , Vk.RequireInstanceExtension
+          { Vk.instanceExtensionLayerName  = Nothing
+          , Vk.instanceExtensionName       = Vk.KHR_XLIB_SURFACE_EXTENSION_NAME
+          , Vk.instanceExtensionMinVersion = Vk.KHR_XLIB_SURFACE_SPEC_VERSION
+          }
+        , Vk.RequireInstanceExtension
+          { Vk.instanceExtensionLayerName  = Nothing
+          , Vk.instanceExtensionName       = Vk.KHR_DISPLAY_EXTENSION_NAME
+          , Vk.instanceExtensionMinVersion = Vk.KHR_DISPLAY_SPEC_VERSION
+          }
+        , Vk.RequireInstanceExtension
+          { Vk.instanceExtensionLayerName  = Nothing
+          , Vk.instanceExtensionName       = Vk.KHR_SURFACE_EXTENSION_NAME
+          , Vk.instanceExtensionMinVersion = Vk.KHR_SURFACE_SPEC_VERSION
+          }
+        , Vk.RequireInstanceExtension
+          { Vk.instanceExtensionLayerName  = Nothing
+          , Vk.instanceExtensionName       = Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME
+          , Vk.instanceExtensionMinVersion = Vk.KHR_PUSH_DESCRIPTOR_SPEC_VERSION
+          }
+        ]
 
   SDL.vkLoadLibrary Nothing
 
+  -- VkU.createDebugInstanceFromRequirements requirements [] createInfo
   (_, inst) <- allocate
     (Vk.createInstance createInfo Nothing)
     (\inst -> do

src/Memory.hs

@@ -66,9 +66,9 @@ createAllocatedBuffer device allocator allocationSize usage memoryUsage = do
 
   (_, (buffer, newAllocation, _)) <- allocate
     (VMA.createBuffer allocator bufferInfo vmaAllocationInfo)
-    (\(buffer, _, _) -> do
+    (\(buffer, newAllocation, _) -> do
       putStrLn "destroying buffer"
-      Vk.destroyBuffer device buffer Nothing
+      VMA.destroyBuffer allocator buffer newAllocation
       )
 
   return $ AllocatedBuffer buffer newAllocation

src/Mesh.hs

@@ -74,7 +74,9 @@ uploadMesh vertices allocator = do
 
   (dataReleaseKey, dataPtr) <- allocate
     (VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
-    (\_ -> VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh))
+    (\_ -> do
+      VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh)
+      )
 
   liftIO $ mapM_ (\(idx, vertex) ->
     poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex