module GTK.Score 
    ( newScore_
    ) where

import Configuration
import State

import State.Functions

import Graphics.UI.Gtk hiding (Clear, Size, on)
import Graphics.UI.Gtk.Glade 

import Control.Concurrent.MVar
import Control.Monad
import Data.List
import Data.Maybe
import Data.Function
import Numeric

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

attrs_ = [SA_Alive, SA_Time, SA_Success]

setIndex i s =  show i ++ ". " ++ f s  where
    f (_:'.':' ':s) = s
    f s = s



newScore_ :: GladeXML -> IO (Configuration -> Maybe Int -> [ScoreEntry] -> [ScoreAttr] -> IO (Maybe String, [ScoreAttr]))
newScore_ xml = do

    dialog        <- xmlGetWidget xml castToDialog "scoredialog"
    table         <- xmlGetWidget xml castToTable  "scoretable"
    configLabel   <- xmlGetWidget xml castToLabel  "configurationlabel"

    buttons <- mapM (xmlGetWidget xml castToButton) ["sortbyluckiness", "sortbytime", "sortbysuccess"]

    scoreState <- newEmptyMVar :: IO (MVar ([ScoreAttr], Maybe Int, [ScoreEntry]))

    entry <- entryNew
    set entry [ entryHasFrame := False, entryMaxLength := 15, entryWidthChars := 10 ]
    widgetShow entry

    -- create entry labels
    lss <- replicateM maxEntries $ do
        labs@(l:ls) <- replicateM 4 (labelNew Nothing)
        set l [miscXalign := 0]
        sequence_ [set x [miscXalign := 1] | x<- ls]
        mapM_ widgetShow labs
        return labs


    let 
        attachLabels n = do
            tableResize table (1 + n) 4
            sequence_ [tableAttachDefaults table x j (j+1) i (i+1) | (i,labs) <- zip [1..n] lss, (j,x) <- zip [0..] labs]

        removeLabels n = 
            mapM_ (containerRemove table) $ concat $ take n lss

        showEntry ls e
            = zipWithM_ labelSetText ls 
                [ se_name e
                , show_ 2 $ luckFunction $ se_alive e
                , showTime $ se_time e
                , show_ 2 $ realToFrac $ successFunction (se_time e) (se_alive e)
                ]

        addEntry i = do
            containerRemove table (head $ lss !! i)
            tableAttachDefaults table entry 0 1 (i+1) (i+2)

        removeEntry i = do
            containerRemove table entry
            tableAttachDefaults table (head $ lss !! i) 0 1 (i+1) (i+2)

        showEntries = do
            (sl, e, es) <- takeMVar scoreState
            let es' = sortByAttr sl es
                e'  = join $ fmap (\i -> elemIndex (es !! i) es') e
            putMVar scoreState (sl, e', es') 

            sequence_ [set b [buttonLabel :~ setIndex i] | (a, b) <- zip attrs_ buttons, (i, a') <- zip [1::Int ..] sl, a == a']
            ff removeEntry e
            ff addEntry e'
            zipWithM_ showEntry lss es'

        sortScoresBy sa = do
            (sl_old, e, es) <- takeMVar scoreState
            let sl = sa: filter (/=sa) sl_old
            putMVar scoreState (sl, e, es)
            when (sl /= sl_old) showEntries

        initSort b sa = do
            onButtonActivate b $ sortScoresBy sa
            onPressed b $ sortScoresBy sa

    zipWithM_ initSort buttons attrs_

    return $ \c i es attrs -> do

        labelSetText configLabel $ showConfiguration c

        maybe (return ()) (entrySetText entry . se_name . (es!!)) i

        putMVar scoreState (attrs, i, es)

        attachLabels $ length es
        ff addEntry i

        showEntries

        r <- dialogRun dialog

        (attrs', i', _) <- takeMVar scoreState

        widgetHide dialog
        ff removeEntry i'
        removeLabels $ length es

        case r of
            ResponseOk  -> do
                n <- entryGetText entry
                return (fmap (const n) i', attrs')

            _ -> return (Nothing, attrs)


ff f (Just i) = f i
ff _ Nothing  = return ()


showTime :: Int -> String
showTime x = "" .++ day .+ 'd' .++ h .+ 'h' .++ dm .++ m .+ 'm' .++ ds ++ s ++ "s"  where
    (day: h: dm: m: ds: s: _) = map show (d:l)
    (d, l) = mapAccumR divMod x [24,6,10,6,10] 

    infixl 6 .++, .+

    "" .+ _ = ""
    s .+ c = s ++ [c]

    "" .++ "0" = ""
    a .++ b = a ++ b


--show_ :: RealFloat a => Int -> a -> String
show_ :: Int -> Double -> String
show_ i x = showFFloat (Just i) x ""