41 lines
895 B
Haskell
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 [] [])
|