vulkan-tutorial/src/Types.hs

148 lines
4.5 KiB
Haskell
Raw Normal View History

2022-12-02 19:34:35 +00:00
{-# LANGUAGE DuplicateRecordFields #-}
2022-07-21 21:12:09 +00:00
module Types where
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
{ engineWindow :: SDL.Window
, engineWindowDimensions :: V2 CInt
2022-12-03 00:44:06 +00:00
, enginePhysicalDevice :: Vk.PhysicalDevice
2022-07-21 21:12:09 +00:00
, engineLogicalDevice :: Vk.Device
2022-12-03 00:44:06 +00:00
, engineInstance :: Vk.Instance
2022-07-21 21:12:09 +00:00
, engineSwapchain :: Vk.SwapchainKHR
, engineQueue :: Vk.Queue
, engineCommandBuffers :: V.Vector Vk.CommandBuffer
, engineFramebuffers :: V.Vector Vk.Framebuffer
2022-12-11 08:02:17 +00:00
, meshPipelineLayout :: Vk.PipelineLayout
2022-12-01 12:17:13 +00:00
, meshPipeline :: V.Vector Vk.Pipeline
2022-07-21 21:12:09 +00:00
, engineRenderPass :: Vk.RenderPass
, engineInFlightFence :: Vk.Fence
, engineImageAvailableSemaphore :: Vk.Semaphore
, engineRenderFinishedSemaphore :: Vk.Semaphore
2022-12-01 12:17:13 +00:00
, engineMesh :: Mesh
2022-12-15 04:19:53 +00:00
, engineExternalMesh :: Mesh
2022-12-03 00:44:06 +00:00
, engineAllocator :: VMA.Allocator
2022-12-28 03:18:54 +00:00
, engineDepthImageView :: Vk.ImageView
, engineDepthImage :: AllocatedImage
, engineDepthFormat :: Vk.Format
2022-07-21 21:12:09 +00:00
}
2022-12-01 12:17:13 +00:00
data AllocatedBuffer = AllocatedBuffer
{ allocatedBuffer :: Vk.Buffer
, bufferAllocation :: VMA.Allocation
}
deriving (Show)
data Vertex = Vertex
{ vertexPosition :: V3 Float
, vertexNormal :: V3 Float
, vertexColor :: V4 Float
}
deriving (Show)
instance Storable Vertex where
sizeOf (Vertex position normal color) = sizeOf position + sizeOf normal + sizeOf color
peek _ = undefined
poke ptr (Vertex position normal color) = do
let castedV3Ptr = castPtr ptr
pokeElemOff castedV3Ptr 0 position
pokeElemOff castedV3Ptr 1 normal
poke (castPtr (ptr `plusPtr` sizeOf position `plusPtr` sizeOf normal)) color
alignment _ = undefined
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
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
}
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
}
deriving (Show)
2022-12-11 08:02:17 +00:00
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
2022-12-28 03:18:54 +00:00
data AllocatedImage = AllocatedImage
{ image :: Vk.Image
, allocation :: VMA.Allocation
}
deriving (Show)