vulkan-tutorial/src/Types.hs
2022-12-02 20:34:35 +01:00

122 lines
3.7 KiB
Haskell

{-# LANGUAGE DuplicateRecordFields #-}
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
data Pipelines
= Rainbow
| Red
| Green
deriving (Eq, Ord, Enum, Bounded)
data ShaderContainer = ShaderContainer
{ containedVertexShader :: Maybe Vk.ShaderModule
, containedFragmentShader :: Maybe Vk.ShaderModule
}
deriving (Show)
data EngineData = EngineData
{ engineWindow :: SDL.Window
, engineWindowDimensions :: V2 CInt
, engineLogicalDevice :: Vk.Device
, engineSwapchain :: Vk.SwapchainKHR
, engineQueue :: Vk.Queue
, engineCommandBuffers :: V.Vector Vk.CommandBuffer
, engineFramebuffers :: V.Vector Vk.Framebuffer
, redEnginePipelines :: V.Vector Vk.Pipeline
, rainbowEnginePipelines :: V.Vector Vk.Pipeline
, meshPipeline :: V.Vector Vk.Pipeline
, engineRenderPass :: Vk.RenderPass
, engineInFlightFence :: Vk.Fence
, engineImageAvailableSemaphore :: Vk.Semaphore
, engineRenderFinishedSemaphore :: Vk.Semaphore
, engineMesh :: Mesh
}
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
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
{ meshVertices :: V.Vector Vertex
, meshBuffer :: AllocatedBuffer
}
deriving (Show)