{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} module Mesh where import Codec.Wavefront import qualified Control.Concurrent.STM as STM import qualified Control.Monad as CM (void) import Control.Monad.IO.Class import Control.Monad.Reader (asks) import Control.Monad.Trans.Resource import qualified Data.Map.Strict as M 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 :: VMA.Allocator -> Render () loadMeshes allocator = do let triangle = 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) ] triMesh <- uploadMesh triangle allocator maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator meshLib <- asks meshLibrary liftIO $ STM.atomically $ do meshMap <- STM.readTMVar meshLib let newMap = M.insert "triangle" triMesh $ M.insert "mask" maskMesh meshMap CM.void $ STM.swapTMVar meshLib newMap uploadMesh :: (MonadResource m, MonadFail m) => V.Vector Vertex -> VMA.Allocator -> m Mesh uploadMesh vertices allocator = do let bufferCreateInfo = Vk.zero { Vk.size = fromIntegral $ V.length vertices * 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, bAllocation, _) <- VMA.createBuffer allocator bufferCreateInfo allocationCreateInfo return (Mesh vertices (AllocatedBuffer buffer bAllocation)) ) (\(Mesh _ (AllocatedBuffer buffer bAllocation)) -> do putStrLn "destroying mesh" VMA.destroyBuffer allocator buffer bAllocation ) (dataReleaseKey, dataPtr) <- allocate (VMA.mapMemory allocator (bufferAllocation $ meshBuffer mesh)) (\_ -> do VMA.unmapMemory allocator (bufferAllocation $ meshBuffer mesh) ) liftIO $ mapM_ (\(idx, vertex) -> poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex ) (zip [0..] (V.toList vertices)) release dataReleaseKey return mesh loadFromObj :: (MonadResource m, MonadFail m) => FilePath -> VMA.Allocator -> m Mesh loadFromObj filepath vma = do eitherObj <- liftIO $ fromFile filepath case eitherObj of Left err -> error ("loadFromObj: loading mesh data: " <> err) Right obj -> do let vertices = digestFaces (objFaces obj) (objLocations obj) uploadMesh vertices vma where digestFaces :: V.Vector (Element Face) -> V.Vector Location -> V.Vector Vertex digestFaces faces locations = V.foldl (\acc (Element _ _ _ _ (Face fa fb fc others)) -> if not (null others) then error "loadFromObj: Non-triangular face detected" else let newVertices = V.map (\faceIndex -> let position = faceIndexToPosition faceIndex locations normal = V3 0 0 0 color = V4 1 1 0 1 in Vertex position normal color ) (V.fromList [ fa, fb, fc ]) in acc V.++ newVertices ) V.empty faces faceIndexToPosition :: FaceIndex -> V.Vector Location -> V3 Float faceIndexToPosition index locations = let Location x y z _ = locations V.! (faceLocIndex index - 1) in V3 x y z