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.IO.Class
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
import qualified Data.Vector as V
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import qualified SDL hiding (V2)
|
import qualified SDL hiding (V2)
|
||||||
import qualified Vulkan as Vk
|
import qualified Vulkan as Vk
|
||||||
|
@ -22,8 +24,15 @@ import Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
container <- STM.newEmptyTMVarIO
|
renderablesContainer <- STM.newTMVarIO (V.empty)
|
||||||
runRender (ReadState container) $ do
|
meshMap <- STM.newTMVarIO (M.empty)
|
||||||
|
materialMap <- STM.newTMVarIO (M.empty)
|
||||||
|
let initState = ReadState
|
||||||
|
{ renderables = renderablesContainer
|
||||||
|
, meshLibrary = meshMap
|
||||||
|
, materialLibrary = materialMap
|
||||||
|
}
|
||||||
|
runRender initState $ do
|
||||||
engineData <- initEngine
|
engineData <- initEngine
|
||||||
|
|
||||||
SDL.showWindow $ engineWindow engineData
|
SDL.showWindow $ engineWindow engineData
|
||||||
|
|
23
src/Mesh.hs
23
src/Mesh.hs
|
@ -5,9 +5,13 @@ module Mesh where
|
||||||
|
|
||||||
import Codec.Wavefront
|
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.IO.Class
|
||||||
|
import Control.Monad.Reader (asks)
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
import Foreign
|
import Foreign
|
||||||
|
@ -23,14 +27,27 @@ import qualified Vulkan.Zero as Vk
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
loadMeshes
|
loadMeshes
|
||||||
:: V.Vector Vertex
|
:: VMA.Allocator
|
||||||
loadMeshes =
|
-> Render ()
|
||||||
V.fromList
|
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.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)
|
, 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
|
uploadMesh
|
||||||
:: (MonadResource m, MonadFail m)
|
:: (MonadResource m, MonadFail m)
|
||||||
=> V.Vector Vertex
|
=> V.Vector Vertex
|
||||||
|
|
|
@ -7,6 +7,7 @@ import Control.Concurrent.STM.TMVar as STM
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Foreign
|
import Foreign
|
||||||
import Foreign.C.Types (CInt)
|
import Foreign.C.Types (CInt)
|
||||||
|
@ -159,14 +160,16 @@ data Material = Material
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
data RenderObject = RenderObject
|
data RenderObject = RenderObject
|
||||||
{ objectMesh :: Mesh
|
{ objectMesh :: String
|
||||||
, objectMaterial :: Material
|
, objectMaterial :: String
|
||||||
, objectMatrix :: M44 Float
|
, objectMatrix :: M44 Float
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
newtype ReadState = ReadState
|
data ReadState = ReadState
|
||||||
{ renderables :: STM.TMVar (V.Vector RenderObject)
|
{ 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
|
newtype RenderReader rd m a = RenderReader
|
||||||
|
|
|
@ -53,6 +53,7 @@ executable vulkan-tutorial
|
||||||
, vector
|
, vector
|
||||||
, resourcet
|
, resourcet
|
||||||
, mtl
|
, mtl
|
||||||
|
, containers
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
Loading…
Reference in a new issue