module State.Functions where

import Configuration
import State
import Core.Square
import Core.Constraints

import Data.Maybe
import Control.Monad
import System.Random 
import Data.List
import Data.Function
import qualified Data.ChangeMap as M
import qualified Data.Map as MM
import qualified Data.ChangeSet as S

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

resetHiddenProbs c gs = gs
    { maxHiddenProb     = Nothing
    , hiddenProbs       = M.empty
    , noHiddenProbs     = squares (size c) \\ M.keys (revealResults gs)
    }


initGameState :: Configuration -> GameState
initGameState c = resetHiddenProbs c $ GameState
    { constraints       = initConstraints (size c) (mines c)
    , marked            = S.empty
    , alive             = 1
    , constraintsProb   = 1
    , revealResults     = M.empty
    , maxHiddenProb     = undefined
    , hiddenProbs       = undefined
    , noHiddenProbs     = undefined
    }

initState :: String -> StdGen -> State
initState userName seed = loadState $ State
    { userName          = userName
    , undoChangesSeed   = True

    , configuration     = c
    , seed              = seed

    , undo              = []
    , redo              = []

    , focus             = fromJust $ square (size c) 1 1
    , mouseFocus        = Nothing
    , redness           = []

    , scores            = MM.empty
    , sortOrder         = [SA_Time, SA_Alive, SA_Success]

    , timer             = Nothing
    , revealing         = Nothing
    , interrupt         = Nothing
    , hint              = Nothing
--    , hinting           = Nothing

    , game              = error "module State.Functions: game was not defined"
    }
 where
    c = configuration' $ Configuration
        { size              = board 10 10
        , mines             = 20
        , strategy          = Random
        , deathProbRange    = (1,1)
        , allowedDeaths     = 0
        , recursiveReveal   = True
        , undoAllowed       = False
        , hintAllowed       = Nothing
--        , numOfSolutions    = undefined
        }

loadState st = st
    { game = initGameState (configuration st) 
    }

{-
readState a b s = case reads s of
    [(st, s)] | all (==' ') s  -> (True, st)
    _                          -> (False, initState a b)

showState = show . stopState
-}

stopState st = f st { mouseFocus = Nothing }
 where
    f st
        | Just r <- revealing st
        = st { revealing = Just $ r { revResult = Nothing }}
        | otherwise = st

------------------------------------------ configuration


----------------------- phases

-- the game is finised
isFinished st 
    =  S.size (marked g) + M.size (revealResults g) == msize st 
    || alive g == 0
 where g = game st

-- winning position (the timer may be stopped)
playerWins st
    =  isFinished st 
    && alive (game st) > 0

-- the game is not yet started (new)
isNew 
    = null . undo

longInterrupt st
    | Just (b, _) <- interrupt st  = b
    | otherwise = False

-- the table is hidden
hiddenTable st
    =  longInterrupt st
    && isJust (timer st)
    && not (isFinished st)

-- the focus can be moved
focusMoves st
    =  not (longInterrupt st)
    && not (isFinished st)

-- the mouse focus is shown
mouseFocusShown st
    =  focusMoves st    
--    && isNothing (busyAnimation_ st)
    || interrupt st == Just (True, OtherApp)

-- reveal / mark / hint can be done
revealCanBeDone st
    =  markCanBeDone st
    && isNothing (revealing st) 

-- mark can be done
markCanBeDone st
    =  isNothing (interrupt st)
    && not (isFinished st)

-- the timer is active
isActive st 
    =  isNothing (busyAnimation_ st) 
    && isNothing (interrupt st) 
    && isJust (timer st)
    && not (isFinished st)


-------------- attributes

allSolutions = numOfSolutions . configuration

busyAnimation_ = join . fmap busyAnimation . revealing

revSquare_ = fmap revSquare . revealing

size_ = size . configuration

msize g = xSize s * ySize s where s = size_ g

mines_left st 
    = mines (configuration st) - S.size (marked $ game st)

information :: State -> Double
information st 
    | b == 1    = 1
    | otherwise = luckFunction a / luckFunction b
 where
    i = fromIntegral $ allSolutions st
    a = fromIntegral (solutions $ constraints $ game st) / i
    b = 1 / i

allSquares 
    = squares . size . configuration

luck :: State -> Double
luck = luckFunction . alive . game

-------------- other

free g p 
    = not (isRevealed g p) && S.notMember p (marked g)

isRevealed g p  
    = M.member p (revealResults g)

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


eventPos st m 
    = maybe (focus st) (calcSquare st) m

calcSquare = restrictSquare . size_ 

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

showConfiguration c
    = unlines $ filter (not . null)
        [ unwords [show (xSize s) ++ "×" ++ show (ySize s), "table,", show $ mines c, "mines"]
        , showStrategy $ strategy c
        , showDPR $ deathProbRange c
        ]
 where
    s = size c

    showStrategy Random = ""
    showStrategy HighestProb = "least information game"

    showDPR (0,1) = ""
    showDPR (1,1) = "lucky game"
    showDPR _ = ""
            -- (a, b): ha p valséggel halnánk meg, akkor p>a esetén meghalunk, p<b esetén életben maradunk

{-
        , c_allowedDeaths   :: Int
        , c_recursiveReveal :: Bool
        , c_undoAllowed     :: Bool
        , c_hintAllowed     :: Maybe HintType
-}


scoreEntry :: State -> Maybe ScoreEntry
scoreEntry st 
    | Just t <- timer st
    , playerWins st
    = Just $ ScoreEntry 
        { se_name    = userName st
        , se_time    = t + 1        -- felfelé kerekítünk
        , se_alive   = alive $ game st
        , se_deaths  = 0
        , se_history = reverse $ map snd $ undo st
        }
    | otherwise
    = Nothing


maxEntries = 10

currentScores :: State -> [ScoreEntry]
currentScores st 
    = ff $ MM.lookup (configuration st) (scores st)
 where
    ff (Just l) = l
    ff Nothing = []


addScore st
    | Just e <- scoreEntry st
    , st' <- st { scores = MM.alter (Just . maybe [e] (e:)) (configuration st) (scores st) }
    , e `elem` cutScores st'
    = Just $ st' { interrupt = Just (False, ViewScore) }
    | otherwise 
    = Nothing

 where
    cutScores :: State -> [ScoreEntry]
    cutScores st 
        = take maxEntries $ nub $ concat $ transpose [sortByAttr as $ currentScores st | as <- ass]
     where
        ass = [l2 ++ l1 | i <- [1..length (sortOrder st)], let (l1, l2)= splitAt (i-1) (sortOrder st)]

 

sortByAttr :: [ScoreAttr] -> [ScoreEntry] -> [ScoreEntry]
sortByAttr as = sortBy (flip compare `on` createRank as)
 where
    createRank :: [ScoreAttr] -> ScoreEntry -> [Double]
    createRank sl e 
        = [f | x <- sl, (a, f) <- l, a==x]
     where
        l :: [(ScoreAttr, Double)]
        l = [ (SA_Alive, realToFrac (se_alive e))
            , (SA_Time, - fromIntegral (se_time e))
            , (SA_Success, realToFrac $ successFunction (se_time e) (se_alive e))
            ]



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

luckFunction :: Rational -> Double
luckFunction x 
    = max (- 1/2 * logBase 2 (realToFrac x)) 0

-- megmondja hogy óránként várhatóan hányszor tudnánk teljesíteni egy klasszikus játékot
successFunction :: Int -> Rational -> Rational
successFunction time{-in sec-} alive{-probability-}
    = 3600 / fromIntegral time * alive  -- 1s 0.5valség   

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

forgetChanges x = x 
        { marked          = S.forget $ marked x
        , revealResults   = M.forget $ revealResults x
        , hiddenProbs     = M.forget $ hiddenProbs x
        }