minesweeper-0.8.8: Transition/Managed.hs

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' <- renderSquare ost' 
            = [(p, q) | p <- nub $ newChanges ++ l, let q = f p, q /= f' p]

    newChanges = changedSquares e (state ost) (state st)

    f  = renderSquare $ 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 )