Compare commits

..

7 commits

Author SHA1 Message Date
nek0 2d1ac519c5 make it work! 2023-04-19 17:31:22 +02:00
nek0 fa984175b3 make runnable on non-discrete GPUs 2023-04-19 17:30:59 +02:00
nek0 d1597f4e35 make runnable on non-discrete GPUs 2023-04-19 17:30:59 +02:00
nek0 3b69ac0389 flake update 2023-04-19 17:30:56 +02:00
nek0 13bd4ac3f1 first little steps 2023-04-19 17:30:01 +02:00
nek0 91e33f4b6c make output visible 2023-04-19 15:38:54 +02:00
nek0 c4425b4647 flake update 2023-04-19 15:22:20 +02:00
30 changed files with 495 additions and 4308 deletions

1
.envrc
View file

@ -1 +0,0 @@
use flake

1
.gitignore vendored
View file

@ -1,3 +1,4 @@
.direnv/ .direnv/
.envrc
dist-newstyle/ dist-newstyle/
extern/ extern/

View file

@ -1,13 +0,0 @@
# Blender MTL File: 'jaeger.blend'
# Material Count: 1
newmtl Material_jaeger.texture.tga
Ns 92.156863
Ka 1.000000 1.000000 1.000000
Kd 0.512000 0.512000 0.512000
Ks 0.500000 0.500000 0.500000
Ke 0.000000 0.000000 0.000000
Ni 1.000000
d 1.000000
illum 2
map_Kd jaeger.texture.tga

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

Binary file not shown.

Before

Width:  |  Height:  |  Size: 167 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 32 MiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 4 MiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 4 MiB

View file

@ -5,11 +5,11 @@
"systems": "systems" "systems": "systems"
}, },
"locked": { "locked": {
"lastModified": 1694529238, "lastModified": 1681202837,
"narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
"owner": "numtide", "owner": "numtide",
"repo": "flake-utils", "repo": "flake-utils",
"rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "rev": "cfacdce06f30d2b68473a46042957675eebb3401",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -20,11 +20,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1699181587, "lastModified": 1681910883,
"narHash": "sha256-v35mUUgVU2ituIHPNHifpjl5uiYQYyLrpaMtz8X8Ums=", "narHash": "sha256-z/21lGaEJ/994LiS1Y1ruTfgVme5w/d3Ww8MluaffDM=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "197629b470f184a47b2a5716312d25b09454bbf8", "rev": "5608f9dbad40f3a0495a351eceb8c4debb9e6099",
"type": "github" "type": "github"
}, },
"original": { "original": {

View file

@ -11,36 +11,28 @@
let let
pkgs = nixpkgs.legacyPackages.${system}; pkgs = nixpkgs.legacyPackages.${system};
nixos-lib = import (nixpkgs + "/nixos/lib") {}; haskellPackages = pkgs.haskellPackages;
haskellPackages = pkgs.haskellPackages.override (old: {
overrides = final: prev: {
wavefront = jailbreakUnbreak prev.wavefront;
vulkan-tutorial = vulkan-tutorial;
};
});
vulkan-tutorial = # (ref:haskell-package-def)
haskellPackages.callCabal2nix packageName self {
# Dependency overrides go here
#wavefront = jailbreakUnbreak haskellPackages.wavefront;
};
jailbreakUnbreak = pkg: jailbreakUnbreak = pkg:
pkgs.haskell.lib.doJailbreak (pkgs.haskell.lib.markUnbroken pkg); pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
packageName = "vulkan-tutorial"; packageName = "vulkan-tutorial";
in rec { in rec {
packages.default = haskellPackages.vulkan-tutorial; packages.${packageName} = # (ref:haskell-package-def)
haskellPackages.callCabal2nix packageName self rec {
# Dependency overrides go here
wavefront = jailbreakUnbreak haskellPackages.wavefront;
};
devShells.default = haskellPackages.shellFor { defaultPackage = self.packages.${system}.${packageName};
packages = p: [ p.vulkan-tutorial ];
devShell = haskellPackages.shellFor {
packages = p: [ defaultPackage ];
withHoogle = true; withHoogle = true;
buildInputs = (with haskellPackages; [ buildInputs = (with haskellPackages; [
haskell-language-server haskell-language-server
ghcid ghcid
cabal-install cabal-install
(jailbreakUnbreak wavefront)
]) ++ (with pkgs; [ ]) ++ (with pkgs; [
shaderc shaderc
vulkan-loader vulkan-loader
@ -50,6 +42,21 @@
VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d"; VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so"; SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
}; };
}); #devShell = pkgs.mkShell {
# buildInputs = with haskellPackages; [
# haskell-language-server
# ghcid
# cabal-install
# ];
# nativeBuildInputs = with pkgs; [
# pkg-config
# SDL2
# vulkan-validation-layers
# vulkan-headers
# vulkan-loader
# ];
# inputsFrom = builtins.attrValues self.packages.${system};
#};
});
} }

View file

@ -1,24 +0,0 @@
//glsl version 4.5
#version 450
//shader input
layout (location = 0) in vec4 inColor;
layout (location = 1) in vec2 texCoord;
//output write
layout (location = 0) out vec4 outFragColor;
layout(set = 0, binding = 1) uniform SceneData{
vec4 fogColor; // w is for exponent
vec4 fogDistances; //x for min, y for max, zw unused.
vec4 ambientColor;
vec4 sunlightDirection; //w for sun power
vec4 sunlightColor;
} sceneData;
layout(set = 2, binding = 0) uniform sampler2D tex1;
void main()
{
vec3 color = texture(tex1, texCoord).xyz;
outFragColor = vec4(color, inColor.w);
}

View file

@ -1,40 +0,0 @@
#version 460
layout (location = 0) in vec3 vPosition;
layout (location = 1) in vec3 vNormal;
layout (location = 2) in vec4 vColor;
layout (location = 3) in vec2 vTexCoord;
layout (location = 0) out vec4 outColor;
layout (location = 1) out vec2 texCoord;
layout(set = 0, binding = 0) uniform CameraBuffer{
mat4 view;
mat4 proj;
mat4 viewproj;
} cameraData;
struct ObjectData{
mat4 model;
};
//all object matrices
layout(std140,set = 1, binding = 0) readonly buffer ObjectBuffer{
ObjectData objects[];
} objectBuffer;
//push constants block
layout( push_constant ) uniform constants
{
vec4 data;
mat4 render_matrix;
} PushConstants;
void main()
{
mat4 modelMatrix = objectBuffer.objects[gl_BaseInstance].model;
mat4 transformMatrix = (cameraData.viewproj * modelMatrix);
gl_Position = transformMatrix * vec4(vPosition, 1.0f);
outColor = vColor;
texCoord = vTexCoord;
}

View file

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -14,15 +15,17 @@ import Foreign hiding (void)
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Linear import Linear
import qualified Vulkan as Vk import qualified Vulkan as Vk
import qualified Vulkan.CStruct.Extends as Vk
import qualified Vulkan.Zero as Vk import qualified Vulkan.Zero as Vk
import qualified VulkanMemoryAllocator as VMA import qualified VulkanMemoryAllocator as VMA
-- internal imports -- internal imports
import Devices
import Types import Types
import Memory import Memory
import Util import Util
import Mesh (compactDraws) import Control.Exception (bracket, bracket_)
frameOverlap :: Int frameOverlap :: Int
frameOverlap = 2 frameOverlap = 2
@ -32,21 +35,18 @@ maxObjects = 10000
createFrames createFrames
:: (MonadResource m, MonadFail m) :: (MonadResource m, MonadFail m)
=> Vk.Device => Vk.PhysicalDevice
-> Vk.Device
-> VMA.Allocator -> VMA.Allocator
-> Vk.DescriptorPool -> Vk.DescriptorPool
-> Vk.DescriptorSetLayout -> Vk.DescriptorSetLayout
-> Vk.DescriptorSetLayout -> Vk.DescriptorSetLayout
-> Word32
-> m (V.Vector FrameData, Vk.Queue) -> m (V.Vector FrameData, Vk.Queue)
createFrames createFrames physicalDevice logicalDevice allocator descriptorPool setLayout objectSetLayout = do
logicalDevice
allocator queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT
descriptorPool
setLayout deviceProperties <- Vk.getPhysicalDeviceProperties physicalDevice
objectSetLayout
queueFamilyIndex
= do
let poolCreateInfo = Vk.zero let poolCreateInfo = Vk.zero
{ Vk.flags = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT { Vk.flags = Vk.COMMAND_POOL_CREATE_RESET_COMMAND_BUFFER_BIT
@ -56,10 +56,14 @@ createFrames
graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0 graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0
frames <- V.mapM frames <- V.mapM
(\_ -> do (\index -> do
commandPool <- snd <$> commandPool <- snd <$> allocate
Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate (Vk.createCommandPool logicalDevice poolCreateInfo Nothing)
(\commandPool -> do
putStrLn "destroying command pool"
Vk.destroyCommandPool logicalDevice commandPool Nothing
)
let commandBufferAllocationInfo = Vk.zero let commandBufferAllocationInfo = Vk.zero
{ Vk.commandPool = commandPool { Vk.commandPool = commandPool
@ -67,7 +71,7 @@ createFrames
, Vk.commandBufferCount = 1 , Vk.commandBufferCount = 1
} }
(_, commandBuffer) <- Vk.withCommandBuffers logicalDevice commandBufferAllocationInfo allocate commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo
let semaphoreCreateInfo = Vk.zero let semaphoreCreateInfo = Vk.zero
fenceCreateInfo = Vk.zero fenceCreateInfo = Vk.zero
@ -75,11 +79,19 @@ createFrames
} :: Vk.FenceCreateInfo '[] } :: Vk.FenceCreateInfo '[]
[presentSemaphore, renderSemaphore] <- replicateM 2 [presentSemaphore, renderSemaphore] <- replicateM 2
(snd <$> (snd <$> allocate
Vk.withSemaphore logicalDevice semaphoreCreateInfo Nothing allocate (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing)
(\semaphore -> do
putStrLn "destroying semaphore"
Vk.destroySemaphore logicalDevice semaphore Nothing
)
)
renderFence <- snd <$> allocate
(Vk.createFence logicalDevice fenceCreateInfo Nothing)
(\fence -> do
putStrLn "destroying fence"
Vk.destroyFence logicalDevice fence Nothing
) )
renderFence <- snd <$>
Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
cameraBuffer <- createAllocatedBuffer cameraBuffer <- createAllocatedBuffer
allocator allocator
@ -87,6 +99,11 @@ createFrames
Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
VMA.MEMORY_USAGE_CPU_TO_GPU VMA.MEMORY_USAGE_CPU_TO_GPU
let sceneParamBufferSize =
-- frameOverlap *
fromIntegral (padUniformBufferSize
(fromIntegral $ sizeOf undefinedGPUSceneData)
deviceProperties)
sceneBuffer <- createAllocatedBuffer sceneBuffer <- createAllocatedBuffer
allocator allocator
(sizeOf undefinedGPUSceneData * frameOverlap) (sizeOf undefinedGPUSceneData * frameOverlap)
@ -99,15 +116,6 @@ createFrames
Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT
VMA.MEMORY_USAGE_CPU_TO_GPU VMA.MEMORY_USAGE_CPU_TO_GPU
indirectBuffer <- createAllocatedBuffer
allocator
(maxObjects * sizeOf (undefined :: Vk.DrawIndirectCommand))
(Vk.BUFFER_USAGE_TRANSFER_DST_BIT .|.
Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT .|.
Vk.BUFFER_USAGE_INDIRECT_BUFFER_BIT
)
VMA.MEMORY_USAGE_CPU_TO_GPU
let allocationInfo = Vk.zero let allocationInfo = Vk.zero
{ Vk.descriptorPool = descriptorPool { Vk.descriptorPool = descriptorPool
, Vk.setLayouts = V.singleton setLayout , Vk.setLayouts = V.singleton setLayout
@ -123,7 +131,7 @@ createFrames
let cameraInfo = Vk.zero let cameraInfo = Vk.zero
{ Vk.buffer = allocatedBuffer cameraBuffer { Vk.buffer = allocatedBuffer cameraBuffer
, Vk.offset = 0 , Vk.offset = 0
, Vk.range = fromIntegral $ sizeOf (undefined :: GPUCameraData) , Vk.range = fromIntegral $ sizeOf (GPUCameraData identity identity identity)
} :: Vk.DescriptorBufferInfo } :: Vk.DescriptorBufferInfo
sceneInfo = Vk.zero sceneInfo = Vk.zero
{ Vk.buffer = allocatedBuffer sceneBuffer { Vk.buffer = allocatedBuffer sceneBuffer
@ -142,7 +150,7 @@ createFrames
cameraInfo cameraInfo
0 0
sceneWrite = writeDescriptorBuffer sceneWrite = writeDescriptorBuffer
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
(V.head globalDescriptor) (V.head globalDescriptor)
sceneInfo sceneInfo
1 1
@ -169,7 +177,6 @@ createFrames
, frameCameraBuffer = cameraBuffer , frameCameraBuffer = cameraBuffer
, frameSceneBuffer = sceneBuffer , frameSceneBuffer = sceneBuffer
, frameObjectBuffer = objectBuffer , frameObjectBuffer = objectBuffer
, frameIndirectBuffer = indirectBuffer
, frameGlobalDescriptor = V.head globalDescriptor , frameGlobalDescriptor = V.head globalDescriptor
, frameObjectDescriptor = V.head objectDescriptor , frameObjectDescriptor = V.head objectDescriptor
} }
@ -181,22 +188,32 @@ createFrames
recordCommandBuffer recordCommandBuffer
:: (MonadResource m, MonadReader ReadState m, MonadIO m) :: (MonadResource m, MonadReader ReadState m, MonadIO m)
=> VMA.Allocator => Vk.CommandBuffer
-> Vk.CommandBuffer
-> Vk.RenderPass -> Vk.RenderPass
-> Vk.Framebuffer -> Vk.Framebuffer
-> V2 CInt -> V2 CInt
-> Vk.Pipeline -> Vk.Pipeline
-> Vk.PipelineLayout
-> VMA.Allocator
-> GPUSceneData
-> AllocatedBuffer
-> Vk.PhysicalDeviceProperties
-> FrameData -> FrameData
-> Int
-> m () -> m ()
recordCommandBuffer recordCommandBuffer
allocator
commandBuffer commandBuffer
renderPass renderPass
frameBuffer frameBuffer
dimensions@(V2 width height) (V2 width height)
graphicsPipeline graphicsPipeline
meshLayout
allocator
sceneParameters
sceneParameterBuffer
deviceProps
frame frame
frameNumber
= do = do
let commandBufferBeginInfo = Vk.zero let commandBufferBeginInfo = Vk.zero
@ -204,190 +221,177 @@ recordCommandBuffer
, Vk.inheritanceInfo = Nothing , Vk.inheritanceInfo = Nothing
} }
Vk.useCommandBuffer commandBuffer commandBufferBeginInfo $ do Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo
let renderPassInfo = Vk.zero let renderPassInfo = Vk.zero
{ Vk.renderPass = renderPass { Vk.renderPass = renderPass
, Vk.framebuffer = frameBuffer , Vk.framebuffer = frameBuffer
, Vk.renderArea = Vk.Rect2D , Vk.renderArea = Vk.Rect2D
{ offset = Vk.Offset2D { offset = Vk.Offset2D
{ Vk.x = 0 { Vk.x = 0
, Vk.y = 0 , Vk.y = 0
} }
, extent = Vk.Extent2D , extent = Vk.Extent2D
{ Vk.width = fromIntegral width { Vk.width = fromIntegral width
, Vk.height = fromIntegral height , Vk.height = fromIntegral height
}
} }
, Vk.clearValues = V.fromList
[ Vk.Color (Vk.Float32 0 0 0 1)
, Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)
]
} }
, Vk.clearValues = V.fromList [ Vk.Color (Vk.Float32 0 0 0 1), Vk.DepthStencil (Vk.ClearDepthStencilValue 1 0)]
}
Vk.cmdUseRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE $ do Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
liftIO $ Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
prepareRecording dimensions commandBuffer graphicsPipeline
let viewport = Vk.zero
{ Vk.x = 0
, Vk.y = 0
, Vk.width = fromIntegral width
, Vk.height = fromIntegral height
, Vk.minDepth = 0
, Vk.maxDepth = 1
}
scissor = Vk.Rect2D
{ Vk.offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, Vk.extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
}
}
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
let framed = fromIntegral frameNumber / 120
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
-- ambient = V4 1 0 1 1
ambientParams = sceneParameters
{ ambientColor = ambient
}
frameIndex = frameNumber `mod` frameOverlap
sceneDataOffset = padUniformBufferSize
(fromIntegral $ sizeOf undefinedGPUSceneData)
deviceProps
liftIO $ do
-- VMA.withMappedMemory allocator (bufferAllocation (frameSceneBuffer frame)) bracket $
-- \scenePointer ->
let scenePointer = VMA.mappedData (bufferInfo (frameSceneBuffer frame))
-- dataPointer <- liftIO $ new scenePointer
-- paramsPtr <- liftIO (new ambientParams)
-- liftIO $ copyBytes
-- (scenePointer `plusPtr` (fromIntegral sceneDataOffset * fromIntegral frameIndex))
-- paramsPtr
-- (sizeOf undefinedGPUSceneData)
liftIO $ poke
(castPtr scenePointer)
-- (castPtr scenePointer `plusPtr`
-- (fromIntegral $
-- padUniformBufferSize (fromIntegral $ sizeOf (undefinedGPUSceneData)) deviceProps))-- *
-- -- fromIntegral frameIndex))
ambientParams
-- liftIO $ do
-- test <- peek (castPtr scenePointer :: Ptr GPUSceneData)
-- print test
-- VMA.unmapMemory allocator (bufferAllocation sceneParameterBuffer)
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
V.mapM_
(\(index, RenderObject meshID materialID modelMatrix) -> do
let camPosition = V3
(-10 * sin (fromIntegral frameNumber / 90))
(-2)
(-10 * cos (fromIntegral frameNumber / 90))
camCenter = V3 0 0 0
camUp = V3 0 1 0
camView = lookAt camPosition camCenter camUp
camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
let draws = compactDraws meshMap materialMap renderObjects let cameraData = GPUCameraData
drawCommands = V.map { view = transpose camView
(\(i, RenderObject mesh _ _) -> , projection = transpose camProjection
Vk.DrawIndirectCommand , viewProjection = transpose $ camProjection !*! camView
{ vertexCount = fromIntegral (V.length $ meshVertices $ meshMap M.! mesh) }
, firstVertex = 0
, instanceCount = 1
, firstInstance = i
}
)
(V.zip
(V.fromList [0..])
renderObjects
)
(memRelease, memPtr) <- VMA.withMappedMemory constants = MeshPushConstants
{ meshPushData = V4 0 0 0 0
, meshRenderMatrix = transpose modelMatrix
}
mesh = meshMap M.! meshID
material = materialMap M.! materialID
liftIO $ VMA.withMappedMemory
allocator allocator
(bufferAllocation $ frameIndirectBuffer frame) (bufferAllocation $ frameCameraBuffer frame)
allocate bracket
$ \memoryPointer ->
V.mapM_ liftIO $ poke (castPtr memoryPointer) cameraData
(\(idx, command) -> liftIO $
poke
(castPtr memPtr `plusPtr` (idx * sizeOf command))
command
)
(V.zip
(V.fromList [0 ..])
drawCommands
)
release memRelease -- VMA.unmapMemory allocator (bufferAllocation $ frameCameraBuffer frame)
V.mapM_ Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
(\(IndirectBatch mesh material first count) -> do
when let uniformOffset =
(materialTextureSet material /= Vk.NULL_HANDLE) padUniformBufferSize
(Vk.cmdBindDescriptorSets (fromIntegral $ sizeOf undefinedGPUSceneData)
commandBuffer deviceProps
Vk.PIPELINE_BIND_POINT_GRAPHICS * fromIntegral frameIndex
(materialPipelineLayout material)
2
(V.singleton $ materialTextureSet material)
V.empty
)
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material) Vk.cmdBindDescriptorSets
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
0
(V.singleton $ frameGlobalDescriptor frame)
V.empty -- (V.singleton $ fromIntegral uniformOffset)
Vk.cmdBindDescriptorSets Vk.cmdBindDescriptorSets
commandBuffer commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material) (materialPipelineLayout material)
0 1
(V.singleton $ frameGlobalDescriptor frame) (V.singleton $ frameObjectDescriptor frame)
V.empty V.empty
Vk.cmdBindDescriptorSets dataPointer <- liftIO (castPtr <$> new constants)
commandBuffer
Vk.PIPELINE_BIND_POINT_GRAPHICS
(materialPipelineLayout material)
1
(V.singleton $ frameObjectDescriptor frame)
V.empty
Vk.cmdBindVertexBuffers Vk.cmdPushConstants
commandBuffer commandBuffer
0 (materialPipelineLayout material)
(V.fromList [ allocatedBuffer $ meshBuffer mesh ]) Vk.SHADER_STAGE_VERTEX_BIT
(V.fromList [ 0 ]) 0
(fromIntegral $ sizeOf constants)
dataPointer
let indirectOffset = fromIntegral $ Vk.cmdBindVertexBuffers
first * fromIntegral ( sizeOf (undefined :: Vk.DrawIndirectCommand)) commandBuffer
drawStride = fromIntegral $ sizeOf (undefined :: Vk.DrawIndirectCommand) 0
(V.fromList [ allocatedBuffer $ meshBuffer mesh ])
(V.fromList [ 0 ])
Vk.cmdDrawIndirect Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
commandBuffer )
(allocatedBuffer $ frameIndirectBuffer frame) (V.zip
indirectOffset (V.fromList [0 ..])
count renderObjects
drawStride )
)
draws
prepareRecording Vk.cmdEndRenderPass commandBuffer
:: V2 CInt
-> Vk.CommandBuffer
-> Vk.Pipeline
-> IO ()
prepareRecording (V2 width height) commandBuffer graphicsPipeline = do
Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
-- Passing negative height and nonzero y origin to the viewport flips the models back in order Vk.endCommandBuffer commandBuffer
let viewport = Vk.zero
{ Vk.x = 0
, Vk.y = fromIntegral height
, Vk.width = fromIntegral width
, Vk.height = - fromIntegral height
, Vk.minDepth = 0
, Vk.maxDepth = 1
}
scissor = Vk.Rect2D
{ Vk.offset = Vk.Offset2D
{ Vk.x = 0
, Vk.y = 0
}
, Vk.extent = Vk.Extent2D
{ Vk.width = fromIntegral width
, Vk.height = fromIntegral height
}
}
Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
pokeData
:: (MonadResource m, MonadReader ReadState m, MonadIO m)
=> FrameData
-> Int
-> GPUSceneData
-> GPUCameraData
-> m ()
pokeData frame frameNumber sceneParameters cameraParameters = do
renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
let scenePointer = VMA.mappedData (bufferInfo $ frameSceneBuffer frame)
memoryPointer = VMA.mappedData (bufferInfo $ frameCameraBuffer frame)
objectPointer = VMA.mappedData (bufferInfo $ frameObjectBuffer frame)
framed = fromIntegral frameNumber / 120
ambient = normalize $ V4 (sin framed) 0 (cos framed) 1
-- ambient = V4 1 0 1 1
ambientParams = sceneParameters
{ ambientColor = ambient
}
V.mapM_
(\(index, obj) -> do
let modelMatrix = GPUObjectData (objectMatrix obj)
liftIO $ poke
(castPtr objectPointer `plusPtr` (index * sizeOf (undefined :: GPUObjectData)))
modelMatrix
)
(V.zip
(V.fromList [0 ..])
renderObjects
)
liftIO $ do
poke
(castPtr scenePointer)
ambientParams
poke
(castPtr memoryPointer)
cameraParameters

View file

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Devices where module Devices where
import Control.Monad import Control.Monad
@ -10,7 +9,7 @@ import Control.Monad.Trans.Resource
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Maybe (fromMaybe, isNothing) import Data.Maybe (fromMaybe, isNothing)
import Data.Bits import Data.Bits
import Foreign import Data.Word (Word32)
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Linear import Linear
import qualified Vulkan as Vk import qualified Vulkan as Vk
@ -39,7 +38,7 @@ pickPhysicalDevice vkInstance = do
physDevices physDevices
let discretePhysDevices = V.filter let discretePhysDevices = V.filter
(\(_, _, devFeatures) -> (\(_, devProps, devFeatures) ->
-- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU && -- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
Vk.geometryShader devFeatures Vk.geometryShader devFeatures
) )
@ -91,7 +90,7 @@ createLogicalDevice
:: (MonadResource m) :: (MonadResource m)
=> Vk.PhysicalDevice => Vk.PhysicalDevice
-> Vk.SurfaceKHR -> Vk.SurfaceKHR
-> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR, Word32) -> m (Vk.Device, V.Vector Vk.SurfaceFormatKHR)
createLogicalDevice physDevice surface = do createLogicalDevice physDevice surface = do
graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT graphicsQueueFamily <- getQueueFamily physDevice Vk.QUEUE_GRAPHICS_BIT
@ -105,26 +104,20 @@ createLogicalDevice physDevice surface = do
deviceCreateInfo = Vk.zero deviceCreateInfo = Vk.zero
{ Vk.queueCreateInfos = V.singleton (Vk.SomeStruct queueCreateInfo) { Vk.queueCreateInfos = V.singleton (Vk.SomeStruct queueCreateInfo)
, Vk.enabledExtensionNames = extensionNames , Vk.enabledExtensionNames = extensionNames
, Vk.enabledFeatures = Just (Vk.zero
{ Vk.multiDrawIndirect = True
} :: Vk.PhysicalDeviceFeatures)
} }
shaderDrawParametersFeatures = Vk.zero
{ Vk.shaderDrawParameters = True
} :: Vk.PhysicalDeviceShaderDrawParametersFeatures
(_, logDevice) <- (_, logDevice) <- allocate
Vk.withDevice (Vk.createDevice physDevice deviceCreateInfo Nothing)
physDevice (\logDevice -> do
(deviceCreateInfo Vk.::& shaderDrawParametersFeatures Vk.:& ()) putStrLn "destroying logical device"
Nothing Vk.destroyDevice logDevice Nothing
allocate )
(result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface (result, formats) <- Vk.getPhysicalDeviceSurfaceFormatsKHR physDevice surface
unless (result == Vk.SUCCESS) $ unless (result == Vk.SUCCESS) $
error "createLogicalDevice: Failed retrieving surface image formats" error "createLogicalDevice: Failed retrieving surface image formats"
return (logDevice, formats, graphicsQueueFamily) return (logDevice, formats)
createSwapchain createSwapchain
:: (MonadResource m) :: (MonadResource m)
@ -144,9 +137,9 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
if if
V.any V.any
(\a -> (\a ->
a.format == (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) a ==
Vk.FORMAT_B8G8R8A8_SRGB Vk.FORMAT_B8G8R8A8_SRGB
&& a.colorSpace == && (Vk.colorSpace :: Vk.SurfaceFormatKHR -> Vk.ColorSpaceKHR) a ==
Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR) Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
surfaceFormats surfaceFormats
then then
@ -173,8 +166,12 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
, Vk.clipped = True , Vk.clipped = True
} }
swapchain <- snd <$> swapchain <- snd <$> allocate
Vk.withSwapchainKHR logicalDevice createInfo Nothing allocate (Vk.createSwapchainKHR logicalDevice createInfo Nothing)
(\swapchain -> do
putStrLn "destroying swapchain"
Vk.destroySwapchainKHR logicalDevice swapchain Nothing
)
let depthImageExtent = let depthImageExtent =
(\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1) (\(V2 w h) -> Vk.Extent3D (fromIntegral w) (fromIntegral h) 1)
@ -190,8 +187,12 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
, VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT , VMA.requiredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
} }
(depthImage, depthAllocation, _) <- snd <$> (depthImage, depthAllocation, _) <- snd <$> allocate
VMA.withImage allocator depthImageInfo depthImageAllocationInfo allocate (VMA.createImage allocator depthImageInfo depthImageAllocationInfo)
(\(depthImage, depthAllocation, _) -> do
putStrLn "destroying image"
VMA.destroyImage allocator depthImage depthAllocation
)
let allocatedImage = AllocatedImage depthImage depthAllocation let allocatedImage = AllocatedImage depthImage depthAllocation
depthImageView = imageviewCreate depthImageView = imageviewCreate
@ -199,8 +200,12 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
Vk.FORMAT_D32_SFLOAT Vk.FORMAT_D32_SFLOAT
Vk.IMAGE_ASPECT_DEPTH_BIT Vk.IMAGE_ASPECT_DEPTH_BIT
depthImageview <- snd <$> depthImageview <- snd <$> allocate
Vk.withImageView logicalDevice depthImageView Nothing allocate (Vk.createImageView logicalDevice depthImageView Nothing)
(\depthImageview -> do
putStrLn "destroying image view"
Vk.destroyImageView logicalDevice depthImageview Nothing
)
return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage) return (swapchain, Vk.SurfaceFormatKHR surfaceFormat colorSpace, depthImageview, allocatedImage)
@ -223,7 +228,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
let createInfo = Vk.zero let createInfo = Vk.zero
{ Vk.image = tmpImage { Vk.image = tmpImage
, Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D , Vk.viewType = Vk.IMAGE_VIEW_TYPE_2D
, Vk.format = surfaceFormat.format , Vk.format = (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) surfaceFormat
, Vk.components = Vk.ComponentMapping , Vk.components = Vk.ComponentMapping
{ Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY { Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY
, Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY , Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY
@ -238,7 +243,11 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
, layerCount = 1 , layerCount = 1
} }
} }
snd <$> snd <$> allocate
Vk.withImageView logicalDevice createInfo Nothing allocate (Vk.createImageView logicalDevice createInfo Nothing)
(\imageView -> do
putStrLn "destroying image view"
Vk.destroyImageView logicalDevice imageView Nothing
)
) )
handles handles

View file

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Draw where module Draw where
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
@ -11,7 +10,6 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Vector as V import qualified Data.Vector as V
import Linear
import qualified Vulkan.Core10 as Vk import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
import qualified Vulkan.CStruct.Extends as Vk import qualified Vulkan.CStruct.Extends as Vk
@ -50,44 +48,26 @@ drawFrame engineData frameNumber = do
unless (imageResult == Vk.SUCCESS) $ unless (imageResult == Vk.SUCCESS) $
error "drawFrame: Failed acquiring next image from swapchain" error "drawFrame: Failed acquiring next image from swapchain"
-- liftIO $ putStrLn "resetting command buffer"
Vk.resetCommandBuffer Vk.resetCommandBuffer
(frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0) (frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0)
matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary
let (V2 width height) = engineWindowDimensions engineData -- liftIO $ putStrLn "recording command buffer"
camPosition = V3
(-10 * sin (fromIntegral frameNumber / 90))
2
(-10 * cos (fromIntegral frameNumber / 90))
camCenter = V3 0 0 0
camUp = V3 0 1 0
camView = lookAt camPosition camCenter camUp
camProjection = perspective
(pi/4)
(fromIntegral width / fromIntegral height)
0.1
200
cameraData = GPUCameraData
{ view = camView
, projection = camProjection
, viewProjection = camProjection !*! camView
}
pokeData
frame
frameNumber
(engineSceneParameters engineData)
cameraData
recordCommandBuffer recordCommandBuffer
(engineData.engineAllocator)
(frameMainCommandBuffer frame) (frameMainCommandBuffer frame)
(engineRenderPass engineData) (engineRenderPass engineData)
(engineFramebuffers engineData V.! fromIntegral index) (engineFramebuffers engineData V.! fromIntegral index)
(engineWindowDimensions engineData) (engineWindowDimensions engineData)
(materialPipeline $ matLibrary M.! "defaultMesh") (materialPipeline $ matLibrary M.! "defaultMesh")
(meshPipelineLayout engineData)
(engineAllocator engineData)
(engineSceneParameters engineData)
(engineSceneParameterBuffer engineData)
(enginePhysicalDeviceProperties engineData)
frame frame
frameNumber
let submitInfo = Vk.zero let submitInfo = Vk.zero
{ Vk.waitSemaphores = { Vk.waitSemaphores =
@ -100,6 +80,7 @@ drawFrame engineData frameNumber = do
V.singleton $ framePresentSemaphore frame V.singleton $ framePresentSemaphore frame
} }
-- liftIO $ putStrLn "submitting to queue"
Vk.queueSubmit Vk.queueSubmit
(engineQueue engineData) (engineQueue engineData)
(V.singleton (Vk.SomeStruct submitInfo)) (V.singleton (Vk.SomeStruct submitInfo))
@ -111,6 +92,7 @@ drawFrame engineData frameNumber = do
, Khr.imageIndices = V.singleton index , Khr.imageIndices = V.singleton index
} }
-- liftIO $ putStrLn "presenting queue"
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
unless (presentResult == Vk.SUCCESS) $ unless (presentResult == Vk.SUCCESS) $

View file

@ -39,6 +39,11 @@ createFramebuffer
let createInfo = framebufferCreateInfo let createInfo = framebufferCreateInfo
{ Vk.attachments = V.fromList [ imageView, depthImageView ] { Vk.attachments = V.fromList [ imageView, depthImageView ]
} :: Vk.FramebufferCreateInfo '[] } :: Vk.FramebufferCreateInfo '[]
snd <$> Vk.withFramebuffer logicalDevice createInfo Nothing allocate snd <$> allocate
(Vk.createFramebuffer logicalDevice createInfo Nothing)
(\framebuffer -> do
putStrLn "destroying framebuffer"
Vk.destroyFramebuffer logicalDevice framebuffer Nothing
)
) )
swapchainImageViews swapchainImageViews

View file

@ -49,8 +49,12 @@ loadShader logicalDevice shaderPath stage = do
{ Vk.code = shader { Vk.code = shader
} }
snd <$> snd <$> allocate
Vk.withShaderModule logicalDevice createInfo Nothing allocate (Vk.createShaderModule logicalDevice createInfo Nothing)
(\shaderModule -> do
putStrLn "destroying shader module"
Vk.destroyShaderModule logicalDevice shaderModule Nothing
)
createRenderPass createRenderPass
:: (MonadResource m) :: (MonadResource m)
@ -122,8 +126,12 @@ createRenderPass
, Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ] , Vk.dependencies = V.fromList [ subpassDependency, subpassDepthDependency ]
} :: Vk.RenderPassCreateInfo '[] } :: Vk.RenderPassCreateInfo '[]
snd <$> snd <$> allocate
Vk.withRenderPass logicalDevice renderPassCreateInfo Nothing allocate (Vk.createRenderPass logicalDevice renderPassCreateInfo Nothing)
(\renderPass -> do
putStrLn "destroying render pass"
Vk.destroyRenderPass logicalDevice renderPass Nothing
)
createShaderStageCreateInfo createShaderStageCreateInfo
:: Vk.ShaderStageFlagBits :: Vk.ShaderStageFlagBits
@ -194,7 +202,6 @@ createGraphicsPipelines
-> V2 CInt -> V2 CInt
-> Vk.PipelineLayout -> Vk.PipelineLayout
-> Maybe Vk.PipelineDepthStencilStateCreateInfo -> Maybe Vk.PipelineDepthStencilStateCreateInfo
-> String
-> m () -> m ()
createGraphicsPipelines createGraphicsPipelines
logicalDevice logicalDevice
@ -203,7 +210,6 @@ createGraphicsPipelines
(V2 width height) (V2 width height)
pipelineLayout pipelineLayout
depthState depthState
materialName
= do = do
meshLib <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary meshLib <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
let pipelineStagesCreateInfos = let pipelineStagesCreateInfos =
@ -294,22 +300,29 @@ createGraphicsPipelines
, Vk.basePipelineIndex = -1 , Vk.basePipelineIndex = -1
} }
pipeline <- pipeline <- snd <$> allocate
(do (do
(result, pipelines) <- snd <$> Vk.withGraphicsPipelines (result, pipelines) <- Vk.createGraphicsPipelines
logicalDevice logicalDevice
Vk.NULL_HANDLE Vk.NULL_HANDLE
(V.singleton (Vk.SomeStruct pipelineCreateInfo)) (V.singleton (Vk.SomeStruct pipelineCreateInfo))
Nothing Nothing
allocate
unless (result == Vk.SUCCESS) $ unless (result == Vk.SUCCESS) $
error "createGraphicsPipelines: Failed creating pipelines" error "createGraphicsPipelines: Failed creating pipelines"
return pipelines return pipelines
) )
let material = Material Vk.NULL_HANDLE (V.head pipeline) pipelineLayout (\pipelines -> do
V.mapM_
(\pipeline -> do
putStrLn "destroying pipeline"
Vk.destroyPipeline logicalDevice pipeline Nothing
)
pipelines
)
let material = Material (V.head pipeline) pipelineLayout
matLibraryTMVar <- asks materialLibrary matLibraryTMVar <- asks materialLibrary
matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryTMVar
let newMatLibrary = M.insert materialName material matLibrary let newMatLibrary = M.insert "defaultMesh" material matLibrary
void $ liftIO $ STM.atomically $ STM.swapTMVar matLibraryTMVar newMatLibrary void $ liftIO $ STM.atomically $ STM.swapTMVar matLibraryTMVar newMatLibrary
createMeshPipelineLayout createMeshPipelineLayout
@ -320,7 +333,7 @@ createMeshPipelineLayout
createMeshPipelineLayout logicalDevice layouts = do createMeshPipelineLayout logicalDevice layouts = do
let pushConstantRange = Vk.zero let pushConstantRange = Vk.zero
{ Vk.offset = 0 { Vk.offset = 0
, Vk.size = fromIntegral (sizeOf undefinedMeshPushConstants) , Vk.size = fromIntegral (sizeOf (undefinedMeshPushConstants))
, Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
} }
pipelineLayoutCreateInfo = Vk.zero pipelineLayoutCreateInfo = Vk.zero
@ -328,5 +341,9 @@ createMeshPipelineLayout logicalDevice layouts = do
, Vk.setLayouts = layouts , Vk.setLayouts = layouts
} }
snd <$> snd <$> allocate
Vk.withPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing allocate (Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
(\pipelineLayout -> do
putStrLn "destroying pipeline layout"
Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
)

View file

@ -10,16 +10,15 @@ import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Bits import Data.Bits ((.|.))
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Vector as V 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 Foreign (sizeOf)
import Foreign.Ptr import Foreign.Ptr
import Linear as L import Linear as L
import qualified Vulkan as Vk import qualified VulkanMemoryAllocator as VMA
import qualified Vulkan.CStruct.Extends as Vk import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
import qualified Vulkan.Extensions.VK_KHR_surface as Khr import qualified Vulkan.Extensions.VK_KHR_surface as Khr
import qualified Vulkan.Zero as Vk import qualified Vulkan.Zero as Vk
@ -34,8 +33,6 @@ import Memory
import Types import Types
import Mesh import Mesh
import CommandBuffer import CommandBuffer
import Sync
import Textures
import Util import Util
initEngine initEngine
@ -93,13 +90,9 @@ initVulkan window = do
) )
vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
(vulkanLogicalDevice, surfaceFormats, queueIndex) <- (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
createLogicalDevice vulkanPhysicalDevice vulkanSurface
uploadContext <- initSyncStructures vulkanLogicalDevice queueIndex (descriptorSetLayout1, descriptorSetLayout2, descriptorPool) <- initDescriptors vulkanLogicalDevice
(descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool) <-
initDescriptors vulkanLogicalDevice
allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance
@ -107,28 +100,17 @@ initVulkan window = do
(swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <- (swapchain, surfaceFormat, depthImageView, depthAllocatedImage) <-
createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice allocator
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/tri_mesh.vert" "vert" meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag" meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag"
textureFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/textured_lit.frag" "frag"
renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT
meshLayout <- createMeshPipelineLayout meshLayout <- createMeshPipelineLayout
vulkanLogicalDevice vulkanLogicalDevice
(V.fromList (V.fromList
[ descriptorSetLayout1 [ descriptorSetLayout1
, descriptorSetLayout2 , descriptorSetLayout2
, textureDescriptorSetLayout
]
)
textureLayout <- createMeshPipelineLayout
vulkanLogicalDevice
(V.fromList
[ descriptorSetLayout1
, descriptorSetLayout2
, textureDescriptorSetLayout
] ]
) )
let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader) let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
textureContainer = ShaderContainer (Just meshVertexShader) (Just textureFragmentShader)
createGraphicsPipelines createGraphicsPipelines
vulkanLogicalDevice vulkanLogicalDevice
renderPass renderPass
@ -136,34 +118,16 @@ initVulkan window = do
dimensions dimensions
meshLayout meshLayout
(Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL)) (Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
"defaultMesh"
createGraphicsPipelines
vulkanLogicalDevice
renderPass
textureContainer
dimensions
textureLayout
(Just (createDepthStencilStateCreateInfo True True Vk.COMPARE_OP_LESS_OR_EQUAL))
"texturedMesh"
frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions
(frames, queue) <- (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice allocator descriptorPool descriptorSetLayout1 descriptorSetLayout2
createFrames
vulkanLogicalDevice
allocator
descriptorPool
descriptorSetLayout1
descriptorSetLayout2
queueIndex
loadMeshes allocator uploadContext queue vulkanLogicalDevice loadMeshes allocator
loadImages allocator uploadContext queue vulkanLogicalDevice initScene
initScene vulkanLogicalDevice descriptorPool textureDescriptorSetLayout EngineData
return $ EngineData
window window
dimensions dimensions
vulkanPhysicalDevice vulkanPhysicalDevice
@ -172,6 +136,7 @@ initVulkan window = do
swapchain swapchain
queue queue
frameBuffers frameBuffers
meshLayout
renderPass renderPass
allocator allocator
depthImageView depthImageView
@ -180,28 +145,27 @@ initVulkan window = do
frames frames
descriptorSetLayout1 descriptorSetLayout1
descriptorSetLayout2 descriptorSetLayout2
textureDescriptorSetLayout
descriptorPool descriptorPool
(GPUSceneData <$> Vk.getPhysicalDeviceProperties vulkanPhysicalDevice
<*> pure (GPUSceneData
(V4 0 0 0 0) (V4 0 0 0 0)
(V4 0 0 0 0) (V4 0 0 0 0)
(V4 0 0 0 0) (V4 0 0 0 0)
(V4 0 0 0 0) (V4 0 0 0 0)
(V4 0 0 0 0) (V4 0 0 0 0)
) )
uploadContext <*> createAllocatedBuffer
allocator
(sizeOf undefinedGPUSceneData * frameOverlap)
Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
VMA.MEMORY_USAGE_GPU_ONLY
initScene initScene :: (MonadReader ReadState m, MonadIO m) => m ()
:: (MonadReader ReadState m, MonadIO m, MonadResource m) initScene = do
=> Vk.Device let mask = RenderObject
-> Vk.DescriptorPool
-> Vk.DescriptorSetLayout
-> m ()
initScene device descriptorPool texturedSetLayout = do
let catMask = RenderObject
{ objectMesh = "mask" { objectMesh = "mask"
, objectMaterial = "texturedMesh" , objectMaterial = "defaultMesh"
, objectMatrix = identity , objectMatrix = identity
} }
triangles = V.concatMap triangles = V.concatMap
@ -226,53 +190,12 @@ initScene device descriptorPool texturedSetLayout = do
renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer renderableVector <- liftIO $ STM.atomically $ STM.readTMVar renderableContainer
void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $ void $ liftIO $ STM.atomically $ STM.swapTMVar renderableContainer $
(renderableVector `V.snoc` catMask) V.++ triangles (renderableVector `V.snoc` mask) V.++ triangles
let samplerInfo = samplerCreateInfo Vk.FILTER_NEAREST Vk.SAMPLER_ADDRESS_MODE_REPEAT
blockySampler <- snd <$> Vk.withSampler device samplerInfo Nothing allocate
matLibraryContainer <- asks materialLibrary
texturedMaterial <- do
matLibrary <- liftIO $ STM.atomically $ STM.readTMVar matLibraryContainer
return (fromMaybe (error "not texturedMesh") $ matLibrary M.!? "texturedMesh")
let allocInfo = Vk.zero
{ Vk.descriptorPool = descriptorPool
, Vk.setLayouts = V.singleton texturedSetLayout
}
texturedDescriptorSet <- V.head . snd <$> Vk.withDescriptorSets device allocInfo allocate
liftIO $ do
matLibrary <- STM.atomically $ STM.readTMVar matLibraryContainer
let material = texturedMaterial
{ materialTextureSet = texturedDescriptorSet
}
newMatLibrary = M.insert "texturedMesh" material matLibrary
void $ STM.atomically $ STM.swapTMVar matLibraryContainer newMatLibrary
textureContainer <- asks textureLibrary
texture <- do
texLibrary <- liftIO $ STM.atomically $ STM.readTMVar textureContainer
return $ fromMaybe (error "no marksman texture found") $ texLibrary M.!? "marksman"
let imageBufferInfo = Vk.zero
{ Vk.sampler = blockySampler
, Vk.imageView = textureImageView texture
, Vk.imageLayout = Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
}
texture1 = V.singleton $ Vk.SomeStruct $ writeDescriptorImage
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
texturedDescriptorSet
imageBufferInfo
0
Vk.updateDescriptorSets device texture1 V.empty
initDescriptors initDescriptors
:: (MonadResource m) :: (MonadResource m)
=> Vk.Device => Vk.Device
-> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool) -> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool)
initDescriptors device = do initDescriptors device = do
let cameraBind = descriptorsetLayoutBinding let cameraBind = descriptorsetLayoutBinding
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
@ -286,10 +209,6 @@ initDescriptors device = do
Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
Vk.SHADER_STAGE_VERTEX_BIT Vk.SHADER_STAGE_VERTEX_BIT
0 0
textureBind = descriptorsetLayoutBinding
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
Vk.SHADER_STAGE_FRAGMENT_BIT
0
setInfo = Vk.zero setInfo = Vk.zero
{ Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
, Vk.bindings = V.fromList , Vk.bindings = V.fromList
@ -301,14 +220,8 @@ initDescriptors device = do
{ Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
, Vk.bindings = V.singleton objectBind , Vk.bindings = V.singleton objectBind
} }
setInfo3 = Vk.zero
{ Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
, Vk.bindings = V.singleton textureBind
}
poolInfo = Vk.zero poolInfo = Vk.zero
{ Vk.flags = { Vk.flags = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT .|.
Vk.DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT
, Vk.maxSets = 10 , Vk.maxSets = 10
, Vk.poolSizes = V.fromList , Vk.poolSizes = V.fromList
[ Vk.zero [ Vk.zero
@ -316,30 +229,35 @@ initDescriptors device = do
, Vk.descriptorCount = 10 , Vk.descriptorCount = 10
} }
, Vk.zero , Vk.zero
{ Vk.type' = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC { Vk.type' = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- _DYNAMIC
, Vk.descriptorCount = 10 , Vk.descriptorCount = 10
} }
, Vk.zero , Vk.zero
{ Vk.type' = Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER { Vk.type' = Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
, Vk.descriptorCount = 10 , Vk.descriptorCount = 10
} }
, Vk.zero
{ Vk.type' = Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
, Vk.descriptorCount = 10
}
] ]
} }
(_, descriptorSetLayout1) <- (_, descriptorSetLayout1) <- allocate
Vk.withDescriptorSetLayout device setInfo Nothing allocate (Vk.createDescriptorSetLayout device setInfo Nothing)
(\descriptorLayout -> do
putStrLn "destroying descriptor layout"
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
)
(_, descriptorSetLayout2) <- (_, descriptorSetLayout2) <- allocate
Vk.withDescriptorSetLayout device setInfo2 Nothing allocate (Vk.createDescriptorSetLayout device setInfo2 Nothing)
(\descriptorLayout -> do
putStrLn "destroying descriptor layout"
Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
)
(_, textureDescriptorSetLayout) <- (_, descriptorPool) <- allocate
Vk.withDescriptorSetLayout device setInfo3 Nothing allocate (Vk.createDescriptorPool device poolInfo Nothing)
(\descriptorPoolInfo -> do
putStrLn "destroying descriptor pool"
Vk.destroyDescriptorPool device descriptorPoolInfo Nothing
)
(_, descriptorPool) <- return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)
Vk.withDescriptorPool device poolInfo Nothing allocate
return (descriptorSetLayout1, descriptorSetLayout2, textureDescriptorSetLayout, descriptorPool)

View file

@ -32,6 +32,11 @@ createInstance window = do
, Vk.enabledLayerNames = V.singleton "VK_LAYER_KHRONOS_validation" , Vk.enabledLayerNames = V.singleton "VK_LAYER_KHRONOS_validation"
} }
(_, inst) <- Vk.withInstance createInfo Nothing allocate (_, inst) <- allocate
(Vk.createInstance createInfo Nothing)
(\inst -> do
putStrLn "destroying instance"
Vk.destroyInstance inst Nothing
)
return inst return inst

View file

@ -1,8 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Main where module Main where
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
@ -11,13 +9,10 @@ import Control.Monad.Loops
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Bits import Data.Bits
import Data.ByteString.Char8
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Time.Clock
import qualified Data.Vector as V import qualified Data.Vector as V
import Data.Word
import qualified SDL hiding (V2) import qualified SDL hiding (V2)
import System.IO (stdout)
import System.Mem
import qualified Vulkan as Vk import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk import qualified Vulkan.Zero as Vk
@ -32,13 +27,11 @@ main = do
renderablesContainer <- STM.newTMVarIO (V.empty) renderablesContainer <- STM.newTMVarIO (V.empty)
meshMap <- STM.newTMVarIO (M.empty) meshMap <- STM.newTMVarIO (M.empty)
materialMap <- STM.newTMVarIO (M.empty) materialMap <- STM.newTMVarIO (M.empty)
textureMap <- STM.newTMVarIO (M.empty)
frameNumber <- STM.newTMVarIO 0 frameNumber <- STM.newTMVarIO 0
let initState = ReadState let initState = ReadState
{ renderables = renderablesContainer { renderables = renderablesContainer
, meshLibrary = meshMap , meshLibrary = meshMap
, materialLibrary = materialMap , materialLibrary = materialMap
, textureLibrary = textureMap
} }
runRender initState $ do runRender initState $ do
engineData <- initEngine engineData <- initEngine
@ -47,33 +40,17 @@ main = do
-- create abort condition for upcoming lop -- create abort condition for upcoming lop
quit <- liftIO $ STM.newTMVarIO True quit <- liftIO $ STM.newTMVarIO True
time <- liftIO $ STM.newTMVarIO =<< getCurrentTime
average <- liftIO $ STM.newTMVarIO 0
-- main loop -- main loop
whileM_ whileM_
(liftIO $ STM.atomically $ STM.readTMVar quit (liftIO $ STM.atomically $ STM.readTMVar quit
) )
( do ( do
liftIO performMajorGC
now <- liftIO getCurrentTime
before <- liftIO $ STM.atomically $ STM.swapTMVar time now
let timeDiff = diffUTCTime now before
fps = recip $ nominalDiffTimeToSeconds timeDiff
liftIO $ hPutStr stdout $ pack $ "Current FPS: " <> show (floor fps) <> " \r"
number <- liftIO $ STM.atomically $ do number <- liftIO $ STM.atomically $ do
number <- STM.readTMVar frameNumber number <- STM.readTMVar frameNumber
if number == 0 then
void $ STM.swapTMVar average fps
else do
oldAverage <- STM.readTMVar average
let newAverage = (oldAverage * fromIntegral number + fps) / frameCount
frameCount = fromIntegral number + 1
void $ STM.swapTMVar average newAverage
void $ STM.swapTMVar frameNumber (succ number) void $ STM.swapTMVar frameNumber (succ number)
return number return number
-- draw -- draw
-- liftIO $ putStr $ show (recip $ nominalDiffTimeToSeconds timeDiff) <> "\r"
drawFrame engineData number drawFrame engineData number
-- poll events -- poll events
evs <- liftIO SDL.pollEvents evs <- liftIO SDL.pollEvents
@ -87,12 +64,6 @@ main = do
evs evs
) )
fps <- liftIO $ STM.atomically $ STM.readTMVar average
liftIO $ hPutStr stdout $
"\n" <>
"Average FPS: " <> pack (show fps) <> "\n"
Vk.deviceWaitIdle $ engineLogicalDevice engineData Vk.deviceWaitIdle $ engineLogicalDevice engineData
createBufferView createBufferView
@ -107,8 +78,12 @@ createBufferView logicalDevice = do
Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT Vk.BUFFER_USAGE_UNIFORM_TEXEL_BUFFER_BIT
, Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE , Vk.sharingMode = Vk.SHARING_MODE_EXCLUSIVE
} }
buffer <- snd <$> buffer <- snd <$> allocate
(Vk.withBuffer logicalDevice bufferCreateInfo Nothing allocate) (Vk.createBuffer logicalDevice bufferCreateInfo Nothing)
(\buffer -> do
putStrLn "destroying buffer"
Vk.destroyBuffer logicalDevice buffer Nothing
)
let bufferViewCreateInfo = Vk.zero let bufferViewCreateInfo = Vk.zero
{ Vk.buffer = buffer { Vk.buffer = buffer
@ -117,7 +92,12 @@ createBufferView logicalDevice = do
, Vk.range = Vk.WHOLE_SIZE , Vk.range = Vk.WHOLE_SIZE
} }
Vk.withBufferView logicalDevice bufferViewCreateInfo Nothing allocate allocate
(Vk.createBufferView logicalDevice bufferViewCreateInfo Nothing)
(\bufferView -> do
putStrLn "destroying bufferView"
Vk.destroyBufferView logicalDevice bufferView Nothing
)
allocateMemory allocateMemory
:: (MonadResource m) :: (MonadResource m)
@ -128,8 +108,13 @@ allocateMemory logicalDevice buffer = do
memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer
let memoryAllocateInfo = Vk.zero let memoryAllocateInfo = Vk.zero
{ Vk.allocationSize = memoryRequirements.size { Vk.allocationSize = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements
, Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String) , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
} }
Vk.withMemory logicalDevice memoryAllocateInfo Nothing allocate allocate
(Vk.allocateMemory logicalDevice memoryAllocateInfo Nothing)
(\memory -> do
putStrLn "Freeing memory"
Vk.freeMemory logicalDevice memory Nothing
)

View file

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Memory where module Memory where
import Control.Monad.IO.Class import Control.Monad.IO.Class
@ -28,9 +27,9 @@ initAllocator
-> m VMA.Allocator -> m VMA.Allocator
initAllocator physicalDevice device instance' = do initAllocator physicalDevice device instance' = do
let instanceProcAddr = castFunPtr $ let instanceProcAddr = castFunPtr $
Vk.pVkGetInstanceProcAddr (instance'.instanceCmds) Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
deviceProcAddr = castFunPtr $ deviceProcAddr = castFunPtr $
Vk.pVkGetDeviceProcAddr (device.deviceCmds) Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
let allocatorInfo = Vk.zero let allocatorInfo = Vk.zero
{ VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice { VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice
, VMA.device = Vk.deviceHandle device , VMA.device = Vk.deviceHandle device
@ -41,7 +40,12 @@ initAllocator physicalDevice device instance' = do
} :: VMA.VulkanFunctions) } :: VMA.VulkanFunctions)
} :: VMA.AllocatorCreateInfo } :: VMA.AllocatorCreateInfo
(_, allocator) <- VMA.withAllocator allocatorInfo allocate (_, allocator) <- allocate
(VMA.createAllocator allocatorInfo)
(\allocator -> do
putStrLn "destroying allocator"
VMA.destroyAllocator allocator
)
return allocator return allocator
@ -53,7 +57,7 @@ createAllocatedBuffer
-> VMA.MemoryUsage -> VMA.MemoryUsage
-> m AllocatedBuffer -> m AllocatedBuffer
createAllocatedBuffer allocator allocationSize usage memoryUsage = do createAllocatedBuffer allocator allocationSize usage memoryUsage = do
let bufferCreateInfo = Vk.zero let bufferInfo = Vk.zero
{ Vk.size = fromIntegral allocationSize { Vk.size = fromIntegral allocationSize
, Vk.usage = usage , Vk.usage = usage
} }
@ -64,7 +68,11 @@ createAllocatedBuffer allocator allocationSize usage memoryUsage = do
, VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT , VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
} :: VMA.AllocationCreateInfo } :: VMA.AllocationCreateInfo
(_, (buffer, newAllocation, info)) <- (_, (buffer, newAllocation, info)) <- allocate
VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate (VMA.createBuffer allocator bufferInfo vmaAllocationInfo)
(\(buffer, newAllocation, _) -> do
putStrLn "destroying buffer"
VMA.destroyBuffer allocator buffer newAllocation
)
return $ AllocatedBuffer buffer newAllocation info return $ AllocatedBuffer buffer newAllocation info

View file

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Mesh where module Mesh where
import Codec.Wavefront import Codec.Wavefront
@ -9,16 +8,15 @@ import Codec.Wavefront
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
import qualified Control.Monad as CM (void) import qualified Control.Monad as CM (void)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader (asks)
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import qualified Data.Vector as V import qualified Data.Vector as V
import Foreign import Foreign
import Linear (V2(..), V3(..), V4(..)) import Linear (V3(..), V4(..))
import qualified VulkanMemoryAllocator as VMA import qualified VulkanMemoryAllocator as VMA
import qualified Vulkan.Core10 as Vk import qualified Vulkan.Core10 as Vk
@ -27,29 +25,19 @@ import qualified Vulkan.Zero as Vk
-- internal imports -- internal imports
import Types import Types
import Sync
loadMeshes loadMeshes
:: (MonadReader ReadState m, MonadResource m, MonadFail m) :: VMA.Allocator
=> VMA.Allocator -> Render ()
-> UploadContext loadMeshes allocator = do
-> Vk.Queue
-> Vk.Device
-> m ()
loadMeshes allocator uploadContext queue device = do
let triangle = V.fromList let triangle = V.fromList
[ Vertex (V3 0.5 0 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0) [ Vertex (V3 0.5 0.5 0) (V3 0 0 0) (V4 0 1 0 1)
, Vertex (V3 (-0.5) 0 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0) , Vertex (V3 (-0.5) 0.5 0) (V3 0 0 0) (V4 0 1 0 1)
, Vertex (V3 0 1 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0) , Vertex (V3 0 (-0.5) 0) (V3 0 0 0) (V4 0 1 0 1)
] ]
triMesh <- uploadMesh triangle allocator uploadContext queue device triMesh <- uploadMesh triangle allocator
maskMesh <- loadFromObj maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator
"./assets/models/jaeger.obj"
allocator
uploadContext
queue
device
meshLib <- asks meshLibrary meshLib <- asks meshLibrary
@ -64,75 +52,38 @@ uploadMesh
:: (MonadResource m, MonadFail m) :: (MonadResource m, MonadFail m)
=> V.Vector Vertex => V.Vector Vertex
-> VMA.Allocator -> VMA.Allocator
-> UploadContext
-> Vk.Queue
-> Vk.Device
-> m Mesh -> m Mesh
uploadMesh vertices allocator uploadContext queue device = do uploadMesh vertices allocator = do
let bufferCreateInfo = Vk.zero
let bufferSize = fromIntegral $ V.length vertices * sizeOf (undefined :: Vertex) { Vk.size = fromIntegral $
stagingBufferCrateInfo = Vk.zero V.length vertices * sizeOf (Vertex (V3 0 0 0) (V3 0 0 0 ) (V4 0 0 0 0))
{ Vk.size = bufferSize , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
, Vk.usage = Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
}
stagingAllocationCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_CPU_ONLY
} :: VMA.AllocationCreateInfo
(stagingReleaseKey, stagingBuffer) <- do
(releaseKey, (buffer, bAllocation, bInfo)) <-
VMA.withBuffer allocator stagingBufferCrateInfo stagingAllocationCreateInfo allocate
return (releaseKey, AllocatedBuffer
{ bufferInfo = bInfo
, bufferAllocation = bAllocation
, allocatedBuffer = buffer
})
(dataReleaseKey, dataPtr) <-
VMA.withMappedMemory allocator (bufferAllocation stagingBuffer) allocate
liftIO $ V.mapM_ (\(idx, vertex) ->
poke
(castPtr dataPtr `plusPtr` (idx * sizeOf vertex))
vertex
)
(V.zip
(V.fromList [0..])
vertices
)
liftIO $ release dataReleaseKey
let vertexBufferCreateInfo = Vk.zero
{ Vk.size = bufferSize
, Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT .|. Vk.BUFFER_USAGE_TRANSFER_DST_BIT
} }
allocationCreateInfo = Vk.zero allocationCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY { VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
} :: VMA.AllocationCreateInfo } :: VMA.AllocationCreateInfo
(_, mesh) <- allocate
(do
(buffer, bAllocation, bInfo) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
)
(\(Mesh _ (AllocatedBuffer buffer bAllocation bInfo)) -> do
putStrLn "destroying mesh"
VMA.destroyBuffer allocator buffer bAllocation
)
mesh <- do (dataReleaseKey, dataPtr) <- allocate
(buffer, bAllocation, bInfo) <- snd <$> (VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
VMA.withBuffer allocator vertexBufferCreateInfo allocationCreateInfo allocate (\_ -> do
return $ Mesh VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh)
{ meshVertices = vertices )
, meshBuffer = AllocatedBuffer
{ bufferInfo = bInfo
, bufferAllocation = bAllocation
, allocatedBuffer = buffer
}
}
immediateSubmit uploadContext queue device$ \cmd -> do liftIO $ mapM_ (\(idx, vertex) ->
let copy = V.singleton $ Vk.BufferCopy poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex
{ size = bufferSize )
, dstOffset = 0 (zip [0..] (V.toList vertices))
, srcOffset = 0
}
Vk.cmdCopyBuffer cmd (allocatedBuffer stagingBuffer) (allocatedBuffer $ meshBuffer mesh) copy release dataReleaseKey
release stagingReleaseKey
return mesh return mesh
@ -140,22 +91,18 @@ loadFromObj
:: (MonadResource m, MonadFail m) :: (MonadResource m, MonadFail m)
=> FilePath => FilePath
-> VMA.Allocator -> VMA.Allocator
-> UploadContext
-> Vk.Queue
-> Vk.Device
-> m Mesh -> m Mesh
loadFromObj filepath vma uploadContext queue device = do loadFromObj filepath vma = do
eitherObj <- liftIO $ fromFile filepath eitherObj <- liftIO $ fromFile filepath
case eitherObj of case eitherObj of
Left err -> Left err ->
error ("loadFromObj: loading mesh data: " <> err) error ("loadFromObj: loading mesh data: " <> err)
Right obj -> do Right obj -> do
let vertices = digestFaces (objFaces obj) (objLocations obj) (objTexCoords obj) let vertices = digestFaces (objFaces obj) (objLocations obj)
uploadMesh vertices vma uploadContext queue device uploadMesh vertices vma
where where
digestFaces digestFaces :: V.Vector (Element Face) -> V.Vector Location -> V.Vector Vertex
:: V.Vector (Element Face) -> V.Vector Location -> V.Vector TexCoord -> V.Vector Vertex digestFaces faces locations =
digestFaces faces locations texCoords =
V.foldl V.foldl
(\acc (Element _ _ _ _ (Face fa fb fc others)) -> (\acc (Element _ _ _ _ (Face fa fb fc others)) ->
if not (null others) if not (null others)
@ -167,9 +114,8 @@ loadFromObj filepath vma uploadContext queue device = do
let position = faceIndexToPosition faceIndex locations let position = faceIndexToPosition faceIndex locations
normal = V3 0 0 0 normal = V3 0 0 0
color = V4 1 1 0 1 color = V4 1 1 0 1
uv = faceIndexToUV faceIndex texCoords
in in
Vertex position normal color uv Vertex position normal color
) )
(V.fromList [ fa, fb, fc ]) (V.fromList [ fa, fb, fc ])
in in
@ -182,45 +128,3 @@ loadFromObj filepath vma uploadContext queue device = do
let Location x y z _ = locations V.! (faceLocIndex index - 1) let Location x y z _ = locations V.! (faceLocIndex index - 1)
in in
V3 x y z V3 x y z
faceIndexToUV :: FaceIndex -> V.Vector TexCoord -> V2 Float
faceIndexToUV index texCoords =
let TexCoord r s _ =
texCoords V.!
(fromMaybe (error "no UV coordinates present") (faceTexCoordIndex index) - 1)
in
-- flip V coordinate of UVs to fix display
V2 r (-s)
compactDraws
:: M.Map String Mesh
-> M.Map String Material
-> V.Vector RenderObject
-> V.Vector IndirectBatch
compactDraws meshLib materialLib objects =
V.foldl
(\acc (index, RenderObject mesh material _) ->
let newDraw = IndirectBatch
{ batchMesh = meshLib M.! mesh
, batchMaterial = materialLib M.! material
, batchFirst = index
, batchCount = 1
}
sameMesh = not (V.null acc) && (meshLib M.! mesh == batchMesh (V.last acc))
sameMaterial = not (V.null acc) && (materialLib M.! material == batchMaterial (V.last acc))
in
if sameMesh && sameMaterial
then
V.init acc `V.snoc` ((V.last acc)
{ batchCount = batchCount (V.last acc) + 1
})
else
acc `V.snoc` newDraw
)
V.empty
(V.zip
(V.fromList [0..])
objects
)

View file

@ -1,75 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Sync where
import Control.Monad.Trans.Resource
import Data.Bits (bit)
import qualified Data.Vector as V
import Data.Word
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk
-- internal imports
import Control.Monad.Reader
import Types
import Util
initSyncStructures
:: (MonadResource m)
=> Vk.Device
-> Word32
-> m UploadContext
initSyncStructures logicalDevice queueFamilyIndex = do
let fenceCreateInfo = Vk.zero
syncFence <- snd <$>
Vk.withFence logicalDevice fenceCreateInfo Nothing allocate
let uploadCommandPoolCreateInfo = Vk.zero
{ Vk.queueFamilyIndex = queueFamilyIndex
} :: Vk.CommandPoolCreateInfo
syncCommandPool <- snd <$>
Vk.withCommandPool logicalDevice uploadCommandPoolCreateInfo Nothing allocate
let cmdBufAllocInfo = Vk.zero
{ Vk.commandPool = syncCommandPool
, Vk.commandBufferCount = 1
}
syncCommandBuffer <- V.head . snd <$> Vk.withCommandBuffers logicalDevice cmdBufAllocInfo allocate
return $ UploadContext
{ uploadFence = syncFence
, uploadCommandBuffer = syncCommandBuffer
, uploadCommandPool = syncCommandPool
}
immediateSubmit
:: (MonadIO m)
=> UploadContext
-> Vk.Queue
-> Vk.Device
-> (Vk.CommandBuffer -> m ())
-> m ()
immediateSubmit uploadContext queue device func = do
let cmdBegin = beginCommandBuffer Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT
Vk.useCommandBuffer
(uploadCommandBuffer uploadContext)
cmdBegin
(func (uploadCommandBuffer uploadContext))
let submitInfo = createSubmitInfo (uploadCommandBuffer uploadContext)
Vk.queueSubmit queue submitInfo (uploadFence uploadContext)
void $ Vk.waitForFences device (V.singleton $ uploadFence uploadContext) True maxBound
Vk.resetFences device (V.singleton $ uploadFence uploadContext)
Vk.resetCommandPool device (uploadCommandPool uploadContext) (bit 0)

View file

@ -1,173 +0,0 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Textures where
import qualified Codec.Picture as P
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import qualified Data.Map.Strict as M
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Foreign hiding (void)
import qualified Control.Concurrent.STM as STM
import qualified Vulkan as Vk
import qualified Vulkan.CStruct.Extends as Vk
import qualified Vulkan.Zero as Vk
import qualified VulkanMemoryAllocator as VMA
-- internal imports
import Types
import Memory
import Sync
import Image
loadImageFromFile
:: (MonadResource m, MonadIO m)
=> VMA.Allocator
-> UploadContext
-> Vk.Queue
-> Vk.Device
-> FilePath
-> m AllocatedImage
loadImageFromFile allocator uploadContext queue device file = do
pixels <- liftIO $ either error P.convertRGBA8 <$> P.readImage file
let texWidth = P.imageWidth pixels
texHeight = P.imageHeight pixels
imageSize = 4 * texWidth * texHeight
imageFormat = Vk.FORMAT_R8G8B8A8_SRGB
stagingBuffer <-
createAllocatedBuffer
allocator
imageSize
Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
VMA.MEMORY_USAGE_CPU_ONLY
let dataPtr = VMA.mappedData (bufferInfo stagingBuffer)
liftIO $ pokeArray (castPtr dataPtr) (VS.toList $ P.imageData pixels)
let imageExtent = Vk.Extent3D
{ width = fromIntegral texWidth
, height = fromIntegral texHeight
, depth = 1
}
dImgAllocCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY
} :: VMA.AllocationCreateInfo
dImgCreateInfo = imageCreate
imageFormat
imageExtent
(Vk.IMAGE_USAGE_SAMPLED_BIT .|. Vk.IMAGE_USAGE_TRANSFER_DST_BIT)
(newImage, newAllocation, _) <- snd <$>
VMA.withImage allocator dImgCreateInfo dImgAllocCreateInfo allocate
immediateSubmit
uploadContext
queue
device
(\cmd -> do
let range = Vk.zero
{ Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
, Vk.baseMipLevel = 0
, Vk.levelCount = 1
, Vk.baseArrayLayer = 0
, Vk.layerCount = 1
}
imageBarrierToTransfer = V.singleton $ Vk.SomeStruct (Vk.zero
{ Vk.oldLayout = Vk.IMAGE_LAYOUT_UNDEFINED
, Vk.newLayout = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
, Vk.image = newImage
, Vk.subresourceRange = range
-- , Vk.srcAccessMask = bit 0
, Vk.dstAccessMask = Vk.ACCESS_TRANSFER_WRITE_BIT
} :: Vk.ImageMemoryBarrier '[])
Vk.cmdPipelineBarrier
cmd
Vk.PIPELINE_STAGE_TOP_OF_PIPE_BIT
Vk.PIPELINE_STAGE_TRANSFER_BIT
(bit 0)
V.empty
V.empty
imageBarrierToTransfer
let copyRegion = V.singleton (Vk.zero
{ Vk.bufferOffset = 0
, Vk.bufferRowLength = 0
, Vk.bufferImageHeight = 0
, Vk.imageExtent = imageExtent
, Vk.imageSubresource = Vk.zero
{ Vk.aspectMask = Vk.IMAGE_ASPECT_COLOR_BIT
, Vk.mipLevel = 0
, Vk.baseArrayLayer = 0
, Vk.layerCount = 1
} :: Vk.ImageSubresourceLayers
} :: Vk.BufferImageCopy)
Vk.cmdCopyBufferToImage
cmd
(allocatedBuffer stagingBuffer)
newImage
Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
copyRegion
let imageBarrierToReadable = V.singleton $ Vk.SomeStruct (Vk.zero
{ Vk.oldLayout = Vk.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
, Vk.newLayout = Vk.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
, Vk.image = newImage
, Vk.subresourceRange = range
, Vk.srcAccessMask = Vk.ACCESS_TRANSFER_WRITE_BIT
, Vk.dstAccessMask = Vk.ACCESS_SHADER_READ_BIT
} :: Vk.ImageMemoryBarrier '[])
Vk.cmdPipelineBarrier
cmd
Vk.PIPELINE_STAGE_TRANSFER_BIT
Vk.PIPELINE_STAGE_FRAGMENT_SHADER_BIT
(bit 0)
V.empty
V.empty
imageBarrierToReadable
)
return $ AllocatedImage
{ image = newImage
, allocation = newAllocation
}
loadImages
:: (MonadResource m, MonadReader ReadState m)
=> VMA.Allocator
-> UploadContext
-> Vk.Queue
-> Vk.Device
-> m ()
loadImages allocator uploadContext queue device = do
loadedImage <- loadImageFromFile allocator uploadContext queue device "assets/textures/jaeger.texture.tga"
let imageInfo = imageviewCreate (image loadedImage) Vk.FORMAT_R8G8B8A8_SRGB Vk.IMAGE_ASPECT_COLOR_BIT
imageView <- snd <$> Vk.withImageView device imageInfo Nothing allocate
let texture = Texture
{ textureImage = loadedImage
, textureImageView = imageView
}
textureLib <- asks textureLibrary
void $ liftIO $ STM.atomically $ do
texMap <- STM.readTMVar textureLib
let newMap = M.insert "marksman" texture texMap
STM.swapTMVar textureLib newMap

View file

@ -9,6 +9,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Vector as V import qualified Data.Vector as V
import Debug.Trace
import Foreign import Foreign
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Linear import Linear
@ -24,28 +25,28 @@ data ShaderContainer = ShaderContainer
deriving (Show) deriving (Show)
data EngineData = EngineData data EngineData = EngineData
{ engineWindow :: SDL.Window { engineWindow :: SDL.Window
, engineWindowDimensions :: V2 CInt , engineWindowDimensions :: V2 CInt
, enginePhysicalDevice :: Vk.PhysicalDevice , enginePhysicalDevice :: Vk.PhysicalDevice
, engineLogicalDevice :: Vk.Device , engineLogicalDevice :: Vk.Device
, engineInstance :: Vk.Instance , engineInstance :: Vk.Instance
, engineSwapchain :: Vk.SwapchainKHR , engineSwapchain :: Vk.SwapchainKHR
, engineQueue :: Vk.Queue , engineQueue :: Vk.Queue
, engineFramebuffers :: V.Vector Vk.Framebuffer , engineFramebuffers :: V.Vector Vk.Framebuffer
, engineRenderPass :: Vk.RenderPass , meshPipelineLayout :: Vk.PipelineLayout
, engineAllocator :: VMA.Allocator , engineRenderPass :: Vk.RenderPass
, engineDepthImageView :: Vk.ImageView , engineAllocator :: VMA.Allocator
, engineDepthImage :: AllocatedImage , engineDepthImageView :: Vk.ImageView
, engineDepthFormat :: Vk.Format , engineDepthImage :: AllocatedImage
, engineFrames :: V.Vector FrameData , engineDepthFormat :: Vk.Format
, engineGlobalSetLayout :: Vk.DescriptorSetLayout , engineFrames :: V.Vector FrameData
, engineObjectSetLayout :: Vk.DescriptorSetLayout , engineGlobalSetLayout :: Vk.DescriptorSetLayout
, engineSingleTextureSetLayout :: Vk.DescriptorSetLayout , engineObjectSetLayout :: Vk.DescriptorSetLayout
, engineDescriptorPool :: Vk.DescriptorPool , engineDescriptorPool :: Vk.DescriptorPool
, engineSceneParameters :: GPUSceneData , enginePhysicalDeviceProperties :: Vk.PhysicalDeviceProperties
, engineUploadContext :: UploadContext , engineSceneParameters :: GPUSceneData
, engineSceneParameterBuffer :: AllocatedBuffer
} }
deriving (Show)
data AllocatedBuffer = AllocatedBuffer data AllocatedBuffer = AllocatedBuffer
{ allocatedBuffer :: Vk.Buffer { allocatedBuffer :: Vk.Buffer
@ -54,38 +55,28 @@ data AllocatedBuffer = AllocatedBuffer
} }
deriving (Show) deriving (Show)
instance Eq AllocatedBuffer where
(AllocatedBuffer buf1 _ _) == (AllocatedBuffer buf2 _ _) = buf1 == buf2
data Vertex = Vertex data Vertex = Vertex
{ vertexPosition :: V3 Float { vertexPosition :: V3 Float
, vertexNormal :: V3 Float , vertexNormal :: V3 Float
, vertexColor :: V4 Float , vertexColor :: V4 Float
, vertexUV :: V2 Float
} }
deriving (Show, Eq) deriving (Show)
instance Storable Vertex where instance Storable Vertex where
sizeOf _ = sizeOf (Vertex position normal color) = sizeOf position + sizeOf normal + sizeOf color
sizeOf (undefined :: V3 Float) * 2 +
sizeOf (undefined :: V4 Float) +
sizeOf (undefined :: V2 Float)
peek ptr = do peek ptr = do
pos <- peek (castPtr ptr) pos <- peek (castPtr ptr)
nor <- peek (castPtr ptr `plusPtr` sizeOf pos) nor <- peek (castPtr ptr `plusPtr` sizeOf pos)
col <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor) col <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor)
uv <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor `plusPtr` sizeOf col) return $ Vertex pos nor col
return $ Vertex pos nor col uv
poke ptr (Vertex position normal color uv) = do poke ptr (Vertex position normal color) = do
let castedV3Ptr = castPtr ptr let castedV3Ptr = castPtr ptr
pokeElemOff castedV3Ptr 0 position pokeElemOff castedV3Ptr 0 position
pokeElemOff castedV3Ptr 1 normal pokeElemOff castedV3Ptr 1 normal
poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color
poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal `plusPtr` sizeOf color)) uv
alignment _ = 0 alignment _ = 0
@ -119,13 +110,6 @@ instance VertexInputDescribable Vertex where
, Vk.format = Vk.FORMAT_R32G32B32A32_SFLOAT , Vk.format = Vk.FORMAT_R32G32B32A32_SFLOAT
, Vk.offset = fromIntegral (sizeOf (vertexPosition v) + sizeOf (vertexNormal v)) , Vk.offset = fromIntegral (sizeOf (vertexPosition v) + sizeOf (vertexNormal v))
} :: Vk.VertexInputAttributeDescription } :: Vk.VertexInputAttributeDescription
uvAttribute = Vk.zero
{ Vk.binding = 0
, Vk.location = 3
, Vk.format = Vk.FORMAT_R32G32_SFLOAT
, Vk.offset = fromIntegral $
sizeOf (vertexPosition v) + sizeOf (vertexNormal v) + sizeOf (vertexColor v)
} :: Vk.VertexInputAttributeDescription
in in
VertexInputDescription VertexInputDescription
{ vidBindings = V.fromList [ mainBinding ] { vidBindings = V.fromList [ mainBinding ]
@ -133,7 +117,6 @@ instance VertexInputDescribable Vertex where
[ positionAttribute [ positionAttribute
, normalAttribute , normalAttribute
, colorAttribute , colorAttribute
, uvAttribute
] ]
} }
@ -147,7 +130,7 @@ data Mesh = Mesh
{ meshVertices :: V.Vector Vertex { meshVertices :: V.Vector Vertex
, meshBuffer :: AllocatedBuffer , meshBuffer :: AllocatedBuffer
} }
deriving (Show, Eq) deriving (Show)
data MeshPushConstants = MeshPushConstants data MeshPushConstants = MeshPushConstants
{ meshPushData :: V4 Float { meshPushData :: V4 Float
@ -155,7 +138,6 @@ data MeshPushConstants = MeshPushConstants
} }
deriving (Show) deriving (Show)
undefinedMeshPushConstants :: MeshPushConstants
undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity
instance Storable MeshPushConstants where instance Storable MeshPushConstants where
@ -180,11 +162,10 @@ data AllocatedImage = AllocatedImage
deriving (Show) deriving (Show)
data Material = Material data Material = Material
{ materialTextureSet :: Vk.DescriptorSet { materialPipeline :: Vk.Pipeline
, materialPipeline :: Vk.Pipeline
, materialPipelineLayout :: Vk.PipelineLayout , materialPipelineLayout :: Vk.PipelineLayout
} }
deriving (Show, Eq) deriving (Show)
data RenderObject = RenderObject data RenderObject = RenderObject
{ objectMesh :: String { objectMesh :: String
@ -193,23 +174,16 @@ data RenderObject = RenderObject
} }
deriving (Show) deriving (Show)
data Texture = Texture
{ textureImage :: AllocatedImage
, textureImageView :: Vk.ImageView
}
data ReadState = ReadState data ReadState = ReadState
{ renderables :: STM.TMVar (V.Vector RenderObject) { renderables :: STM.TMVar (V.Vector RenderObject)
, meshLibrary :: STM.TMVar (M.Map String Mesh) , meshLibrary :: STM.TMVar (M.Map String Mesh)
, materialLibrary :: STM.TMVar (M.Map String Material) , materialLibrary :: STM.TMVar (M.Map String Material)
, textureLibrary :: STM.TMVar (M.Map String Texture)
} }
newtype RenderReader rd m a = RenderReader newtype RenderReader rd m a = RenderReader
{ runRenderInner :: RenderInner rd m a { runRenderInner :: RenderInner rd m a
} }
deriving deriving (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)
(Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)
type RenderInner rd m = ReaderT rd m type RenderInner rd m = ReaderT rd m
@ -227,7 +201,6 @@ data FrameData = FrameData
, frameCameraBuffer :: AllocatedBuffer , frameCameraBuffer :: AllocatedBuffer
, frameSceneBuffer :: AllocatedBuffer , frameSceneBuffer :: AllocatedBuffer
, frameObjectBuffer :: AllocatedBuffer , frameObjectBuffer :: AllocatedBuffer
, frameIndirectBuffer :: AllocatedBuffer
, frameGlobalDescriptor :: Vk.DescriptorSet , frameGlobalDescriptor :: Vk.DescriptorSet
, frameObjectDescriptor :: Vk.DescriptorSet , frameObjectDescriptor :: Vk.DescriptorSet
} }
@ -237,12 +210,11 @@ newtype GPUObjectData = GPUObjectData
{ objectModelMatrix :: M44 Float { objectModelMatrix :: M44 Float
} }
undefinedGPUObjectData :: GPUObjectData
undefinedGPUObjectData = GPUObjectData identity undefinedGPUObjectData = GPUObjectData identity
instance Storable GPUObjectData where instance Storable GPUObjectData where
sizeOf (GPUObjectData _) = sizeOf (identity :: M44 Float) sizeOf (GPUObjectData modelMatrix) = sizeOf modelMatrix
alignment _ = 0 alignment _ = 0
@ -250,7 +222,7 @@ instance Storable GPUObjectData where
GPUObjectData <$> peek (castPtr ptr) GPUObjectData <$> peek (castPtr ptr)
poke ptr (GPUObjectData modelMatrix) = poke ptr (GPUObjectData modelMatrix) =
poke (castPtr ptr) $ transpose modelMatrix poke (castPtr ptr) modelMatrix
data GPUCameraData = GPUCameraData data GPUCameraData = GPUCameraData
{ view :: M44 Float { view :: M44 Float
@ -260,8 +232,8 @@ data GPUCameraData = GPUCameraData
instance Storable GPUCameraData where instance Storable GPUCameraData where
sizeOf _ = sizeOf (GPUCameraData pview pprojection pviewProjection) =
3 * sizeOf (undefined :: M44 Float) sizeOf pview + sizeOf pprojection + sizeOf pviewProjection
alignment _ = 0 alignment _ = 0
@ -272,10 +244,9 @@ instance Storable GPUCameraData where
return $ GPUCameraData v p vp return $ GPUCameraData v p vp
poke ptr (GPUCameraData pview pprojection pviewProjection) = do poke ptr (GPUCameraData pview pprojection pviewProjection) = do
poke (castPtr ptr) $ transpose pview poke (castPtr ptr) pview
poke (castPtr ptr `plusPtr` sizeOf pview) $ transpose pprojection poke (castPtr ptr `plusPtr` sizeOf pview) pprojection
poke (castPtr ptr `plusPtr` sizeOf pview `plusPtr` sizeOf pprojection) $ poke (castPtr ptr `plusPtr` sizeOf pview `plusPtr` sizeOf pprojection) pviewProjection
transpose pviewProjection
data GPUSceneData = GPUSceneData data GPUSceneData = GPUSceneData
{ fogColor :: V4 Float { fogColor :: V4 Float
@ -315,17 +286,3 @@ instance Storable GPUSceneData where
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol
data UploadContext = UploadContext
{ uploadFence :: Vk.Fence
, uploadCommandPool :: Vk.CommandPool
, uploadCommandBuffer :: Vk.CommandBuffer
}
deriving (Show)
data IndirectBatch = IndirectBatch
{ batchMesh :: Mesh
, batchMaterial :: Material
, batchFirst :: Word32
, batchCount :: Word32
}

View file

@ -8,6 +8,8 @@ import qualified Data.Vector as V
import Data.Word (Word32) import Data.Word (Word32)
import Debug.Trace
import qualified Vulkan as Vk import qualified Vulkan as Vk
import qualified Vulkan.CStruct.Extends as Vk import qualified Vulkan.CStruct.Extends as Vk
import qualified Vulkan.Zero as Vk import qualified Vulkan.Zero as Vk
@ -56,55 +58,11 @@ writeDescriptorBuffer
-> Vk.DescriptorBufferInfo -> Vk.DescriptorBufferInfo
-> Word32 -> Word32
-> Vk.SomeStruct Vk.WriteDescriptorSet -> Vk.SomeStruct Vk.WriteDescriptorSet
writeDescriptorBuffer type' dstSet dBufferInfo binding = Vk.SomeStruct $ writeDescriptorBuffer type' dstSet bufferInfo binding = Vk.SomeStruct $
Vk.zero Vk.zero
{ Vk.dstBinding = binding { Vk.dstBinding = binding
, Vk.dstSet = dstSet , Vk.dstSet = dstSet
, Vk.descriptorCount = 1 , Vk.descriptorCount = 1
, Vk.descriptorType = type' , Vk.descriptorType = type'
, Vk.bufferInfo = V.singleton dBufferInfo , Vk.bufferInfo = V.singleton bufferInfo
}
beginCommandBuffer
:: Vk.CommandBufferUsageFlags
-> Vk.CommandBufferBeginInfo '[]
beginCommandBuffer flags =
Vk.zero
{ Vk.flags = flags
}
createSubmitInfo
:: Vk.CommandBuffer
-> V.Vector (Vk.SomeStruct Vk.SubmitInfo)
createSubmitInfo cmd = V.singleton $ Vk.SomeStruct $
Vk.zero
{ Vk.commandBuffers = V.singleton (Vk.commandBufferHandle cmd)
}
samplerCreateInfo
:: Vk.Filter
-> Vk.SamplerAddressMode
-> Vk.SamplerCreateInfo '[]
samplerCreateInfo filters addressMode =
Vk.zero
{ Vk.magFilter = filters
, Vk.minFilter = filters
, Vk.addressModeU = addressMode
, Vk.addressModeV = addressMode
, Vk.addressModeW = addressMode
}
writeDescriptorImage
:: Vk.DescriptorType
-> Vk.DescriptorSet
-> Vk.DescriptorImageInfo
-> Word32
-> Vk.WriteDescriptorSet '[]
writeDescriptorImage type' set imageInfo binding =
Vk.zero
{ Vk.dstBinding = binding
, Vk.dstSet = set
, Vk.descriptorCount = 1
, Vk.descriptorType = type'
, Vk.imageInfo = V.singleton imageInfo
} }

View file

@ -1,46 +0,0 @@
{pkgs, vulkan-tutorial, ...}:
pkgs.nixosTest ({
name = "test";
nodes = {
machine = { config, pkgs, ...}: {
environment = {
systemPackages = with pkgs; [
vulkan-tutorial
git
shaderc
vulkan-loader
vulkan-validation-layers
];
sessionVariables = {
VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
};
};
hardware.opengl = {
enable = true;
driSupport = true;
driSupport32Bit = true;
};
services.xserver = {
enable = true;
displayManager.sddm.enable = true;
desktopManager.cinnamon.enable = true;
};
users.users.test = {
password = "test";
extraGroups = [
"wheel"
];
isNormalUser = true;
};
};
};
skipLint = true;
testScript = ''
start_all()
machine.shell_interact()
'';
})

View file

@ -34,14 +34,12 @@ executable vulkan-tutorial
Memory Memory
Mesh Mesh
Image Image
Sync
Textures
Types Types
Util Util
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:
build-depends: base build-depends: base >=4.14.3.0
, sdl2 , sdl2
, vulkan , vulkan
, vulkan-utils , vulkan-utils
@ -50,14 +48,12 @@ executable vulkan-tutorial
, linear , linear
, monad-loops , monad-loops
, stm , stm
, time
, bytestring , bytestring
, text , text
, vector , vector
, resourcet , resourcet
, mtl , mtl
, containers , containers
, JuicyPixels
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall