{-# LANGUAGE OverloadedStrings #-} module Scenes.Test ( module Test ) where import Affection as A import Linear import qualified Data.Vector.Storable as VS import qualified Data.Vector as V import Data.String (fromString) import Data.Maybe (fromJust) import Control.Concurrent.STM -- internal imports import Types import Classes import Graphics 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 V.empty <*> newTVarIO (PVM identity identity identity) <*> newTVarIO [] loadScene = load isSceneLoaded = liftIO . readTVarIO . testLoaded update = Test.update onEvents = singleHandler render level = liftIO $ do (GLAssets va vb ib sh _) <- atomically (readTMVar $ testGraphics level) (LevelMap layers _ _ tileMap _) <- atomically (readTMVar $ testMap level) stageSet <- readTVarIO (testStageSet level) nonPlayerCast <- readTVarIO (testCast level) powerups <- V.map Cast <$> readTVarIO (testPowerups level) -- A.logIO A.Debug (fromString $ V.foldl (\acc (Cast p) -> acc ++ show p ++ " ") "" powerups) pituicat <- readTVarIO (testPlayer level) let cast = Cast (fromJust pituicat) `V.cons` powerups V.++ nonPlayerCast (V2 px py) = realToFrac <$> pcPos (fromJust pituicat) atomically $ modifyTVar (testMatrices level) $ \pvm -> pvm { pvmV = mkTransformationMat identity (V3 (400 - px) (300 - py) 0) } (PVM p v m) <- readTVarIO (testMatrices level) let (indices, vertices) = populate layers stageSet cast bind va bind vb bind ib bind sh setUniform sh "u_mvp" (p !*! v !*! m) write vb 0 vertices write ib 0 (VS.map fromIntegral indices) bind (tileMapTexture tileMap) V.mapM_(\(StageSet prop) -> bindPropTexture prop) stageSet V.mapM_(\(Cast c) -> bindPropTexture c) cast R.draw va ib sh