tracer/src/StateMachine.hs

42 lines
774 B
Haskell
Raw Normal View History

2018-02-07 00:18:16 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
module StateMachine where
import Affection
import Types
import Load
2018-06-25 21:59:12 +00:00
import MainGame
2018-02-07 00:18:16 +00:00
instance StateMachine State UserData where
2018-06-25 21:59:12 +00:00
smLoad Main = loadMap
2018-02-07 00:18:16 +00:00
smLoad Load = loadLoad
2018-06-25 21:59:12 +00:00
smUpdate Main = updateMap
2018-02-07 00:18:16 +00:00
smUpdate Load = updateLoad
2018-06-25 21:59:12 +00:00
smDraw Main = drawMap
2018-02-07 00:18:16 +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 = []
}