half-working state…

shadersrc/rainbow_lit.frag

@@ -15,5 +15,6 @@ layout(set = 0, binding = 1) uniform  SceneData{
 } sceneData;
 
 void main() {
-    outColor = vec4(fragColor.xyz + sceneData.ambientColor.xyz, 1.0f);
+    //outColor = vec4(fragColor.xyz + sceneData.ambientColor.xyz, 1.0f);
+    outColor = sceneData.ambientColor;
 }

src/CommandBuffer.hs

@@ -11,7 +11,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Resource
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
-import Foreign
+import Foreign hiding (void)
 import Foreign.C.Types (CInt)
 import Linear
 import qualified Vulkan as Vk
@@ -29,6 +29,9 @@ import Util
 frameOverlap :: Int
 frameOverlap = 2
 
+maxObjects :: Int
+maxObjects = 10000
+
 createFrames
   :: (MonadResource m, MonadFail m)
   => Vk.PhysicalDevice
@@ -36,8 +39,9 @@ createFrames
   -> VMA.Allocator
   -> Vk.DescriptorPool
   -> Vk.DescriptorSetLayout
+  -> Vk.DescriptorSetLayout
   -> m (V.Vector FrameData, Vk.Queue)
-createFrames physicalDevice logicalDevice allocator descriptorPool setLayout = do
+createFrames physicalDevice logicalDevice allocator descriptorPool setLayout objectSetLayout = do
 
   queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT
 
@@ -94,13 +98,34 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout = d
         Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
         VMA.MEMORY_USAGE_CPU_TO_GPU
 
+      let sceneParamBufferSize =
+            -- frameOverlap *
+              fromIntegral (padUniformBufferSize
+                (fromIntegral $ sizeOf undefinedGPUSceneData)
+                deviceProperties)
+      sceneBuffer <- createAllocatedBuffer
+        allocator
+        (sizeOf undefinedGPUSceneData * frameOverlap)
+        Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
+        VMA.MEMORY_USAGE_CPU_TO_GPU
+
+      objectBuffer <- createAllocatedBuffer
+        allocator
+        (sizeOf undefinedGPUObjectData * maxObjects)
+        Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT
+        VMA.MEMORY_USAGE_CPU_TO_GPU
 
       let allocationInfo = Vk.zero
             { Vk.descriptorPool = descriptorPool
             , Vk.setLayouts     = V.singleton setLayout
             }
+          objectSetAllocInfo = Vk.zero
+            { Vk.descriptorPool = descriptorPool
+            , Vk.setLayouts     = V.singleton objectSetLayout
+            }
 
       globalDescriptor <- Vk.allocateDescriptorSets logicalDevice allocationInfo
+      objectDescriptor <- Vk.allocateDescriptorSets logicalDevice objectSetAllocInfo
 
       let cameraInfo = Vk.zero
             { Vk.buffer = allocatedBuffer cameraBuffer
@@ -108,11 +133,15 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout = d
             , Vk.range  = fromIntegral $ sizeOf (GPUCameraData identity identity identity)
             } :: Vk.DescriptorBufferInfo
           sceneInfo = Vk.zero
-            { Vk.buffer = allocatedBuffer cameraBuffer
+            { Vk.buffer = allocatedBuffer sceneBuffer
-            , Vk.offset = padUniformBufferSize
+            , Vk.offset = 0
-              (fromIntegral $ sizeOf (undefinedGPUSceneData) * fromIntegral index)
+            -- , Vk.offset = padUniformBufferSize (fromIntegral $ sizeOf undefinedGPUSceneData) deviceProperties * fromIntegral index
-              deviceProperties
+            , Vk.range  = fromIntegral $ sizeOf undefinedGPUSceneData
-            , Vk.range  = fromIntegral $ sizeOf (undefinedGPUSceneData)
+            } :: Vk.DescriptorBufferInfo
+          objectInfo = Vk.zero
+            { Vk.buffer = allocatedBuffer objectBuffer
+            , Vk.offset = 0
+            , Vk.range  = fromIntegral $ sizeOf undefinedGPUObjectData * maxObjects
             } :: Vk.DescriptorBufferInfo
           cameraWrite = writeDescriptorBuffer
             Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
@@ -120,13 +149,19 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout = d
             cameraInfo
             0
           sceneWrite = writeDescriptorBuffer
-            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
+            Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
             (V.head globalDescriptor)
             sceneInfo
             1
+          objectWrite = writeDescriptorBuffer
+            Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
+            (V.head objectDescriptor)
+            objectInfo
+            0
           setWrites = V.fromList
             [ cameraWrite
             , sceneWrite
+            , objectWrite
             ]
 
 
@@ -139,7 +174,9 @@ createFrames physicalDevice logicalDevice allocator descriptorPool setLayout = d
         , frameCommandPool       = commandPool
         , frameMainCommandBuffer = V.head commandBuffer
         , frameCameraBuffer      = cameraBuffer
+        , frameObjectBuffer      = objectBuffer
         , frameGlobalDescriptor  = V.head globalDescriptor
+        , frameObjectDescriptor  = V.head objectDescriptor
         }
 
       )
@@ -227,29 +264,47 @@ recordCommandBuffer
     Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
 
     let framed = fromIntegral frameNumber / 120
-        ambient = V4 (sin framed) 0 (cos framed) 1
+        -- 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
+
 
     scenePointer <- VMA.mapMemory allocator (bufferAllocation sceneParameterBuffer)
 
+    -- dataPointer <- liftIO $ new scenePointer
+
+    -- paramsPtr <- liftIO (new ambientParams)
+
+    -- liftIO $ copyBytes
+    --   (scenePointer `plusPtr` (fromIntegral sceneDataOffset * fromIntegral frameIndex))
+    --   paramsPtr
+    --   (sizeOf undefinedGPUSceneData)
+
     liftIO $ poke
-      (castPtr scenePointer `plusPtr`
+      (castPtr scenePointer `plusPtr` (fromIntegral sceneDataOffset * frameIndex))
-        (fromIntegral $
+      -- (castPtr scenePointer `plusPtr`
-          padUniformBufferSize (fromIntegral $ sizeOf (undefinedGPUSceneData)) deviceProps *
+      --   (fromIntegral $
-            fromIntegral frameIndex))
+      --     padUniformBufferSize (fromIntegral $ sizeOf (undefinedGPUSceneData)) deviceProps))--  *
-      (sceneParameters
+      --       -- fromIntegral frameIndex))
-        { ambientColor = ambient
+      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
-    materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
 
     V.mapM_
-      (\(RenderObject meshID materialID modelMatrix) -> do
+      (\(index, RenderObject meshID materialID modelMatrix) -> do
 
         let camPosition = V3
               (-10 * sin (fromIntegral frameNumber / 90))
@@ -260,13 +315,14 @@ recordCommandBuffer
             camView = lookAt camPosition camCenter camUp
             camProjection = perspective (pi/4) (fromIntegral width / fromIntegral height) 0.1 200
 
-            cameraData = GPUCameraData
+        materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
+
+        let cameraData = GPUCameraData
               { view           = transpose camView
               , projection     = transpose camProjection
               , viewProjection = transpose $ camProjection !*! camView
               }
 
-            -- pvm = projection !*! view !*! modelMatrix
             constants = MeshPushConstants
               { meshPushData     = V4 0 0 0 0
               , meshRenderMatrix = transpose modelMatrix
@@ -282,12 +338,26 @@ recordCommandBuffer
 
         Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
 
+        let uniformOffset =
+              padUniformBufferSize
+               (fromIntegral $ sizeOf undefinedGPUSceneData)
+               deviceProps
+              * fromIntegral frameIndex
+
         Vk.cmdBindDescriptorSets
           commandBuffer
           Vk.PIPELINE_BIND_POINT_GRAPHICS
           (materialPipelineLayout material)
           0
           (V.singleton $ frameGlobalDescriptor frame)
+          (V.singleton $ fromIntegral uniformOffset)
+
+        Vk.cmdBindDescriptorSets
+          commandBuffer
+          Vk.PIPELINE_BIND_POINT_GRAPHICS
+          (materialPipelineLayout material)
+          1
+          (V.singleton $ frameObjectDescriptor frame)
           V.empty
 
         dataPointer <- liftIO (castPtr <$> new constants)
@@ -306,9 +376,12 @@ recordCommandBuffer
           (V.fromList [ allocatedBuffer $ meshBuffer mesh ])
           (V.fromList [ 0 ])
 
-        Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 0
+        Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
+        )
+      (V.zip
+        (V.fromList [0 ..])
+        renderObjects
         )
-      renderObjects
 
     Vk.cmdEndRenderPass commandBuffer
 

src/GraphicsPipeline.hs

@@ -325,34 +325,20 @@ createGraphicsPipelines
     let newMatLibrary = M.insert "defaultMesh" material matLibrary
     void $ liftIO $ STM.atomically $ STM.swapTMVar matLibraryTMVar newMatLibrary
 
-createPipelineLayout
-  :: MonadResource m
-  => Vk.Device
-  -> m Vk.PipelineLayout
-createPipelineLayout logicalDevice = do
-  let pipelineLayoutCreateInfo = Vk.zero
-
-  snd <$> allocate
-    (Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
-    (\pipelineLayout -> do
-      putStrLn "destroying pipeline layout"
-      Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
-      )
-
 createMeshPipelineLayout
   :: MonadResource m
   => Vk.Device
-  -> Vk.DescriptorSetLayout
+  -> V.Vector Vk.DescriptorSetLayout
   -> m Vk.PipelineLayout
-createMeshPipelineLayout logicalDevice layout = do
+createMeshPipelineLayout logicalDevice layouts = do
   let pushConstantRange = Vk.zero
         { Vk.offset     = 0
-        , Vk.size       = fromIntegral (sizeOf (undefined :: MeshPushConstants))
+        , Vk.size       = fromIntegral (sizeOf (undefinedMeshPushConstants))
         , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
         }
       pipelineLayoutCreateInfo = Vk.zero
         { Vk.pushConstantRanges = V.singleton pushConstantRange
-        , Vk.setLayouts         = V.singleton layout
+        , Vk.setLayouts         = layouts
         }
 
   snd <$> allocate

src/Init.hs

@@ -92,7 +92,7 @@ initVulkan window = do
   vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
   (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
 
-  (descriptorSetLayout, descriptorPool) <- initDescriptors vulkanLogicalDevice
+  (descriptorSetLayout1, descriptorSetLayout2, descriptorPool) <- initDescriptors vulkanLogicalDevice
 
   allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance
 
@@ -103,7 +103,13 @@ initVulkan window = do
   meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
   meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow_lit.frag" "frag"
   renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) Vk.FORMAT_D32_SFLOAT
-  meshLayout <- createMeshPipelineLayout vulkanLogicalDevice descriptorSetLayout
+  meshLayout <- createMeshPipelineLayout
+    vulkanLogicalDevice
+    (V.fromList
+      [ descriptorSetLayout1
+      , descriptorSetLayout2
+      ]
+      )
   let meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
   createGraphicsPipelines
     vulkanLogicalDevice
@@ -115,7 +121,7 @@ initVulkan window = do
 
   frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions
 
-  (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice allocator descriptorPool descriptorSetLayout
+  (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice allocator descriptorPool descriptorSetLayout1 descriptorSetLayout2
 
   loadMeshes allocator
 
@@ -137,7 +143,8 @@ initVulkan window = do
     depthAllocatedImage
     Vk.FORMAT_D32_SFLOAT
     frames
-    descriptorSetLayout
+    descriptorSetLayout1
+    descriptorSetLayout2
     descriptorPool
     <$> Vk.getPhysicalDeviceProperties vulkanPhysicalDevice
     <*> pure (GPUSceneData
@@ -149,7 +156,7 @@ initVulkan window = do
       )
     <*> createAllocatedBuffer
       allocator
-      (sizeOf (undefinedGPUSceneData))
+      (sizeOf undefinedGPUSceneData)
       Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT
       VMA.MEMORY_USAGE_CPU_TO_GPU
 
@@ -188,7 +195,7 @@ initScene = do
 initDescriptors
   :: (MonadResource m)
   => Vk.Device
-  -> m (Vk.DescriptorSetLayout, Vk.DescriptorPool)
+  -> m (Vk.DescriptorSetLayout, Vk.DescriptorSetLayout, Vk.DescriptorPool)
 initDescriptors device = do
   let cameraBind = descriptorsetLayoutBinding
         Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
@@ -198,6 +205,10 @@ initDescriptors device = do
         Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
         (Vk.SHADER_STAGE_VERTEX_BIT .|. Vk.SHADER_STAGE_FRAGMENT_BIT)
         1
+      objectBind = descriptorsetLayoutBinding
+        Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
+        Vk.SHADER_STAGE_VERTEX_BIT
+        0
       setInfo = Vk.zero
         { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
         , Vk.bindings = V.fromList
@@ -205,24 +216,43 @@ initDescriptors device = do
           , sceneBind
           ]
         }
+      setInfo2 = Vk.zero
+        { Vk.flags = Vk.DESCRIPTOR_SET_LAYOUT_CREATE_UPDATE_AFTER_BIND_POOL_BIT
+        , Vk.bindings = V.singleton objectBind
+        }
       poolInfo = Vk.zero
         { Vk.flags     = Vk.DESCRIPTOR_POOL_CREATE_UPDATE_AFTER_BIND_BIT
         , Vk.maxSets   = 10
-        , Vk.poolSizes = V.singleton
+        , Vk.poolSizes = V.fromList
-          ( Vk.zero
+          [ Vk.zero
             { Vk.type'           = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
             , Vk.descriptorCount = 10
             }
-          )
+          , Vk.zero
+            { Vk.type'           = Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
+            , Vk.descriptorCount = 10
+            }
+          , Vk.zero
+            { Vk.type'           = Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
+            , Vk.descriptorCount = 10
+            }
+          ]
         }
 
-  (_, descriptorSetLayout) <- allocate
+  (_, descriptorSetLayout1) <- allocate
     (Vk.createDescriptorSetLayout device setInfo Nothing)
     (\descriptorLayout -> do
       putStrLn "destroying descriptor layout"
       Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
       )
 
+  (_, descriptorSetLayout2) <- allocate
+    (Vk.createDescriptorSetLayout device setInfo2 Nothing)
+    (\descriptorLayout -> do
+      putStrLn "destroying descriptor layout"
+      Vk.destroyDescriptorSetLayout device descriptorLayout Nothing
+      )
+
   (_, descriptorPool) <- allocate
     (Vk.createDescriptorPool device poolInfo Nothing)
     (\descriptorPoolInfo -> do
@@ -230,4 +260,4 @@ initDescriptors device = do
       Vk.destroyDescriptorPool device descriptorPoolInfo Nothing
       )
 
-  return (descriptorSetLayout, descriptorPool)
+  return (descriptorSetLayout1, descriptorSetLayout2, descriptorPool)

src/Instance.hs

@@ -29,7 +29,7 @@ createInstance window = do
           -- enable debug util extension for debugging purposes
         , Vk.enabledExtensionNames = V.fromList windowExtensions
           -- enable validation layer for debugging purposes
-        -- , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
+        , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
         }
 
   (_, inst) <- allocate

src/Types.hs

@@ -9,6 +9,7 @@ import Control.Monad.Reader
 import Control.Monad.Trans.Resource
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
+import Debug.Trace
 import Foreign
 import Foreign.C.Types (CInt)
 import Linear
@@ -40,6 +41,7 @@ data EngineData = EngineData
   , engineDepthFormat              :: Vk.Format
   , engineFrames                   :: V.Vector FrameData
   , engineGlobalSetLayout          :: Vk.DescriptorSetLayout
+  , engineObjectSetLayout          :: Vk.DescriptorSetLayout
   , engineDescriptorPool           :: Vk.DescriptorPool
   , enginePhysicalDeviceProperties :: Vk.PhysicalDeviceProperties
   , engineSceneParameters          :: GPUSceneData
@@ -63,7 +65,11 @@ instance Storable Vertex where
 
   sizeOf (Vertex position normal color) = sizeOf position + sizeOf normal + sizeOf color
 
-  peek _ = undefined
+  peek ptr = do
+    pos <- peek (castPtr ptr)
+    nor <- peek (castPtr ptr `plusPtr` sizeOf pos)
+    col <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor)
+    return $ Vertex pos nor col
 
   poke ptr (Vertex position normal color) = do
     let castedV3Ptr = castPtr ptr
@@ -71,7 +77,7 @@ instance Storable Vertex where
     pokeElemOff castedV3Ptr 1 normal
     poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color
 
-  alignment _ = undefined
+  alignment _ = 0
 
 class VertexInputDescribable v where
 
@@ -131,9 +137,11 @@ data MeshPushConstants = MeshPushConstants
   }
   deriving (Show)
 
+undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity
+
 instance Storable MeshPushConstants where
 
-  sizeOf _ = sizeOf (undefined :: V4 Float) + sizeOf (undefined :: M44 Float)
+  sizeOf _ = sizeOf (V4 0 0 0 0 :: V4 Float) + sizeOf (identity :: M44 Float)
 
   peek ptr = do
     dat <- peek (castPtr ptr)
@@ -190,10 +198,30 @@ data FrameData = FrameData
   , frameCommandPool       :: Vk.CommandPool
   , frameMainCommandBuffer :: Vk.CommandBuffer
   , frameCameraBuffer      :: AllocatedBuffer
+  , frameObjectBuffer      :: AllocatedBuffer
   , frameGlobalDescriptor  :: Vk.DescriptorSet
+  , frameObjectDescriptor  :: Vk.DescriptorSet
   }
   deriving (Show)
 
+newtype GPUObjectData = GPUObjectData
+  { objectModelMatrix :: M44 Float
+  }
+
+undefinedGPUObjectData = GPUObjectData identity
+
+instance Storable GPUObjectData where
+
+  sizeOf (GPUObjectData modelMatrix) = sizeOf modelMatrix
+
+  alignment _ = 0
+
+  peek ptr = do
+    GPUObjectData <$> peek (castPtr ptr)
+
+  poke ptr (GPUObjectData modelMatrix) =
+    poke (castPtr ptr) modelMatrix
+
 data GPUCameraData = GPUCameraData
   { view           :: M44 Float
   , projection     :: M44 Float
@@ -205,9 +233,13 @@ instance Storable GPUCameraData where
   sizeOf (GPUCameraData pview pprojection pviewProjection) =
     sizeOf pview + sizeOf pprojection + sizeOf pviewProjection
 
-  alignment = undefined
+  alignment _ = 0
 
-  peek _ = undefined
+  peek ptr = do
+    v <- peek (castPtr ptr)
+    p <- peek (castPtr ptr `plusPtr` sizeOf v)
+    vp <- peek (castPtr ptr `plusPtr` sizeOf v `plusPtr` sizeOf p)
+    return $ GPUCameraData v p vp
 
   poke ptr (GPUCameraData pview pprojection pviewProjection) = do
     poke (castPtr ptr) pview
@@ -221,6 +253,7 @@ data GPUSceneData = GPUSceneData
   , sunDirection :: V4 Float
   , sunColor     :: V4 Float
   }
+  deriving (Show)
 
 undefinedGPUSceneData :: GPUSceneData
 undefinedGPUSceneData = GPUSceneData
@@ -232,16 +265,22 @@ undefinedGPUSceneData = GPUSceneData
 
 instance Storable GPUSceneData where
 
-  sizeOf (GPUSceneData fogCol fogDist ambCol sunDir sunCol) =
+  sizeOf _ =
-    sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir + sizeOf sunCol
+    5 * sizeOf (V4 0 0 0 0 :: V4 Float)
 
-  alignment = undefined
+  alignment _ = 0
 
-  peek _ = undefined
+  peek ptr = do
+    fogCol <- peek (castPtr ptr)
+    fogDst <- peek (castPtr $ ptr `plusPtr` sizeOf fogCol)
+    ambCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst))
+    sunDir <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol))
+    sunCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol + sizeOf sunDir))
+    return $ GPUSceneData fogCol fogDst ambCol sunDir sunCol
 
   poke ptr (GPUSceneData fogCol fogDist ambCol sunDir sunCol) = do
     poke (castPtr ptr) fogCol
-    poke (castPtr ptr `plusPtr` sizeOf fogCol) fogDist
+    poke (castPtr $ ptr `plusPtr` sizeOf fogCol) fogDist
-    poke (castPtr ptr `plusPtr` sizeOf fogCol `plusPtr` sizeOf fogDist) ambCol
+    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol
-    poke (castPtr ptr `plusPtr` sizeOf fogCol `plusPtr` sizeOf fogDist `plusPtr` sizeOf ambCol) sunDir
+    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir
-    poke (castPtr ptr `plusPtr` sizeOf fogCol `plusPtr` sizeOf fogDist `plusPtr` sizeOf ambCol `plusPtr` sizeOf sunDir) sunCol
+    poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol

src/Util.hs

@@ -8,6 +8,8 @@ import qualified Data.Vector as V
 
 import Data.Word (Word32)
 
+import Debug.Trace
+
 import qualified Vulkan as Vk
 import qualified Vulkan.CStruct.Extends as Vk
 import qualified Vulkan.Zero as Vk
@@ -28,10 +30,13 @@ padUniformBufferSize
   -> Vk.DeviceSize
 padUniformBufferSize origSize gpuProperties =
   let minUBOAlignment = Vk.minUniformBufferOffsetAlignment $ Vk.limits gpuProperties
+      result =
+        if minUBOAlignment > 0
+        then (origSize + minUBOAlignment - 1) .&. complement (minUBOAlignment - 1)
+        else origSize
   in
-    if minUBOAlignment > 0
+    -- trace ("padding result: " <> show result) result
-    then (origSize + minUBOAlignment - 1) .&. complement (minUBOAlignment - 1)
+    result
-    else origSize
 
 descriptorsetLayoutBinding
   :: Vk.DescriptorType