module Transition.Response ( buildContResponse , buildTickResponse , contResponses , tickResponses , changedSquares ) where import Core.Square import Event import State import State.Functions import Transition.Graphics import Data.Maybe import Data.List import qualified Data.ChangeMap as M import qualified Data.ChangeSet as S --------------------------------------------------- main buildContResponse :: Eq r => (e -> Bool) -> [st -> r] -> e -> st -> st -> [r] buildContResponse isInit resp e ost st = [ x | f <- resp , let x = f st , isInit e || x /= f ost ] contResponses = [ ShowInfo . infoString , ShowTime . timeString ] buildTickResponse :: (e -> Bool) -> [(st -> Bool, st -> r)] -> e -> st -> st -> [r] buildTickResponse isInit triggers e ost st = [ f st | (p, f) <- triggers , p st , isInit e || not (p ost) ] tickResponses = [ (prefInterrupt, PopUpPreferences . configuration) , (scoreInterrupt, popUpNewScore) ] prefInterrupt st = fmap snd (interrupt st) == Just ModifyPreferences scoreInterrupt st = fmap snd (interrupt st) == Just ViewScore popUpNewScore st = PopUpNewScore (configuration st) e l (sortOrder st) where l = currentScores st e | Just e <- scoreEntry st , Just i <- elemIndex e l = Just i | otherwise = Nothing -------------------------------------------------------- changedSquares :: Event -> State -> State -> [Square] changedSquares e ost st = case e of Triggered BusyTick -> maybeToList $ revSquare_ ost Triggered FadeTick -> map fst $ redness ost _ | hiddenTable st /= hiddenTable ost || hint st /= hint ost -- new table simptoms: || length (undo st) < length (undo ost) || size_ st /= size_ ost -> allSquares st _ -> concat -- nub lesz később [ catMaybes $ diff [mouseFocus ost, mouseFocus st] , diff [focus ost, focus st] , S.changes (marked g) , M.changes (revealResults g) , M.changes (hiddenProbs g) ] where g = game st diff [x, y] | x == y = [] diff l = l