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