slowly working forwards

src/CommandBuffer.hs

@@ -14,6 +14,8 @@ import qualified Vulkan.Zero as Vk
 -- internal imports
 
 import Devices
+import Types
+import Mesh
 
 createCommandPool
   :: (MonadResource m)
@@ -64,63 +66,82 @@ recordCommandBuffer
   -> Vk.Framebuffer
   -> V2 CInt
   -> Vk.Pipeline
+  -> Maybe Mesh
   -> m ()
-recordCommandBuffer commandBuffer renderPass frameBuffer (V2 width height) graphicsPipeline = do
+recordCommandBuffer
+  commandBuffer
+  renderPass
+  frameBuffer
+  (V2 width height)
+  graphicsPipeline
+  mesh
+  = do
 
-  let commandBufferBeginInfo = Vk.zero
+    let commandBufferBeginInfo = Vk.zero
-        { Vk.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT
+          { Vk.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT
-        , Vk.inheritanceInfo = Nothing
+          , Vk.inheritanceInfo = Nothing
-        }
+          }
 
-  Vk.beginCommandBuffer commandBuffer commandBufferBeginInfo
+    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.y = 0
+              }
+            , extent = Vk.Extent2D
+              { Vk.width  = fromIntegral width
+              , Vk.height = fromIntegral height
+              }
+            }
+          , Vk.clearValues = V.replicate 4 (Vk.Color $ Vk.Float32 0 0 0 1)
+          }
+
+    Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
+
+    Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS 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
             }
-          , extent = Vk.Extent2D
+          , Vk.extent = Vk.Extent2D
-            { Vk.width  = fromIntegral width
+            { Vk.width = fromIntegral width
             , Vk.height = fromIntegral height
             }
           }
-        , Vk.clearValues = V.replicate 4 (Vk.Color $ Vk.Float32 0 0 0 1)
-        }
 
-  Vk.cmdBeginRenderPass commandBuffer renderPassInfo Vk.SUBPASS_CONTENTS_INLINE
+    Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
+    Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
 
-  Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS graphicsPipeline
+    maybe
+      (Vk.cmdDraw commandBuffer 3 1 0 0)
+      (\jmesh -> do
+        Vk.cmdBindVertexBuffers
+          commandBuffer
+          0
+          (V.fromList [ allocatedBuffer $ meshBuffer jmesh ])
+          (V.fromList [ 0 ])
 
-  let viewport = Vk.zero
+        Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices jmesh) 1 0 0
-        { Vk.x        = 0
+        )
-        , Vk.y        = 0
+      mesh
-        , 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.cmdEndRenderPass commandBuffer
-  Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
 
-  Vk.cmdDraw commandBuffer 3 1 0 0
+    Vk.endCommandBuffer commandBuffer
-
-  Vk.cmdEndRenderPass commandBuffer
-
-  Vk.endCommandBuffer commandBuffer
 
 createSyncObjects
   :: (MonadResource m, MonadFail m)

src/Draw.hs

@@ -18,7 +18,7 @@ import Types
 import Control.Monad.IO.Class (MonadIO(liftIO))
 
 drawFrame
-  :: (MonadResource m)
+  :: (MonadResource m, MonadFail m)
   => EngineData
   -> STM.TMVar Pipelines
   -> m ()
@@ -69,6 +69,12 @@ drawFrame engineData switch = do
       Green ->
         meshPipeline engineData V.! fromIntegral index
       )
+    (case switchState of
+      Green ->
+        Just $ engineMesh engineData
+      _ ->
+        Nothing
+      )
 
   let submitInfo = Vk.zero
         { Vk.waitSemaphores =

src/GraphicsPipeline.hs

@@ -12,6 +12,7 @@ import Data.Bits
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Vector as V
 import Foreign.C.Types (CInt)
+import qualified Vulkan as VK
 import qualified Vulkan.Core10 as Vk
 import qualified Vulkan.Zero as Vk
 import qualified Vulkan.CStruct.Extends as Vk
@@ -19,8 +20,7 @@ import qualified Vulkan.Utils.ShaderQQ.GLSL.Shaderc as Vk
 
 -- internal imports
 import Types
-import qualified Vulkan as VK
+import Mesh
-import qualified Vulkan.CStruct.Extends as VK
 
 loadShader
   :: (MonadResource m)
@@ -128,7 +128,7 @@ createVertexInputAssemblyStateCreateInfo topology =
 
 createRasterizationStateCreateInfo
   :: Vk.PolygonMode
-  -> VK.SomeStruct Vk.PipelineRasterizationStateCreateInfo
+  -> Vk.SomeStruct Vk.PipelineRasterizationStateCreateInfo
 createRasterizationStateCreateInfo mode =
   Vk.SomeStruct $ Vk.zero
     { Vk.depthClampEnable        = False
@@ -198,9 +198,10 @@ createGraphicsPipelines
         pipelineDynamicStateCreateInfo = Vk.zero
           { Vk.dynamicStates = dynamicStates
           }
+        vertexDescription = getVertexDescription (V.head loadMeshes)
         pipelineVertexInputCreateInfo = Vk.zero
-          { Vk.vertexBindingDescriptions   = V.empty -- Fill me?
+          { Vk.vertexBindingDescriptions   = vidBindings vertexDescription
-          , Vk.vertexAttributeDescriptions = V.empty -- Fill me?
+          , Vk.vertexAttributeDescriptions = vidAttributes vertexDescription
           }
         viewport = Vk.Viewport
           { Vk.x        = 0

src/Init.hs

@@ -130,7 +130,9 @@ initVulkan window = do
   return $ EngineData
     window
     dimensions
+    vulkanPhysicalDevice
     vulkanLogicalDevice
+    vulkanInstance
     swapchain
     graphicsQueue
     commandBuffer
@@ -143,3 +145,4 @@ initVulkan window = do
     imageAvailableSemaphore
     renderFinishedSemaphore
     mesh
+    allocator

src/Main.hs

@@ -28,7 +28,7 @@ main = runResourceT $ do
 
   -- create abort condition for upcoming lop
   quit <- liftIO $ STM.newTMVarIO True
-  showPipeline <- liftIO $ STM.newTMVarIO Rainbow
+  showPipeline <- liftIO $ STM.newTMVarIO Green
 
   -- main loop
   whileM_

src/Types.hs

@@ -27,7 +27,9 @@ data ShaderContainer = ShaderContainer
 data EngineData = EngineData
   { engineWindow                  :: SDL.Window
   , engineWindowDimensions        :: V2 CInt
+  , enginePhysicalDevice          :: Vk.PhysicalDevice
   , engineLogicalDevice           :: Vk.Device
+  , engineInstance                :: Vk.Instance
   , engineSwapchain               :: Vk.SwapchainKHR
   , engineQueue                   :: Vk.Queue
   , engineCommandBuffers          :: V.Vector Vk.CommandBuffer
@@ -40,6 +42,7 @@ data EngineData = EngineData
   , engineImageAvailableSemaphore :: Vk.Semaphore
   , engineRenderFinishedSemaphore :: Vk.Semaphore
   , engineMesh                    :: Mesh
+  , engineAllocator               :: VMA.Allocator
   } 
 
 data AllocatedBuffer = AllocatedBuffer