{-# 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