new modules

src/Memory.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+module Memory where
+
+import Control.Monad.Trans.Resource
+
+import qualified VulkanMemoryAllocator as VMA
+import qualified Vulkan.Core10 as Vk
+import qualified Vulkan.Zero as Vk
+
+initAllocator
+  :: (MonadResource m, MonadFail m)
+  => Vk.PhysicalDevice
+  -> Vk.Device
+  -> Vk.Instance
+  -> m VMA.Allocator
+initAllocator physicalDevice device instance' = do
+  let allocatorInfo = Vk.zero
+        { VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice
+        , VMA.device         = Vk.deviceHandle device
+        , VMA.instance'      = Vk.instanceHandle instance'
+        } :: VMA.AllocatorCreateInfo
+
+  (_, allocator) <- allocate
+    (VMA.createAllocator allocatorInfo)
+    (\allocator -> do
+      print ("destroying allocator" :: String)
+      VMA.destroyAllocator allocator
+      )
+
+  return allocator

src/Mesh.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DataKinds #-}
+module Mesh where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource
+
+import qualified Data.Vector as V
+
+import Foreign
+
+import Linear (V3(..))
+
+import qualified VulkanMemoryAllocator as VMA
+import qualified Vulkan.Core10 as Vk
+import qualified Vulkan.Zero as Vk
+
+-- internal imports
+
+import Types
+
+loadMeshes
+  :: V.Vector Vertex
+loadMeshes =
+  V.fromList
+    [ Vertex (V3 0.5 0.5 0)    (V3 0 1 0) undefined
+    , Vertex (V3 (-0.5) 0.5 0) (V3 0 1 0) undefined
+    , Vertex (V3 0 (-0.5) 0)   (V3 0 1 0) undefined
+    ]
+
+uploadMesh
+  :: (MonadResource m, MonadFail m)
+  => V.Vector Vertex
+  -> VMA.Allocator
+  -> m Mesh
+uploadMesh vertices allocator = do
+  let bufferCreateInfo = Vk.zero
+        { Vk.size  = fromIntegral $ sizeOf (undefined :: Vertex)
+        , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
+        }
+      allocationCreateInfo = Vk.zero
+        { VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU
+        } :: VMA.AllocationCreateInfo
+  (_, mesh) <- allocate
+    (do
+      (buffer, allocation, _) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo
+      return (Mesh vertices (AllocatedBuffer buffer allocation))
+      )
+    (\(Mesh _ (AllocatedBuffer buffer allocation)) -> do
+      print ("destroying mesh" :: String)
+      VMA.destroyBuffer allocator buffer allocation
+      )
+
+  (dataReleaseKey, dataPtr) <- allocate
+    (VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh))
+    (\_ -> VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh))
+
+  liftIO $ mapM_ (\(idx, vertex) ->
+    poke (castPtr (dataPtr `plusPtr` idx)) vertex
+    )
+    (zip [0..] (V.toList vertices))
+
+  release dataReleaseKey
+
+  return mesh