start filling the state
This commit is contained in:
parent
1d4372a6b5
commit
a1e0211b0f
4 changed files with 43 additions and 13 deletions
13
src/Main.hs
13
src/Main.hs
|
@ -9,6 +9,8 @@ import Control.Monad.Loops
|
|||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Bits
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Vector as V
|
||||
import Data.Word
|
||||
import qualified SDL hiding (V2)
|
||||
import qualified Vulkan as Vk
|
||||
|
@ -22,8 +24,15 @@ import Types
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
container <- STM.newEmptyTMVarIO
|
||||
runRender (ReadState container) $ do
|
||||
renderablesContainer <- STM.newTMVarIO (V.empty)
|
||||
meshMap <- STM.newTMVarIO (M.empty)
|
||||
materialMap <- STM.newTMVarIO (M.empty)
|
||||
let initState = ReadState
|
||||
{ renderables = renderablesContainer
|
||||
, meshLibrary = meshMap
|
||||
, materialLibrary = materialMap
|
||||
}
|
||||
runRender initState $ do
|
||||
engineData <- initEngine
|
||||
|
||||
SDL.showWindow $ engineWindow engineData
|
||||
|
|
23
src/Mesh.hs
23
src/Mesh.hs
|
@ -5,9 +5,13 @@ 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
|
||||
|
@ -23,14 +27,27 @@ import qualified Vulkan.Zero as Vk
|
|||
import Types
|
||||
|
||||
loadMeshes
|
||||
:: V.Vector Vertex
|
||||
loadMeshes =
|
||||
V.fromList
|
||||
:: 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
|
||||
|
|
|
@ -7,6 +7,7 @@ import Control.Concurrent.STM.TMVar as STM
|
|||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Vector as V
|
||||
import Foreign
|
||||
import Foreign.C.Types (CInt)
|
||||
|
@ -159,14 +160,16 @@ data Material = Material
|
|||
deriving (Show)
|
||||
|
||||
data RenderObject = RenderObject
|
||||
{ objectMesh :: Mesh
|
||||
, objectMaterial :: Material
|
||||
{ objectMesh :: String
|
||||
, objectMaterial :: String
|
||||
, objectMatrix :: M44 Float
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
newtype ReadState = ReadState
|
||||
data ReadState = ReadState
|
||||
{ renderables :: STM.TMVar (V.Vector RenderObject)
|
||||
, meshLibrary :: STM.TMVar (M.Map String Mesh)
|
||||
, materialLibrary :: STM.TMVar (M.Map String Material)
|
||||
}
|
||||
|
||||
newtype RenderReader rd m a = RenderReader
|
||||
|
|
|
@ -53,6 +53,7 @@ executable vulkan-tutorial
|
|||
, vector
|
||||
, resourcet
|
||||
, mtl
|
||||
, containers
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
Loading…
Reference in a new issue