{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module StateMachine where import Affection import Data.Maybe (isNothing) import Control.Monad (void, when) import Control.Concurrent.STM -- internal imports import Types import Classes -- import State.Loading -- import State.MainGame instance StateMachine GameData State where smLoad Loading gd = do mThreadId <- liftIO $ atomically $ readTVar (gameLoadThread gd) when (isNothing mThreadId) $ do (Stage scene) <- liftIO $ atomically $ readTMVar $ gameScene gd -- ctx <- liftIO $ atomically $ fromJust <$> -- (readTVar $ gameLoadContext gd) ad <- get -- get inner state of engine -- let win = ((\(_, y, _) -> y) $ head $ drawWindows ad) liftIO $ loadScene scene (gameStateLoadProgress gd) -- SDL.glMakeCurrent win (snd $ head $ glContext ad) -- liftIO $ atomically $ writeTVar (gameLoadThread gd) (Just tid) smLoad x _ = error ("State load not yet implemented: " <> show x) smUpdate Loading gd dt = do (Stage scene) <- liftIO $ atomically $ readTMVar $ gameScene gd Classes.update scene dt smUpdate x _ _ = error ("State update not yet implemented: " <> show x) smDraw Loading gd = do (Stage scene) <- liftIO $ atomically $ readTMVar $ gameScene gd render scene smDraw x _ = error ("State draw not yet implemented: " <> show x) smEvent _ gd evs = do let Subsystems w m k _ = gameSubsystems gd void . (consumeSDLEvents k) =<< consumeSDLEvents m =<< consumeSDLEvents w evs smClean x _ = error ("State clean not yet implemented: " <> show x)