{-# LANGUAGE DuplicateRecordFields #-} module Types where import qualified Data.Vector as V import Foreign import Foreign.C.Types (CInt) import Linear import qualified SDL import qualified Vulkan 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 , enginePhysicalDevice :: Vk.PhysicalDevice , engineLogicalDevice :: Vk.Device , engineInstance :: Vk.Instance , engineSwapchain :: Vk.SwapchainKHR , engineQueue :: Vk.Queue , engineCommandBuffers :: V.Vector Vk.CommandBuffer , engineFramebuffers :: V.Vector Vk.Framebuffer , meshPipelineLayout :: Vk.PipelineLayout , meshPipeline :: V.Vector Vk.Pipeline , engineRenderPass :: Vk.RenderPass , engineInFlightFence :: Vk.Fence , engineImageAvailableSemaphore :: Vk.Semaphore , engineRenderFinishedSemaphore :: Vk.Semaphore , engineMesh :: Mesh , engineExternalMesh :: Mesh , engineAllocator :: VMA.Allocator , engineDepthImageView :: Vk.ImageView , engineDepthImage :: AllocatedImage , engineDepthFormat :: Vk.Format } 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 } deriving (Show) data Mesh = Mesh { meshVertices :: V.Vector Vertex , meshBuffer :: AllocatedBuffer } deriving (Show) 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 data AllocatedImage = AllocatedImage { image :: Vk.Image , allocation :: VMA.Allocation } deriving (Show)