module Transition.Managed ( initState , stopState , transition , Transition , State ) where import Transition.Graphics import Core.Square import State.Functions hiding (initState, stopState) import qualified State.Functions as F import Transition import Transition.Action import Transition.State import Transition.Response import Event import qualified State as S import Driver.Log import Data.List import Data.Maybe import Control.Monad import Data.Binary import Data.DeriveTH import Data.Derive.Binary --------------------------------------------------- main data State = State { drawing :: Bool , changes :: Maybe (S.State, [Square]) -- Nothing: update needed , state :: S.State } deriving (Show) ---------------- initState a b = State { drawing = False , changes = Nothing , state = F.initState a b } stopState st = st { drawing = False , changes = Nothing , state = F.stopState $ state st } ------------------------------------------------ transition :: Event -> Transition State Event [Response] transition = buildTransition (==Init) triggers'' (\e -> fmap initDrawing . nextState' e) responses triggers'' = [(p . state, e, w . state) | (p, e, w) <- triggers'] nextState' InfoDrawingDone _ = Nothing nextState' DrawingDone st = Just $ st { drawing = False } nextState' UpdateTable st = Just $ st { changes = Nothing } nextState' e@(PreferencesClosed (Just _)) st -- elég lenne csak a nagyon megváltozottra = lift nextState e $ st { changes = Nothing } nextState' e st = lift nextState e st initDrawing st | Just (_, []) <- changes st = st | drawing st = st | otherwise = st { drawing = True, changes = Just (state st, []) } lift f e ost | Just st <- f e $ state ost = Just $ ost { changes = fmap (mapSnd (changedSquares e (state ost) st ++)) $ changes ost, state = st } | otherwise = Nothing mapSnd f (a, b) = (a, f b) ------------------------------------ responses' e ost st | drawing st && (not (drawing ost) || e == DrawingDone) = [DrawSquares (size_ $ state st) ch] | otherwise = [] where ch | isNothing (changes ost) || e == UpdateTable = [(p, f p) | p <- squares . size_ . state $ st] | Just (ost', l) <- changes ost , f' <- squareState ost' = [(p, q) | p <- nub $ newChanges ++ l, let q = f p, q /= f' p] newChanges = changedSquares e (state ost) (state st) f = squareState $ state st responses :: Event -> State -> State -> [Response] responses e ost st = buildContResponse (==Init) [f . state | f <- contResponses] e ost st ++ buildTickResponse (==Init) [(p . state, f . state) | (p, f) <- tickResponses] e ost st ++ responses' e ost st -- ++ buildTickResponse (==DrawingDone) [(drawing, drawSquares)] e ost st $( derive makeBinary ''State )