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 #version 450
layout (location = 0) in vec3 vPosition; layout (location = 0) in vec3 vPosition;
layout (location = 1) in vec3 vNormal; 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{ layout(set = 0, binding = 0) uniform CameraBuffer{
mat4 view; mat4 view;

View file

@ -38,8 +38,8 @@ pickPhysicalDevice vkInstance = do
physDevices physDevices
let discretePhysDevices = V.filter 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 Vk.geometryShader devFeatures
) )
devicesWithPropsAndFeatures devicesWithPropsAndFeatures

View file

@ -5,6 +5,7 @@
module Init where module Init where
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
@ -55,7 +56,12 @@ initEngine = do
-- create the window -- create the window
(_, window) <- (_, window) <-
allocate 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 (\window -> do
liftIO $ putStrLn "destroying window" liftIO $ putStrLn "destroying window"
SDL.destroyWindow window SDL.destroyWindow window
@ -175,13 +181,18 @@ initDescriptors device = do
, Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
} }
setInfo = Vk.zero setInfo = Vk.zero
{ Vk.flags = bit 0 { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
, Vk.bindings = V.singleton cameraBufferBinding , Vk.bindings = V.singleton cameraBufferBinding
} }
poolInfo = Vk.zero poolInfo = Vk.zero
{ Vk.flags = bit 0 { Vk.flags = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
, Vk.maxSets = 10 , 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 (_, descriptorSetLayout) <- allocate

View file

@ -10,29 +10,67 @@ import qualified Data.Vector as V
import qualified SDL hiding (V2) import qualified SDL hiding (V2)
import qualified SDL.Video.Vulkan as SDL import qualified SDL.Video.Vulkan as SDL
import qualified Vulkan as Vk import qualified Vulkan as Vk
import qualified Vulkan.Requirement as Vk
import qualified Vulkan.Zero as Vk import qualified Vulkan.Zero as Vk
import qualified Vulkan.Utils.Initialization as VkU
createInstance :: MonadResource m => SDL.Window -> m Vk.Instance createInstance :: MonadResource m => SDL.Window -> m Vk.Instance
createInstance window = do createInstance window = do
windowExtensions <- 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 . 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 let createInfo = Vk.zero
{ Vk.applicationInfo = Just Vk.zero { Vk.applicationInfo = Just Vk.zero
{ Vk.applicationName = Just "Haskell ❤️ Vulkan" { 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 -- enable debug util extension for debugging purposes
, Vk.enabledExtensionNames = V.fromList windowExtensions , Vk.enabledExtensionNames = V.fromList windowExtensions
-- enable validation layer for debugging purposes -- 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 SDL.vkLoadLibrary Nothing
-- VkU.createDebugInstanceFromRequirements requirements [] createInfo
(_, inst) <- allocate (_, inst) <- allocate
(Vk.createInstance createInfo Nothing) (Vk.createInstance createInfo Nothing)
(\inst -> do (\inst -> do

View file

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

View file

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