2018-02-07 00:18:16 +00:00
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
|
|
|
|
module StateMachine where
|
|
|
|
|
|
|
|
import Affection
|
|
|
|
|
|
|
|
import Types
|
|
|
|
|
2018-06-08 23:17:03 +00:00
|
|
|
import Load
|
2018-06-28 19:07:58 +00:00
|
|
|
import MainGame.WorldMap
|
|
|
|
import MainGame.MindMap
|
2018-02-17 01:36:06 +00:00
|
|
|
|
2018-02-07 00:18:16 +00:00
|
|
|
instance StateMachine State UserData where
|
2018-06-28 19:07:58 +00:00
|
|
|
smLoad (Main _) = loadMap
|
2018-02-07 00:18:16 +00:00
|
|
|
|
2018-06-08 23:17:03 +00:00
|
|
|
smLoad Load = loadLoad
|
|
|
|
|
2018-06-28 19:07:58 +00:00
|
|
|
smUpdate (Main WorldMap) = updateMap
|
|
|
|
smUpdate (Main MindMap) = updateMind
|
2018-02-07 00:18:16 +00:00
|
|
|
|
2018-06-08 23:17:03 +00:00
|
|
|
smUpdate Load = updateLoad
|
|
|
|
|
2018-06-28 19:07:58 +00:00
|
|
|
smDraw (Main WorldMap) = drawMap
|
|
|
|
smDraw (Main MindMap) = drawMind
|
2018-02-07 00:18:16 +00:00
|
|
|
|
2018-06-08 23:17:03 +00:00
|
|
|
smDraw Load = drawLoad
|
|
|
|
|
2018-02-07 00:18:16 +00:00
|
|
|
smEvent _ evs = do
|
2018-06-23 22:42:39 +00:00
|
|
|
Subsystems w m k <- subsystems <$> getAffection
|
|
|
|
_ <- consumeSDLEvents k =<< consumeSDLEvents w =<< consumeSDLEvents m evs
|
2018-02-07 00:18:16 +00:00
|
|
|
return ()
|
|
|
|
|
|
|
|
smClean _ = do
|
|
|
|
ud <- getAffection
|
2018-06-23 22:42:39 +00:00
|
|
|
let Subsystems w m k = subsystems ud
|
|
|
|
toClean = uuid ud
|
2018-02-07 00:18:16 +00:00
|
|
|
mapM_ (\u -> do
|
|
|
|
partUnSubscribe w u
|
|
|
|
partUnSubscribe m u
|
2018-06-23 22:42:39 +00:00
|
|
|
partUnSubscribe k u
|
2018-02-07 00:18:16 +00:00
|
|
|
) toClean
|
|
|
|
putAffection ud
|
|
|
|
{ uuid = []
|
|
|
|
}
|