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-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
|
2018-02-17 01:36:06 +00:00
|
|
|
|
2020-05-05 08:26:16 +00:00
|
|
|
instance StateMachine UserData State where
|
2018-06-08 23:17:03 +00:00
|
|
|
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-06-08 23:17:03 +00:00
|
|
|
|
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
|