This commit is contained in:
nek0 2022-12-02 20:34:35 +01:00
parent 8075eb3fd8
commit ce5bed8843
8 changed files with 86 additions and 14 deletions

View file

@ -26,6 +26,7 @@ SUBPASS
subpasses subpasses
subresource subresource
Subresource Subresource
succ
swapchain swapchain
Swapchain Swapchain
SWAPCHAIN SWAPCHAIN

View file

@ -20,7 +20,7 @@ import Control.Monad.IO.Class (MonadIO(liftIO))
drawFrame drawFrame
:: (MonadResource m) :: (MonadResource m)
=> EngineData => EngineData
-> STM.TMVar Bool -> STM.TMVar Pipelines
-> m () -> m ()
drawFrame engineData switch = do drawFrame engineData switch = do
@ -61,11 +61,13 @@ drawFrame engineData switch = do
(engineRenderPass engineData) (engineRenderPass engineData)
(engineFramebuffers engineData V.! fromIntegral index) (engineFramebuffers engineData V.! fromIntegral index)
(engineWindowDimensions engineData) (engineWindowDimensions engineData)
(if switchState (case switchState of
then Rainbow ->
redEnginePipelines engineData V.! fromIntegral index redEnginePipelines engineData V.! fromIntegral index
else Red ->
rainbowEnginePipelines engineData V.! fromIntegral index rainbowEnginePipelines engineData V.! fromIntegral index
Green ->
meshPipeline engineData V.! fromIntegral index
) )
let submitInfo = Vk.zero let submitInfo = Vk.zero

View file

@ -237,7 +237,7 @@ createGraphicsPipelines
, Vk.attachments = V.singleton colorBlendAttachment , Vk.attachments = V.singleton colorBlendAttachment
} }
pipelineCreateInfo = Vk.zero pipelineCreateInfo = Vk.zero
{ Vk.stageCount = 2 { Vk.stageCount = fromIntegral (V.length pipelineStagesCreateInfos)
, Vk.stages = pipelineStagesCreateInfos , Vk.stages = pipelineStagesCreateInfos
, Vk.vertexInputState = Just $ Vk.SomeStruct pipelineVertexInputCreateInfo , Vk.vertexInputState = Just $ Vk.SomeStruct pipelineVertexInputCreateInfo
, Vk.inputAssemblyState = , Vk.inputAssemblyState =

View file

@ -88,10 +88,12 @@ initVulkan window = do
redFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/red.frag" "frag" redFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/red.frag" "frag"
rainbowVertexShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.vert" "vert" rainbowVertexShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.vert" "vert"
rainbowFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.frag" "frag" rainbowFragmentShader <- loadShader vulkanLogicalDevice "shadersrc/rainbow.frag" "frag"
meshVertexShader <- loadShader vulkanLogicalDevice "shadersrc/mesh.vert" "vert"
renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat) renderPass <- createRenderPass vulkanLogicalDevice (Khr.format surfaceFormat)
pipelineLayout <- createPipelineLayout vulkanLogicalDevice pipelineLayout <- createPipelineLayout vulkanLogicalDevice
let redContainer = ShaderContainer (Just redVertexShader) (Just redFragmentShader) let redContainer = ShaderContainer (Just redVertexShader) (Just redFragmentShader)
let rainbowContainer = ShaderContainer (Just rainbowVertexShader) (Just rainbowFragmentShader) rainbowContainer = ShaderContainer (Just rainbowVertexShader) (Just rainbowFragmentShader)
meshContainer = ShaderContainer (Just meshVertexShader) Nothing
redPipelines <- redPipelines <-
createGraphicsPipelines createGraphicsPipelines
vulkanLogicalDevice vulkanLogicalDevice
@ -108,6 +110,14 @@ initVulkan window = do
dimensions dimensions
(length imageViews) (length imageViews)
pipelineLayout pipelineLayout
meshPipelines <-
createGraphicsPipelines
vulkanLogicalDevice
renderPass
meshContainer
dimensions
(length imageViews)
pipelineLayout
frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions
@ -127,10 +137,9 @@ initVulkan window = do
frameBuffers frameBuffers
redPipelines redPipelines
rainbowPipelines rainbowPipelines
undefined -- placeholder for meshPipeline meshPipelines
renderPass renderPass
inFlightFence inFlightFence
imageAvailableSemaphore imageAvailableSemaphore
renderFinishedSemaphore renderFinishedSemaphore
mesh mesh

View file

@ -28,7 +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 showPipeline <- liftIO $ STM.newTMVarIO Rainbow
-- main loop -- main loop
whileM_ whileM_
@ -36,7 +36,7 @@ main = runResourceT $ do
) )
( do ( do
-- draw -- draw
drawFrame engineData secondPipeline drawFrame engineData showPipeline
-- poll events -- poll events
evs <- liftIO SDL.pollEvents evs <- liftIO SDL.pollEvents
-- flip abort condition on window close -- flip abort condition on window close
@ -48,8 +48,14 @@ main = runResourceT $ do
case dat of case dat of
SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeSpace _) -> SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeSpace _) ->
liftIO $ STM.atomically $ do liftIO $ STM.atomically $ do
state <- STM.readTMVar secondPipeline state <- STM.readTMVar showPipeline
void $ STM.swapTMVar secondPipeline (not state) void $ STM.swapTMVar showPipeline
(if state /= maxBound then succ state else state)
SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ SDL.KeycodeTab _) ->
liftIO $ STM.atomically $ do
state <- STM.readTMVar showPipeline
void $ STM.swapTMVar showPipeline
(if state /= minBound then pred state else state)
_ -> return () _ -> return ()
_ -> return () _ -> return ()
) )

View file

@ -38,7 +38,7 @@ initAllocator physicalDevice device instance' = do
(_, allocator) <- allocate (_, allocator) <- allocate
(VMA.createAllocator allocatorInfo) (VMA.createAllocator allocatorInfo)
(\allocator -> do (\allocator -> do
print ("destroying allocator" :: String) putStrLn "destroying allocator"
VMA.destroyAllocator allocator VMA.destroyAllocator allocator
) )

View file

@ -48,7 +48,7 @@ uploadMesh vertices allocator = do
return (Mesh vertices (AllocatedBuffer buffer allocation)) return (Mesh vertices (AllocatedBuffer buffer allocation))
) )
(\(Mesh _ (AllocatedBuffer buffer allocation)) -> do (\(Mesh _ (AllocatedBuffer buffer allocation)) -> do
print ("destroying mesh" :: String) putStrLn "destroying mesh"
VMA.destroyBuffer allocator buffer allocation VMA.destroyBuffer allocator buffer allocation
) )

View file

@ -1,3 +1,4 @@
{-# LANGUAGE DuplicateRecordFields #-}
module Types where module Types where
import qualified Data.Vector as V import qualified Data.Vector as V
@ -7,8 +8,16 @@ import Foreign.C.Types (CInt)
import Linear import Linear
import qualified SDL import qualified SDL
import qualified Vulkan as Vk import qualified Vulkan as Vk
import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Zero as Vk
import qualified VulkanMemoryAllocator as VMA import qualified VulkanMemoryAllocator as VMA
data Pipelines
= Rainbow
| Red
| Green
deriving (Eq, Ord, Enum, Bounded)
data ShaderContainer = ShaderContainer data ShaderContainer = ShaderContainer
{ containedVertexShader :: Maybe Vk.ShaderModule { containedVertexShader :: Maybe Vk.ShaderModule
, containedFragmentShader :: Maybe Vk.ShaderModule , containedFragmentShader :: Maybe Vk.ShaderModule
@ -60,6 +69,51 @@ instance Storable Vertex where
alignment _ = undefined alignment _ = undefined
class VertexInputDescribable v where
getVertexDescription :: v -> VertexInputDescription
instance VertexInputDescribable Vertex where
getVertexDescription v =
let mainBinding = Vk.zero
{ Vk.binding = 0
, Vk.stride = fromIntegral (sizeOf v)
, Vk.inputRate = Vk.VERTEX_INPUT_RATE_VERTEX
} :: Vk.VertexInputBindingDescription
positionAttribute = Vk.zero
{ Vk.binding = 0
, Vk.location = 0
, Vk.format = Vk.FORMAT_R32G32B32_SFLOAT
, Vk.offset = 0
} :: Vk.VertexInputAttributeDescription
normalAttribute = Vk.zero
{ Vk.binding = 0
, Vk.location = 1
, Vk.format = Vk.FORMAT_R32G32B32_SFLOAT
, Vk.offset = fromIntegral (sizeOf (vertexPosition v))
} :: Vk.VertexInputAttributeDescription
colorAttribute = Vk.zero
{ Vk.binding = 0
, Vk.location = 2
, Vk.format = Vk.FORMAT_R32G32B32A32_SFLOAT
, Vk.offset = fromIntegral (sizeOf (vertexPosition v) + sizeOf (vertexNormal v))
} :: Vk.VertexInputAttributeDescription
in
VertexInputDescription
{ vidBindings = V.fromList [ mainBinding ]
, vidAttributes = V.fromList
[ positionAttribute
, normalAttribute
, colorAttribute
]
}
data VertexInputDescription = VertexInputDescription
{ vidBindings :: V.Vector Vk.VertexInputBindingDescription
, vidAttributes :: V.Vector Vk.VertexInputAttributeDescription
}
data Mesh = Mesh data Mesh = Mesh
{ meshVertices :: V.Vector Vertex { meshVertices :: V.Vector Vertex
, meshBuffer :: AllocatedBuffer , meshBuffer :: AllocatedBuffer