{-# 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 1 0) (V4 0 0 0 0) , Vertex (V3 (-0.5) 0.5 0) (V3 0 1 0) (V4 0 0 0 0) , Vertex (V3 0 (-0.5) 0) (V3 0 1 0) (V4 0 0 0 0) ] 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