tracer/src/StateMachine.hs

{-# LANGUAGE MultiParamTypeClasses #-}

module StateMachine where

import Affection

import Types

import Load
import Test

instance StateMachine State UserData where
  smLoad Menu = loadMap

  smLoad Load = loadLoad

  smUpdate Menu = updateMap

  smUpdate Load = updateLoad

  smDraw Menu = drawMap

  smDraw Load = drawLoad

  smEvent _ evs = do
    Subsystems w m <- subsystems <$> getAffection
    _ <- consumeSDLEvents w =<< consumeSDLEvents m evs
    return ()

  smClean _ = do
    ud <- getAffection
    let Subsystems w m = subsystems ud
        toClean        = uuid ud
    mapM_ (\u -> do
      partUnSubscribe w u
      partUnSubscribe m u
      ) toClean
    putAffection ud
      { uuid = []
      }