This commit is contained in:
nek0 2023-01-16 01:10:23 +01:00
parent 341260b2cd
commit e8e37f1ced
6 changed files with 68 additions and 17 deletions

View file

@ -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;

View file

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

View file

@ -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

View file

@ -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
putStrLn "activating followinfg extensions:"
print windowExtensions
-- liftIO $ do
-- putStrLn "activating followinfg extensions:"
-- 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

View file

@ -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

View file

@ -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