new modules

This commit is contained in:
nek0 2022-12-01 21:16:51 +01:00
parent d3636f890e
commit 9dca7c85e0
2 changed files with 98 additions and 0 deletions

32
src/Memory.hs Normal file
View file

@ -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

66
src/Mesh.hs Normal file
View file

@ -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