128 lines
3.7 KiB
Haskell
128 lines
3.7 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) <- 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))
|
|
(\_ -> 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
|