vulkan-tutorial/src/Types.hs

{-# 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
  , 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
  , engineAllocator               :: VMA.Allocator
  } 

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)

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