tracer/src/StateMachine.hs

43 lines
1 KiB
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-10-12 12:26:06 +00:00
import Menu.Connect
2018-10-12 19:40:16 +00:00
import Menu.Adjust
2018-06-28 19:07:58 +00:00
import MainGame.WorldMap
import MainGame.MindMap
2018-10-12 19:40:16 +00:00
import Util
2020-05-05 08:26:16 +00:00
instance StateMachine UserData State where
smLoad Load = loadLoad
2018-10-12 12:26:06 +00:00
smLoad (Menu Connect) = loadMenu
2020-05-05 08:26:16 +00:00
smLoad (Menu (Adjust a c)) = (\ud -> loadAdjust ud a c (loadMenu ud))
2018-10-08 21:36:52 +00:00
smLoad (Main _) = loadMap
2018-10-08 21:36:52 +00:00
smUpdate Load = updateLoad
2018-10-12 12:26:06 +00:00
smUpdate (Menu Connect) = updateMenu
2020-05-05 08:26:16 +00:00
smUpdate (Menu (Adjust _ _)) = const $ const (return ())
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-10-08 21:36:52 +00:00
smDraw Load = drawLoad
2018-10-12 12:26:06 +00:00
smDraw (Menu Connect) = drawMenu
2020-05-05 08:26:16 +00:00
smDraw (Menu (Adjust _ _)) = (\ud -> drawMenu ud >> drawAdjust (nano ud))
2018-06-28 19:07:58 +00:00
smDraw (Main WorldMap) = drawMap
smDraw (Main MindMap) = drawMind
2018-02-07 00:18:16 +00:00
2020-05-05 08:26:16 +00:00
smEvent _ ud evs = do
let Subsystems w m k j _ = subsystems ud
2018-10-08 16:54:23 +00:00
_ <- consumeSDLEvents j =<<
consumeSDLEvents k =<<
consumeSDLEvents w =<<
consumeSDLEvents m evs
2018-02-07 00:18:16 +00:00
return ()
2018-10-12 19:40:16 +00:00
smClean _ = fullClean