make rotating triengle

shadersrc/mesh.vert

@@ -6,8 +6,15 @@ layout (location = 2) in vec4 vColor;
 
 layout (location = 0) out vec4 outColor;
 
+//push constants block
+layout( push_constant ) uniform constants
+{
+  vec4 data;
+	mat4 render_matrix;
+} PushConstants;
+
 void main()
 {
-	gl_Position = vec4(vPosition, 1.0f);
+	gl_Position = PushConstants.render_matrix * vec4(vPosition, 1.0f);
 	outColor = vColor;
 }

src/CommandBuffer.hs

@@ -4,8 +4,10 @@
 module CommandBuffer where
 
 import Control.Monad
+import Control.Monad.IO.Class
 import Control.Monad.Trans.Resource
 import qualified Data.Vector as V
+import Foreign
 import Foreign.C.Types (CInt)
 import Linear
 import qualified Vulkan as Vk
@@ -15,7 +17,6 @@ import qualified Vulkan.Zero as Vk
 
 import Devices
 import Types
-import Mesh
 
 createCommandPool
   :: (MonadResource m)
@@ -66,7 +67,9 @@ recordCommandBuffer
   -> Vk.Framebuffer
   -> V2 CInt
   -> Vk.Pipeline
+  -> Vk.PipelineLayout
   -> Maybe Mesh
+  -> Int
   -> m ()
 recordCommandBuffer
   commandBuffer
@@ -74,7 +77,9 @@ recordCommandBuffer
   frameBuffer
   (V2 width height)
   graphicsPipeline
+  meshLayout
   mesh
+  frameNumber
   = do
 
     let commandBufferBeginInfo = Vk.zero
@@ -126,9 +131,28 @@ recordCommandBuffer
     Vk.cmdSetViewport commandBuffer 0 (V.singleton viewport)
     Vk.cmdSetScissor commandBuffer 0 (V.singleton scissor)
 
-    maybe
+    liftIO $ maybe
       (Vk.cmdDraw commandBuffer 3 1 0 0)
       (\jmesh -> do
+        let camPosition = V3 0 0 (-2)
+            camCenter = V3 0 0 0
+            camUp = V3 0 1 0
+            view = lookAt camPosition camCenter camUp
+            projection = perspective (pi/4) (800 / 600) 0.1 200
+            modelRot = axisAngle (V3 0 1 0) (fromIntegral frameNumber / (10 * pi))
+            model = mkTransformation modelRot (V3 0 0 0)
+            pvm = projection !*! view !*! model
+            constants = MeshPushConstants (V4 0 0 0 0) (transpose pvm)
+
+        pointer <- castPtr <$> new constants
+        Vk.cmdPushConstants
+          commandBuffer
+          meshLayout
+          Vk.SHADER_STAGE_VERTEX_BIT
+          0
+          (fromIntegral $ sizeOf constants)
+          pointer
+
         Vk.cmdBindVertexBuffers
           commandBuffer
           0

src/Draw.hs

@@ -21,8 +21,9 @@ drawFrame
   :: (MonadResource m, MonadFail m)
   => EngineData
   -> STM.TMVar Pipelines
+  -> Int
   -> m ()
-drawFrame engineData switch = do
+drawFrame engineData switch frameNumber = do
 
   unless (all (V.length (engineCommandBuffers engineData) ==)
     [ V.length (engineCommandBuffers engineData)
@@ -69,12 +70,14 @@ drawFrame engineData switch = do
       Green ->
         meshPipeline engineData V.! fromIntegral index
       )
+    (meshPipelineLayout engineData)
     (case switchState of
       Green ->
         Just $ engineMesh engineData
       _ ->
         Nothing
       )
+    frameNumber
 
   let submitInfo = Vk.zero
         { Vk.waitSemaphores =

src/GraphicsPipeline.hs

@@ -11,6 +11,7 @@ import Data.Bits
 -- import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Vector as V
+import Foreign (sizeOf)
 import Foreign.C.Types (CInt)
 import qualified Vulkan as VK
 import qualified Vulkan.Core10 as Vk
@@ -288,3 +289,24 @@ createPipelineLayout logicalDevice = do
       putStrLn "destroying pipeline layout"
       Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
       )
+
+createMeshPipelineLayout
+  :: MonadResource m
+  => Vk.Device
+  -> m Vk.PipelineLayout
+createMeshPipelineLayout logicalDevice = do
+  let pushConstantRange = Vk.zero
+        { Vk.offset     = 0
+        , Vk.size       = fromIntegral (sizeOf (undefined :: MeshPushConstants))
+        , Vk.stageFlags = Vk.SHADER_STAGE_VERTEX_BIT
+        }
+      pipelineLayoutCreateInfo = Vk.zero
+        { Vk.pushConstantRanges = V.singleton pushConstantRange
+        }
+
+  snd <$> allocate
+    (Vk.createPipelineLayout logicalDevice pipelineLayoutCreateInfo Nothing)
+    (\pipelineLayout -> do
+      putStrLn "destroying pipeline layout"
+      Vk.destroyPipelineLayout logicalDevice pipelineLayout Nothing
+      )

src/Init.hs

@@ -92,6 +92,7 @@ initVulkan window = do
   meshFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.frag" "frag"
   renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat)
   pipelineLayout <- createPipelineLayout vulkanLogicalDevice
+  meshLayout <- createMeshPipelineLayout vulkanLogicalDevice
   let redContainer = ShaderContainer (Just redVertexShader) (Just redFragmentShader)
       rainbowContainer = ShaderContainer (Just rainbowVertexShader) (Just rainbowFragmentShader)
       meshContainer = ShaderContainer (Just meshVertexShader) (Just meshFragmentShader)
@@ -118,7 +119,7 @@ initVulkan window = do
       meshContainer
       dimensions
       (length imageViews)
-      pipelineLayout
+      meshLayout
 
   frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions
 
@@ -138,6 +139,7 @@ initVulkan window = do
     graphicsQueue
     commandBuffer
     frameBuffers
+    meshLayout
     redPipelines
     rainbowPipelines
     meshPipelines

src/Main.hs

@@ -29,14 +29,17 @@ main = runResourceT $ do
   -- create abort condition for upcoming lop
   quit <- liftIO $ STM.newTMVarIO True
   showPipeline <- liftIO $ STM.newTMVarIO Green
+  frameContainer <- liftIO $ STM.newTMVarIO 0
 
   -- main loop
   whileM_
     (liftIO $ STM.atomically $ STM.readTMVar quit
       )
     ( do
+      frameNumber <- liftIO $ STM.atomically $ STM.takeTMVar frameContainer
+      liftIO $ STM.atomically $ STM.putTMVar frameContainer (succ frameNumber)
       -- draw
-      drawFrame engineData showPipeline
+      drawFrame engineData showPipeline frameNumber
       -- poll events
       evs <- liftIO SDL.pollEvents
       -- flip abort condition on window close

src/Types.hs

@@ -3,12 +3,10 @@ module Types where
 
 import qualified Data.Vector as V
 import Foreign
-import Foreign.Storable (Storable(..))
 import Foreign.C.Types (CInt)
 import Linear
 import qualified SDL
 import qualified Vulkan as Vk
-import qualified Vulkan.Core10 as Vk
 import qualified Vulkan.Zero as Vk
 import qualified VulkanMemoryAllocator as VMA
 
@@ -34,6 +32,7 @@ data EngineData = EngineData
   , engineQueue                   :: Vk.Queue
   , engineCommandBuffers          :: V.Vector Vk.CommandBuffer
   , engineFramebuffers            :: V.Vector Vk.Framebuffer
+  , meshPipelineLayout            :: Vk.PipelineLayout
   , redEnginePipelines            :: V.Vector Vk.Pipeline
   , rainbowEnginePipelines        :: V.Vector Vk.Pipeline
   , meshPipeline                  :: V.Vector Vk.Pipeline
@@ -122,3 +121,24 @@ data Mesh = Mesh
   , meshBuffer   :: AllocatedBuffer
   }
   deriving (Show)
+
+data MeshPushConstants = MeshPushConstants
+  { meshPushData     :: V4 Float
+  , meshRenderMatrix :: M44 Float
+  }
+  deriving (Show)
+
+instance Storable MeshPushConstants where
+
+  sizeOf _ = sizeOf (undefined :: V4 Float) + sizeOf (undefined :: M44 Float)
+
+  peek ptr = do
+    dat <- peek (castPtr ptr)
+    mat <- peek (castPtr (ptr `plusPtr` sizeOf dat))
+    return (MeshPushConstants dat mat)
+
+  poke ptr (MeshPushConstants dat mat) = do
+    poke (castPtr ptr) dat
+    poke (castPtr $ ptr `plusPtr` sizeOf dat) mat
+
+  alignment _ = 0