vulkan-tutorial/src/Mesh.hs

67 lines
1.8 KiB
Haskell

{-# 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(..), V4(..))
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 0 0) (V4 0 1 0 1)
, Vertex (V3 (-0.5) 0.5 0) (V3 0 0 0) (V4 0 1 0 1)
, Vertex (V3 0 (-0.5) 0) (V3 0 0 0) (V4 0 1 0 1)
]
uploadMesh
:: (MonadResource m, MonadFail m)
=> V.Vector Vertex
-> VMA.Allocator
-> m Mesh
uploadMesh vertices allocator = do
let bufferCreateInfo = Vk.zero
{ Vk.size = fromIntegral $ sizeOf (Vertex (V3 0 0 0) (V3 0 0 0 ) (V4 0 0 0 0))
, 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
putStrLn "destroying mesh"
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