diff --git a/src/Memory.hs b/src/Memory.hs new file mode 100644 index 0000000..3c446da --- /dev/null +++ b/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 diff --git a/src/Mesh.hs b/src/Mesh.hs new file mode 100644 index 0000000..3d294f1 --- /dev/null +++ b/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