vulkan-tutorial/src/Mesh.hs
2023-04-29 02:10:27 +02:00

123 lines
3.5 KiB
Haskell

{-# 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 <- do
(buffer, bAllocation, bInfo) <- snd <$>
VMA.withBuffer allocator bufferCreateInfo allocationCreateInfo allocate
return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo))
(dataReleaseKey, dataPtr) <-
VMA.withMappedMemory allocator (bufferAllocation $ meshBuffer mesh) allocate
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