{-# 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 tx) <- 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 playerPos@(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) <- atomically $ readTVar (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 p) -> bindPropTexture p) stageSet V.mapM_ (\(Cast c) -> bindPropTexture c) cast R.draw va ib sh