pituicat/src/StateMachine.hs

61 lines
1.6 KiB
Haskell

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