{-# 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 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 instance Scene Test where initScene = Test <$> newEmptyTMVarIO <*> newEmptyTMVarIO <*> newTVarIO False <*> newTVarIO V.empty <*> newTVarIO V.empty loadScene = load isSceneLoaded = liftIO . readTVarIO . testLoaded update = Test.update onEvents _ _ = return () 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) cast <- readTVarIO (testCast level) 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