minesweeper-0.8.8: Transition/Response.hs

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