From 6ae9fee3f03b4e7a3fe797c99ed23147831fc7b0 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Thu, 1 Dec 2022 13:17:13 +0100
Subject: [PATCH] =?UTF-8?q?w=C3=B6rk=20w=C3=B6rk?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Init.hs           |  9 ++++++++-
 src/Types.hs          | 38 ++++++++++++++++++++++++++++++++++++++
 vulkan-tutorial.cabal |  3 +++
 3 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/src/Init.hs b/src/Init.hs
index 2f48021..b4e823d 100644
--- a/src/Init.hs
+++ b/src/Init.hs
@@ -6,7 +6,6 @@ module Init where
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Resource
-import qualified Data.Vector as V
 import qualified SDL hiding (V2)
 import qualified SDL.Video.Vulkan as SDL
 import Foreign.Ptr
@@ -21,7 +20,9 @@ import Devices
 import GraphicsPipeline
 import Framebuffers
 import CommandBuffer
+import Memory
 import Types
+import Mesh
 
 initEngine
   :: (MonadResource m, MonadFail m)
@@ -55,6 +56,7 @@ initEngine = do
   -- initialize viúlkan data structures
   initVulkan window
 
+
 initVulkan
   :: (MonadResource m, MonadFail m)
   => SDL.Window
@@ -75,6 +77,9 @@ initVulkan window = do
   vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
   (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface
 
+  allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance
+  mesh <- uploadMesh loadMeshes allocator
+
   dimensions <- liftIO $ SDL.windowInitialSize <$> SDL.getWindowConfig window
   (swapchain, surfaceFormat) <-
     createSwapchain vulkanSurface surfaceFormats dimensions vulkanLogicalDevice
@@ -122,8 +127,10 @@ initVulkan window = do
     frameBuffers
     redPipelines
     rainbowPipelines
+    undefined -- placeholder for meshPipeline
     renderPass
     inFlightFence
     imageAvailableSemaphore
     renderFinishedSemaphore
+    mesh
     
diff --git a/src/Types.hs b/src/Types.hs
index 5c87fd7..4edba10 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -1,10 +1,13 @@
 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 VulkanMemoryAllocator as VMA
 
 data ShaderContainer = ShaderContainer
   { containedVertexShader   :: Vk.ShaderModule
@@ -22,8 +25,43 @@ data EngineData = EngineData
   , 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
+
+data Mesh = Mesh
+  { meshVertices :: V.Vector Vertex
+  , meshBuffer   :: AllocatedBuffer
+  }
+  deriving (Show)
diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal
index 2bddfc8..1b3a807 100644
--- a/vulkan-tutorial.cabal
+++ b/vulkan-tutorial.cabal
@@ -31,6 +31,8 @@ executable vulkan-tutorial
                       Framebuffers
                       CommandBuffer
                       Draw
+                      Memory
+                      Mesh
                       Types
 
     -- LANGUAGE extensions used by modules in this package.
@@ -39,6 +41,7 @@ executable vulkan-tutorial
                     , sdl2
                     , vulkan
                     , vulkan-utils
+                    , VulkanMemoryAllocator
                     , linear
                     , monad-loops
                     , stm