make rotating triengle

This commit is contained in:
nek0 2022-12-11 09:02:17 +01:00
parent d4688d03a5
commit 49ab3e49ed
7 changed files with 89 additions and 8 deletions

View file

@ -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;
}

View file

@ -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

View file

@ -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 =

View file

@ -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
)

View file

@ -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

View file

@ -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

View file

@ -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