vulkan-tutorial/src/Mesh.hs

226 lines
6.4 KiB
Haskell
Raw Normal View History

2022-12-01 20:16:51 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
2023-05-14 11:28:19 +00:00
{-# LANGUAGE FlexibleContexts #-}
2022-12-01 20:16:51 +00:00
module Mesh where
2022-12-15 04:19:53 +00:00
import Codec.Wavefront
2023-01-02 04:59:59 +00:00
import qualified Control.Concurrent.STM as STM
import qualified Control.Monad as CM (void)
2022-12-01 20:16:51 +00:00
import Control.Monad.IO.Class
2023-05-14 11:28:19 +00:00
import Control.Monad.Reader
2022-12-01 20:16:51 +00:00
import Control.Monad.Trans.Resource
2023-01-02 04:59:59 +00:00
import qualified Data.Map.Strict as M
2023-05-16 09:14:46 +00:00
import Data.Maybe (fromMaybe)
2022-12-01 20:16:51 +00:00
import qualified Data.Vector as V
import Foreign
2023-05-16 09:14:46 +00:00
import Linear (V2(..), V3(..), V4(..))
2022-12-01 20:16:51 +00:00
import qualified VulkanMemoryAllocator as VMA
import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Zero as Vk
-- internal imports
import Types
2023-05-14 11:28:19 +00:00
import Sync
2022-12-01 20:16:51 +00:00
loadMeshes
2023-05-14 11:28:19 +00:00
:: (MonadReader ReadState m, MonadResource m, MonadFail m)
=> VMA.Allocator
-> UploadContext
-> Vk.Queue
-> Vk.Device
-> m ()
loadMeshes allocator uploadContext queue device = do
2023-01-02 04:59:59 +00:00
let triangle = V.fromList
2023-05-17 03:52:41 +00:00
[ Vertex (V3 0.5 0 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
, Vertex (V3 (-0.5) 0 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
, Vertex (V3 0 1 0) (V3 0 0 0) (V4 0 1 0 1) (V2 0 0)
2023-01-02 04:59:59 +00:00
]
2023-05-14 11:28:19 +00:00
triMesh <- uploadMesh triangle allocator uploadContext queue device
2023-05-15 04:45:12 +00:00
maskMesh <- loadFromObj
2023-05-16 09:14:46 +00:00
"./assets/models/jaeger.obj"
2023-05-15 04:45:12 +00:00
allocator
uploadContext
queue
device
2023-01-02 04:59:59 +00:00
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
2022-12-01 20:16:51 +00:00
uploadMesh
:: (MonadResource m, MonadFail m)
=> V.Vector Vertex
-> VMA.Allocator
2023-05-14 11:28:19 +00:00
-> UploadContext
-> Vk.Queue
-> Vk.Device
2022-12-01 20:16:51 +00:00
-> m Mesh
2023-05-14 11:28:19 +00:00
uploadMesh vertices allocator uploadContext queue device = do
let bufferSize = fromIntegral $ V.length vertices * sizeOf (undefined :: Vertex)
stagingBufferCrateInfo = Vk.zero
{ Vk.size = bufferSize
, Vk.usage = Vk.BUFFER_USAGE_TRANSFER_SRC_BIT
2022-12-01 20:16:51 +00:00
}
2023-05-14 11:28:19 +00:00
stagingAllocationCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_CPU_ONLY
2022-12-01 20:16:51 +00:00
} :: VMA.AllocationCreateInfo
2023-05-14 11:28:19 +00:00
(stagingReleaseKey, stagingBuffer) <- do
(releaseKey, (buffer, bAllocation, bInfo)) <-
VMA.withBuffer allocator stagingBufferCrateInfo stagingAllocationCreateInfo allocate
return (releaseKey, AllocatedBuffer
{ bufferInfo = bInfo
, bufferAllocation = bAllocation
, allocatedBuffer = buffer
})
2023-04-29 00:10:27 +00:00
(dataReleaseKey, dataPtr) <-
2023-05-14 11:28:19 +00:00
VMA.withMappedMemory allocator (bufferAllocation stagingBuffer) allocate
2022-12-01 20:16:51 +00:00
2023-05-14 11:28:19 +00:00
liftIO $ V.mapM_ (\(idx, vertex) ->
poke
(castPtr dataPtr `plusPtr` (idx * sizeOf vertex))
vertex
2022-12-01 20:16:51 +00:00
)
2023-05-14 11:28:19 +00:00
(V.zip
(V.fromList [0..])
vertices
)
liftIO $ release dataReleaseKey
let vertexBufferCreateInfo = Vk.zero
{ Vk.size = bufferSize
, Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT .|. Vk.BUFFER_USAGE_TRANSFER_DST_BIT
}
allocationCreateInfo = Vk.zero
{ VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY
} :: VMA.AllocationCreateInfo
mesh <- do
(buffer, bAllocation, bInfo) <- snd <$>
VMA.withBuffer allocator vertexBufferCreateInfo allocationCreateInfo allocate
return $ Mesh
{ meshVertices = vertices
, meshBuffer = AllocatedBuffer
{ bufferInfo = bInfo
, bufferAllocation = bAllocation
, allocatedBuffer = buffer
}
}
immediateSubmit uploadContext queue device$ \cmd -> do
let copy = V.singleton $ Vk.BufferCopy
{ size = bufferSize
, dstOffset = 0
, srcOffset = 0
}
Vk.cmdCopyBuffer cmd (allocatedBuffer stagingBuffer) (allocatedBuffer $ meshBuffer mesh) copy
2022-12-01 20:16:51 +00:00
2023-05-14 11:28:19 +00:00
release stagingReleaseKey
2022-12-01 20:16:51 +00:00
return mesh
2022-12-15 04:19:53 +00:00
loadFromObj
:: (MonadResource m, MonadFail m)
=> FilePath
2022-12-17 06:39:45 +00:00
-> VMA.Allocator
2023-05-14 11:28:19 +00:00
-> UploadContext
-> Vk.Queue
-> Vk.Device
2022-12-15 04:19:53 +00:00
-> m Mesh
2023-05-14 11:28:19 +00:00
loadFromObj filepath vma uploadContext queue device = do
2022-12-17 06:39:45 +00:00
eitherObj <- liftIO $ fromFile filepath
case eitherObj of
Left err ->
error ("loadFromObj: loading mesh data: " <> err)
Right obj -> do
2023-05-16 09:14:46 +00:00
let vertices = digestFaces (objFaces obj) (objLocations obj) (objTexCoords obj)
2023-05-14 11:28:19 +00:00
uploadMesh vertices vma uploadContext queue device
2022-12-17 06:39:45 +00:00
where
2023-05-16 09:14:46 +00:00
digestFaces
:: V.Vector (Element Face) -> V.Vector Location -> V.Vector TexCoord -> V.Vector Vertex
digestFaces faces locations texCoords =
2022-12-17 06:39:45 +00:00
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
2023-05-16 09:14:46 +00:00
uv = faceIndexToUV faceIndex texCoords
2022-12-17 06:39:45 +00:00
in
2023-05-16 09:14:46 +00:00
Vertex position normal color uv
2022-12-17 06:39:45 +00:00
)
(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
2023-05-16 09:14:46 +00:00
faceIndexToUV :: FaceIndex -> V.Vector TexCoord -> V2 Float
faceIndexToUV index texCoords =
let TexCoord r s _ =
texCoords V.!
(fromMaybe (error "no UV coordinates present") (faceTexCoordIndex index) - 1)
in
V2 r s
2023-05-20 16:36:31 +00:00
compactDraws
:: M.Map String Mesh
-> M.Map String Material
-> V.Vector RenderObject
-> V.Vector IndirectBatch
compactDraws meshLib materialLib objects =
V.foldl
(\acc (index, RenderObject mesh material _) ->
let newDraw = IndirectBatch
{ batchMesh = meshLib M.! mesh
, batchMaterial = materialLib M.! material
, batchFirst = index
, batchCount = 1
}
sameMesh = not (V.null acc) && (meshLib M.! mesh == batchMesh (V.last acc))
sameMaterial = not (V.null acc) && (materialLib M.! material == batchMaterial (V.last acc))
in
if sameMesh && sameMaterial
then
V.init acc `V.snoc` ((V.last acc)
{ batchCount = batchCount (V.last acc) + 1
})
else
acc `V.snoc` newDraw
)
V.empty
(V.zip
(V.fromList [0..])
objects
)