haskelloids/src/StateMachine.hs

41 lines
895 B
Haskell

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module StateMachine where
import Control.Concurrent.MVar
import Control.Monad (void)
import Affection
import Types
import InGame
import Menu
instance StateMachine UserData State where
smLoad Menu = (\ud -> loadMenu (smClean Menu ud >> smLoad InGame ud) ud)
smLoad InGame = (\ud -> loadGame
(smClean InGame ud >> smLoad Menu ud)
(smClean InGame ud >> smLoad InGame ud)
ud
)
smUpdate Menu = updateMenu
smUpdate InGame = updateGame
smDraw Menu = drawMenu
smDraw InGame = drawGame
smEvent _ _ _ = return ()
smClean _ ud = do
(UUIDClean uuwin uukbd) <- liftIO $ readMVar (stateUUIDs ud)
let (Subsystems win kbd) = subsystems ud
mapM_ (partUnSubscribe win) uuwin
mapM_ (partUnSubscribe kbd) uukbd
void $ liftIO $ swapMVar (stateUUIDs ud) (UUIDClean [] [])