2017-02-20 19:51:33 +00:00
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
|
|
|
|
module StateMachine where
|
|
|
|
|
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
|
|
|
|
|
|
|
instance StateMachine State UserData where
|
2017-12-20 01:00:28 +00:00
|
|
|
smLoad Menu = loadMenu (smClean Menu >> smLoad InGame)
|
2017-02-20 19:51:33 +00:00
|
|
|
|
2017-12-21 04:21:20 +00:00
|
|
|
smLoad InGame = loadGame (smClean InGame >> smLoad Menu) (smClean InGame >> smLoad InGame)
|
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
|
|
|
|
|
|
|
smEvent _ _ = return ()
|
2017-12-20 01:00:28 +00:00
|
|
|
|
|
|
|
smClean _ = do
|
|
|
|
ud <- getAffection
|
|
|
|
let (UUIDClean uuwin uukbd) = stateUUIDs ud
|
|
|
|
(Subsystems win kbd) = subsystems ud
|
|
|
|
mapM_ (partUnSubscribe win) uuwin
|
|
|
|
mapM_ (partUnSubscribe kbd) uukbd
|
|
|
|
putAffection ud
|
|
|
|
{ stateUUIDs = UUIDClean [] []
|
|
|
|
}
|