minesweeper-0.9.1: Transition/Response.hs

{-# LANGUAGE PatternGuards #-}

module Transition.Response
    ( buildContResponse
    , buildTickResponse
    , contResponses
    , tickResponses
    , changedSquares
    ) where

import Core.Square
import Event
import Configuration
import Preferences
import Table
import State
import State.Functions
import Transition.Graphics

import Data.Maybe
import Data.SetClass (toList)
import Data.List

--------------------------------------------------- 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 . getInfo
    , ShowTime . getTimeInfo
    ]

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 . preferences)
    , (scoreInterrupt, popUpNewScore)
    ]

prefInterrupt st 
    = fmap snd (interrupt st) == Just ModifyPreferences

scoreInterrupt st 
    = fmap snd (interrupt st) == Just ViewScore


popUpNewScore st
    = PopUpNewScore (preferences st) e l (sortOrder st)
 where
    l = currentScores st
    e | Just e <- scoreEntry st
      , Just i <- elemIndex e l
          = Just i
      | otherwise 
          = Nothing

allSquares 
    = squares . size . configuration . preferences

--------------------------------------------------------


changedSquares :: Event -> State -> State -> [Square]
changedSquares e ost st = case e of

    Triggered BusyTick  -> map revSquare $ take 1 $ revealing 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
        -> toList $ allSquares st

    _   -> concat       -- nub not necessary
        [ catMaybes $ diff [mouseFocus ost, mouseFocus st]
        , diff [focus ost, focus st]
        ] ++ allChanges g
 where
    g = game st

    diff :: Eq a => [a] -> [a]
    diff [x, y] | x == y = []
    diff l = l