pituicat/src/Scenes/Test.hs

70 lines
1.5 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test
( module Test
) where
import Affection as A
import qualified Data.Vector.Storable as VS
import qualified Data.Vector as V
import Data.Maybe (fromJust)
import Control.Concurrent.STM
-- internal imports
import Types
import Classes
import Renderer as R
import Scenes.Test.Types as Test
import Scenes.Test.Util as Test
import Scenes.Test.Load as Test
import Scenes.Test.Update as Test
import Scenes.Test.EventHandler as Test
instance Scene Test where
initScene =
Test
<$> newEmptyTMVarIO
<*> newEmptyTMVarIO
<*> newTVarIO False
<*> newTVarIO Nothing
<*> newTVarIO V.empty
<*> newTVarIO V.empty
<*> newTVarIO []
loadScene = load
isSceneLoaded = liftIO . readTVarIO . testLoaded
update = Test.update
onEvents = singleHandler
render level = liftIO $ do
(GLAssets va vb ib sh tx) <- atomically (readTMVar $ testGraphics level)
(LevelMap layers _ _ tileMap _) <-
atomically (readTMVar $ testMap level)
stageSet <- readTVarIO (testStageSet level)
nonPlayerCast <- readTVarIO (testCast level)
pituicat <- atomically $ readTVar (testPlayer level)
let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
let (indices, vertices) = populate layers stageSet cast
bind va
bind vb
bind ib
write vb 0 vertices
write ib 0 (VS.map fromIntegral indices)
bind (tileMapTexture tileMap)
V.mapM_ (\(StageSet p) -> bindPropTexture p) stageSet
V.mapM_ (\(Cast c) -> bindPropTexture c) cast
R.draw va ib sh