haskelloids/src/StateMachine.hs

41 lines
895 B
Haskell
Raw Permalink Normal View History

2017-12-22 08:01:07 +00:00
{-# OPTIONS_GHC -fno-warn-orphans #-}
2017-02-20 19:51:33 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
module StateMachine where
2020-05-04 19:17:06 +00:00
import Control.Concurrent.MVar
import Control.Monad (void)
2017-12-16 10:55:30 +00:00
import Affection
2017-02-20 19:51:33 +00:00
import Types
2017-12-20 01:00:28 +00:00
import InGame
2017-12-16 10:55:30 +00:00
import Menu
2017-02-20 19:51:33 +00:00
2020-05-04 19:17:06 +00:00
instance StateMachine UserData State where
smLoad Menu = (\ud -> loadMenu (smClean Menu ud >> smLoad InGame ud) ud)
2017-02-20 19:51:33 +00:00
2020-05-04 19:17:06 +00:00
smLoad InGame = (\ud -> loadGame
(smClean InGame ud >> smLoad Menu ud)
(smClean InGame ud >> smLoad InGame ud)
ud
)
2017-02-20 19:51:33 +00:00
2017-12-16 10:55:30 +00:00
smUpdate Menu = updateMenu
2017-02-20 19:51:33 +00:00
2017-12-20 01:00:28 +00:00
smUpdate InGame = updateGame
2017-02-20 19:51:33 +00:00
2017-12-19 05:49:41 +00:00
smDraw Menu = drawMenu
2017-02-20 19:51:33 +00:00
2017-12-20 01:00:28 +00:00
smDraw InGame = drawGame
2017-12-19 16:30:44 +00:00
2020-05-04 19:17:06 +00:00
smEvent _ _ _ = return ()
2017-12-20 01:00:28 +00:00
2020-05-04 19:17:06 +00:00
smClean _ ud = do
(UUIDClean uuwin uukbd) <- liftIO $ readMVar (stateUUIDs ud)
let (Subsystems win kbd) = subsystems ud
2017-12-20 01:00:28 +00:00
mapM_ (partUnSubscribe win) uuwin
mapM_ (partUnSubscribe kbd) uukbd
2020-05-04 19:17:06 +00:00
void $ liftIO $ swapMVar (stateUUIDs ud) (UUIDClean [] [])