add switchable shader

This commit is contained in:
nek0 2022-10-26 16:52:55 +02:00
parent 2ba2c5866c
commit b826889430
8 changed files with 70 additions and 13 deletions

11
shadersrc/red.frag Normal file
View file

@ -0,0 +1,11 @@
//glsl version 4.5
#version 450
//output write
layout (location = 0) out vec4 outFragColor;
void main()
{
//return red
outFragColor = vec4(1.f,0.f,0.f,1.0f);
}

15
shadersrc/red.vert Normal file
View file

@ -0,0 +1,15 @@
//we will be using glsl version 4.5 syntax
#version 450
void main()
{
//const array of positions for the triangle
const vec2 positions[3] = vec2[3](
vec2(0.5, 0.5),
vec2(-0.5, 0.5),
vec2(0.0, -0.5)
);
//output the position of each vertex
gl_Position = vec4(positions[gl_VertexIndex], 0.0, 1.0);
}

View file

@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
module Draw where module Draw where
import qualified Control.Concurrent.STM as STM
import Control.Monad import Control.Monad
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import qualified Data.Vector as V import qualified Data.Vector as V
@ -14,22 +15,23 @@ import qualified Vulkan.Zero as Vk
import CommandBuffer import CommandBuffer
import Types import Types
import Control.Monad.IO.Class (MonadIO(liftIO))
drawFrame drawFrame
:: (MonadResource m) :: (MonadResource m)
=> EngineData => EngineData
-> STM.TMVar Bool
-> m () -> m ()
drawFrame engineData = do drawFrame engineData switch = do
unless (all (V.length (engineCommandBuffers engineData) ==) unless (all (V.length (engineCommandBuffers engineData) ==)
[ V.length (engineCommandBuffers engineData) [ V.length (engineCommandBuffers engineData)
, V.length (engineFramebuffers engineData) , V.length (engineFramebuffers engineData)
, V.length (enginePipelines engineData)
]) $ ]) $
error ("Numbers of elements mismatch: command buffers " <> error ("Numbers of elements mismatch: command buffers " <>
show (V.length $ engineCommandBuffers engineData) <> show (V.length $ engineCommandBuffers engineData) <>
", frame buffers " <> show (V.length $ engineFramebuffers engineData) <> ", frame buffers " <> show (V.length $ engineFramebuffers engineData)
", pipelines " <> show (V.length $ enginePipelines engineData)) )
let fences = V.singleton $ engineInFlightFence engineData let fences = V.singleton $ engineInFlightFence engineData
@ -51,13 +53,20 @@ drawFrame engineData = do
Vk.resetCommandBuffer Vk.resetCommandBuffer
(engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0) (engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0)
switchState <- liftIO $ STM.atomically $ STM.readTMVar switch
-- liftIO $ putStrLn "recording command buffer" -- liftIO $ putStrLn "recording command buffer"
recordCommandBuffer recordCommandBuffer
(engineCommandBuffers engineData V.! fromIntegral index) (engineCommandBuffers engineData V.! fromIntegral index)
(engineRenderPass engineData) (engineRenderPass engineData)
(engineFramebuffers engineData V.! fromIntegral index) (engineFramebuffers engineData V.! fromIntegral index)
(engineWindowDimensions engineData) (engineWindowDimensions engineData)
(enginePipelines engineData V.! fromIntegral index) (if switchState
then
redEnginePipelines engineData V.! fromIntegral index
else
rainbowEnginePipelines engineData V.! fromIntegral index
)
let submitInfo = Vk.zero let submitInfo = Vk.zero
{ Vk.waitSemaphores = { Vk.waitSemaphores =

View file

@ -6,6 +6,7 @@ module Init where
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
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.Ptr import Foreign.Ptr
@ -78,16 +79,27 @@ initVulkan window = do
(swapchain, surfaceFormat) <- (swapchain, surfaceFormat) <-
createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice
imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice imageViews <- getImageViewHandles swapchain surfaceFormat vulkanLogicalDevice
vertexShader <- loadShader vulkanLogicalDevice "shadersrc/shader.vert" "vert" redVertexShader <- loadShader vulkanLogicalDevice "shadersrc/red.vert" "vert"
fragmentShader <- loadShader vulkanLogicalDevice "shadersrc/shader.frag" "frag" redFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/red.frag" "frag"
rainbowVertexShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.vert" "vert"
rainbowFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.frag" "frag"
renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat)
pipelineLayout <- createPipelineLayout vulkanLogicalDevice pipelineLayout <- createPipelineLayout vulkanLogicalDevice
let shaderContainer = ShaderContainer vertexShader fragmentShader let redContainer = ShaderContainer redVertexShader redFragmentShader
pipelines <- let rainbowContainer = ShaderContainer rainbowVertexShader rainbowFragmentShader
redPipelines <-
createGraphicsPipelines createGraphicsPipelines
vulkanLogicalDevice vulkanLogicalDevice
renderPass renderPass
shaderContainer redContainer
dimensions
(length imageViews)
pipelineLayout
rainbowPipelines <-
createGraphicsPipelines
vulkanLogicalDevice
renderPass
rainbowContainer
dimensions dimensions
(length imageViews) (length imageViews)
pipelineLayout pipelineLayout
@ -108,7 +120,8 @@ initVulkan window = do
graphicsQueue graphicsQueue
commandBuffer commandBuffer
frameBuffers frameBuffers
pipelines redPipelines
rainbowPipelines
renderPass renderPass
inFlightFence inFlightFence
imageAvailableSemaphore imageAvailableSemaphore

View file

@ -28,6 +28,7 @@ main = runResourceT $ do
-- create abort condition for upcoming lop -- create abort condition for upcoming lop
quit <- liftIO $ STM.newTMVarIO True quit <- liftIO $ STM.newTMVarIO True
secondPipeline <- liftIO $ STM.newTMVarIO False
-- main loop -- main loop
whileM_ whileM_
@ -35,7 +36,7 @@ main = runResourceT $ do
) )
( do ( do
-- draw -- draw
drawFrame engineData drawFrame engineData secondPipeline
-- poll events -- poll events
evs <- liftIO SDL.pollEvents evs <- liftIO SDL.pollEvents
-- flip abort condition on window close -- flip abort condition on window close
@ -43,6 +44,13 @@ main = runResourceT $ do
(\e -> case SDL.eventPayload e of (\e -> case SDL.eventPayload e of
SDL.WindowClosedEvent _ -> SDL.WindowClosedEvent _ ->
void $ liftIO $ STM.atomically $ STM.swapTMVar quit False void $ liftIO $ STM.atomically $ STM.swapTMVar quit False
SDL.KeyboardEvent dat ->
case dat of
SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeSpace _) ->
liftIO $ STM.atomically $ do
state <- STM.readTMVar secondPipeline
void $ STM.swapTMVar secondPipeline (not state)
_ -> return ()
_ -> return () _ -> return ()
) )
evs evs

View file

@ -20,7 +20,8 @@ data EngineData = EngineData
, engineQueue :: Vk.Queue , engineQueue :: Vk.Queue
, engineCommandBuffers :: V.Vector Vk.CommandBuffer , engineCommandBuffers :: V.Vector Vk.CommandBuffer
, engineFramebuffers :: V.Vector Vk.Framebuffer , engineFramebuffers :: V.Vector Vk.Framebuffer
, enginePipelines :: V.Vector Vk.Pipeline , redEnginePipelines :: V.Vector Vk.Pipeline
, rainbowEnginePipelines :: V.Vector Vk.Pipeline
, engineRenderPass :: Vk.RenderPass , engineRenderPass :: Vk.RenderPass
, engineInFlightFence :: Vk.Fence , engineInFlightFence :: Vk.Fence
, engineImageAvailableSemaphore :: Vk.Semaphore , engineImageAvailableSemaphore :: Vk.Semaphore