haskelloids/src/StateMachine.hs

36 lines
778 B
Haskell
Raw 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
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 [] []
}