vulkan-tutorial/src/Types.hs

331 lines
10 KiB
Haskell
Raw Normal View History

2022-12-02 19:34:35 +00:00
{-# LANGUAGE DuplicateRecordFields #-}
2023-01-02 01:18:06 +00:00
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
2022-07-21 21:12:09 +00:00
module Types where
2023-01-02 01:18:06 +00:00
import Control.Concurrent.STM.TMVar as STM
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Resource
2023-01-02 04:59:59 +00:00
import qualified Data.Map.Strict as M
2022-07-21 21:12:09 +00:00
import qualified Data.Vector as V
2022-12-01 12:17:13 +00:00
import Foreign
2022-07-21 21:12:09 +00:00
import Foreign.C.Types (CInt)
import Linear
import qualified SDL
import qualified Vulkan as Vk
2022-12-02 19:34:35 +00:00
import qualified Vulkan.Zero as Vk
2022-12-01 12:17:13 +00:00
import qualified VulkanMemoryAllocator as VMA
2022-07-21 21:12:09 +00:00
data ShaderContainer = ShaderContainer
2022-12-02 19:02:01 +00:00
{ containedVertexShader :: Maybe Vk.ShaderModule
, containedFragmentShader :: Maybe Vk.ShaderModule
2022-07-21 21:12:09 +00:00
}
deriving (Show)
data EngineData = EngineData
2023-05-16 09:14:46 +00:00
{ engineWindow :: SDL.Window
, engineWindowDimensions :: V2 CInt
, enginePhysicalDevice :: Vk.PhysicalDevice
, engineLogicalDevice :: Vk.Device
, engineInstance :: Vk.Instance
, engineSwapchain :: Vk.SwapchainKHR
, engineQueue :: Vk.Queue
, engineFramebuffers :: V.Vector Vk.Framebuffer
, engineRenderPass :: Vk.RenderPass
, engineAllocator :: VMA.Allocator
, engineDepthImageView :: Vk.ImageView
, engineDepthImage :: AllocatedImage
, engineDepthFormat :: Vk.Format
, engineFrames :: V.Vector FrameData
, engineGlobalSetLayout :: Vk.DescriptorSetLayout
, engineObjectSetLayout :: Vk.DescriptorSetLayout
, engineSingleTextureSetLayout :: Vk.DescriptorSetLayout
, engineDescriptorPool :: Vk.DescriptorPool
, engineSceneParameters :: GPUSceneData
, engineUploadContext :: UploadContext
2022-07-21 21:12:09 +00:00
}
2023-05-14 16:50:02 +00:00
deriving (Show)
2022-12-01 12:17:13 +00:00
data AllocatedBuffer = AllocatedBuffer
{ allocatedBuffer :: Vk.Buffer
, bufferAllocation :: VMA.Allocation
2023-04-19 15:26:33 +00:00
, bufferInfo :: VMA.AllocationInfo
2022-12-01 12:17:13 +00:00
}
deriving (Show)
2023-05-20 16:36:31 +00:00
instance Eq AllocatedBuffer where
(AllocatedBuffer buf1 _ _) == (AllocatedBuffer buf2 _ _) = buf1 == buf2
2022-12-01 12:17:13 +00:00
data Vertex = Vertex
{ vertexPosition :: V3 Float
, vertexNormal :: V3 Float
, vertexColor :: V4 Float
2023-05-16 09:14:46 +00:00
, vertexUV :: V2 Float
2022-12-01 12:17:13 +00:00
}
2023-05-20 16:36:31 +00:00
deriving (Show, Eq)
2022-12-01 12:17:13 +00:00
instance Storable Vertex where
2023-05-16 09:14:46 +00:00
sizeOf _ =
sizeOf (undefined :: V3 Float) * 2 +
sizeOf (undefined :: V4 Float) +
sizeOf (undefined :: V2 Float)
2022-12-01 12:17:13 +00:00
2023-04-12 11:41:00 +00:00
peek ptr = do
pos <- peek (castPtr ptr)
nor <- peek (castPtr ptr `plusPtr` sizeOf pos)
col <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor)
2023-05-16 09:14:46 +00:00
uv <- peek (castPtr ptr `plusPtr` sizeOf pos `plusPtr` sizeOf nor `plusPtr` sizeOf col)
return $ Vertex pos nor col uv
2022-12-01 12:17:13 +00:00
2023-05-16 09:14:46 +00:00
poke ptr (Vertex position normal color uv) = do
2022-12-01 12:17:13 +00:00
let castedV3Ptr = castPtr ptr
pokeElemOff castedV3Ptr 0 position
pokeElemOff castedV3Ptr 1 normal
poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color
2023-05-16 09:14:46 +00:00
poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal `plusPtr` sizeOf color)) uv
2022-12-01 12:17:13 +00:00
2023-04-12 11:41:00 +00:00
alignment _ = 0
2022-12-01 12:17:13 +00:00
2022-12-02 19:34:35 +00:00
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
2023-05-16 09:14:46 +00:00
uvAttribute = Vk.zero
{ Vk.binding = 0
, Vk.location = 3
, Vk.format = Vk.FORMAT_R32G32_SFLOAT
, Vk.offset = fromIntegral $
sizeOf (vertexPosition v) + sizeOf (vertexNormal v) + sizeOf (vertexColor v)
} :: Vk.VertexInputAttributeDescription
2022-12-02 19:34:35 +00:00
in
VertexInputDescription
{ vidBindings = V.fromList [ mainBinding ]
, vidAttributes = V.fromList
[ positionAttribute
, normalAttribute
, colorAttribute
2023-05-16 09:14:46 +00:00
, uvAttribute
2022-12-02 19:34:35 +00:00
]
}
data VertexInputDescription = VertexInputDescription
{ vidBindings :: V.Vector Vk.VertexInputBindingDescription
, vidAttributes :: V.Vector Vk.VertexInputAttributeDescription
}
2022-12-28 03:18:54 +00:00
deriving (Show)
2022-12-02 19:34:35 +00:00
2022-12-01 12:17:13 +00:00
data Mesh = Mesh
{ meshVertices :: V.Vector Vertex
, meshBuffer :: AllocatedBuffer
}
2023-05-20 16:36:31 +00:00
deriving (Show, Eq)
2022-12-11 08:02:17 +00:00
data MeshPushConstants = MeshPushConstants
{ meshPushData :: V4 Float
, meshRenderMatrix :: M44 Float
}
deriving (Show)
2023-04-20 04:21:43 +00:00
undefinedMeshPushConstants :: MeshPushConstants
2023-04-12 11:41:00 +00:00
undefinedMeshPushConstants = MeshPushConstants (V4 0 0 0 0) identity
2022-12-11 08:02:17 +00:00
instance Storable MeshPushConstants where
2023-04-12 11:41:00 +00:00
sizeOf _ = sizeOf (V4 0 0 0 0 :: V4 Float) + sizeOf (identity :: M44 Float)
2022-12-11 08:02:17 +00:00
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
2022-12-28 03:18:54 +00:00
data AllocatedImage = AllocatedImage
{ image :: Vk.Image
, allocation :: VMA.Allocation
}
deriving (Show)
2023-01-02 01:18:06 +00:00
data Material = Material
2023-05-16 09:14:46 +00:00
{ materialTextureSet :: Vk.DescriptorSet
, materialPipeline :: Vk.Pipeline
2023-01-02 01:18:06 +00:00
, materialPipelineLayout :: Vk.PipelineLayout
}
2023-05-20 16:36:31 +00:00
deriving (Show, Eq)
2023-01-02 01:18:06 +00:00
data RenderObject = RenderObject
2023-01-02 04:59:59 +00:00
{ objectMesh :: String
, objectMaterial :: String
2023-01-02 01:18:06 +00:00
, objectMatrix :: M44 Float
}
deriving (Show)
data Texture = Texture
{ textureImage :: AllocatedImage
, textureImageView :: Vk.ImageView
}
2023-01-02 04:59:59 +00:00
data ReadState = ReadState
{ renderables :: STM.TMVar (V.Vector RenderObject)
, meshLibrary :: STM.TMVar (M.Map String Mesh)
, materialLibrary :: STM.TMVar (M.Map String Material)
, textureLibrary :: STM.TMVar (M.Map String Texture)
2023-01-02 01:18:06 +00:00
}
newtype RenderReader rd m a = RenderReader
{ runRenderInner :: RenderInner rd m a
}
2023-05-14 11:28:19 +00:00
deriving
(Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail)
2023-01-02 01:18:06 +00:00
type RenderInner rd m = ReaderT rd m
type Render a = RenderReader ReadState ResIO a
runRender :: ReadState -> Render a -> IO a
runRender rd actions = runResourceT $ flip runReaderT rd $ runRenderInner actions
2023-01-06 15:54:30 +00:00
data FrameData = FrameData
{ framePresentSemaphore :: Vk.Semaphore
, frameRenderSemaphore :: Vk.Semaphore
, frameRenderFence :: Vk.Fence
, frameCommandPool :: Vk.CommandPool
, frameMainCommandBuffer :: Vk.CommandBuffer
2023-01-06 19:02:17 +00:00
, frameCameraBuffer :: AllocatedBuffer
2023-04-19 15:26:33 +00:00
, frameSceneBuffer :: AllocatedBuffer
2023-04-12 11:41:00 +00:00
, frameObjectBuffer :: AllocatedBuffer
2023-01-06 19:02:17 +00:00
, frameGlobalDescriptor :: Vk.DescriptorSet
2023-04-12 11:41:00 +00:00
, frameObjectDescriptor :: Vk.DescriptorSet
2023-01-06 15:54:30 +00:00
}
deriving (Show)
2023-01-06 19:02:17 +00:00
2023-04-12 11:41:00 +00:00
newtype GPUObjectData = GPUObjectData
{ objectModelMatrix :: M44 Float
}
2023-04-20 04:21:43 +00:00
undefinedGPUObjectData :: GPUObjectData
2023-04-12 11:41:00 +00:00
undefinedGPUObjectData = GPUObjectData identity
instance Storable GPUObjectData where
2023-04-23 00:12:04 +00:00
sizeOf (GPUObjectData _) = sizeOf (identity :: M44 Float)
2023-04-12 11:41:00 +00:00
alignment _ = 0
peek ptr = do
GPUObjectData <$> peek (castPtr ptr)
poke ptr (GPUObjectData modelMatrix) =
poke (castPtr ptr) $ transpose modelMatrix
2023-04-12 11:41:00 +00:00
2023-01-06 19:02:17 +00:00
data GPUCameraData = GPUCameraData
{ view :: M44 Float
, projection :: M44 Float
, viewProjection :: M44 Float
}
instance Storable GPUCameraData where
2023-05-12 11:30:00 +00:00
sizeOf _ =
3 * sizeOf (undefined :: M44 Float)
2023-01-06 19:02:17 +00:00
2023-04-12 11:41:00 +00:00
alignment _ = 0
2023-01-06 19:02:17 +00:00
2023-04-12 11:41:00 +00:00
peek ptr = do
v <- peek (castPtr ptr)
p <- peek (castPtr ptr `plusPtr` sizeOf v)
vp <- peek (castPtr ptr `plusPtr` sizeOf v `plusPtr` sizeOf p)
return $ GPUCameraData v p vp
2023-01-06 19:02:17 +00:00
2023-04-02 08:46:02 +00:00
poke ptr (GPUCameraData pview pprojection pviewProjection) = do
poke (castPtr ptr) $ transpose pview
poke (castPtr ptr `plusPtr` sizeOf pview) $ transpose pprojection
poke (castPtr ptr `plusPtr` sizeOf pview `plusPtr` sizeOf pprojection) $
transpose pviewProjection
2023-04-02 08:46:02 +00:00
data GPUSceneData = GPUSceneData
{ fogColor :: V4 Float
, fogDistance :: V4 Float
, ambientColor :: V4 Float
, sunDirection :: V4 Float
, sunColor :: V4 Float
}
2023-04-12 11:41:00 +00:00
deriving (Show)
2023-04-02 08:46:02 +00:00
undefinedGPUSceneData :: GPUSceneData
undefinedGPUSceneData = GPUSceneData
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
(V4 0 0 0 0)
instance Storable GPUSceneData where
2023-04-12 11:41:00 +00:00
sizeOf _ =
5 * sizeOf (V4 0 0 0 0 :: V4 Float)
2023-04-02 08:46:02 +00:00
2023-04-12 11:41:00 +00:00
alignment _ = 0
2023-04-02 08:46:02 +00:00
2023-04-12 11:41:00 +00:00
peek ptr = do
fogCol <- peek (castPtr ptr)
fogDst <- peek (castPtr $ ptr `plusPtr` sizeOf fogCol)
ambCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst))
sunDir <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol))
sunCol <- peek (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDst + sizeOf ambCol + sizeOf sunDir))
return $ GPUSceneData fogCol fogDst ambCol sunDir sunCol
2023-04-02 08:46:02 +00:00
poke ptr (GPUSceneData fogCol fogDist ambCol sunDir sunCol) = do
poke (castPtr ptr) fogCol
2023-04-12 11:41:00 +00:00
poke (castPtr $ ptr `plusPtr` sizeOf fogCol) fogDist
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir
poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol
2023-05-14 11:28:19 +00:00
data UploadContext = UploadContext
{ uploadFence :: Vk.Fence
, uploadCommandPool :: Vk.CommandPool
, uploadCommandBuffer :: Vk.CommandBuffer
}
deriving (Show)
2023-05-20 16:36:31 +00:00
data IndirectBatch = IndirectBatch
{ batchMesh :: Mesh
, batchMaterial :: Material
, batchFirst :: Word32
, batchCount :: Word32
}