{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2015 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Coin.UI.Widgets.MiniCalendar (
    MiniCalendarWidget,
    miniCalendarNew,
    miniCalendarNew2,
    miniCalendarGetDate,
    miniCalendarGetDate2,
    miniCalendarSetDate,
    miniCalendarOnChange
) where

import qualified System.Glib.Types as Gtk
import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk ( AttrOp(..) )

import Control.Monad
import Data.Maybe
import Data.IORef

import Coin.UI.Builder.GtkUIBuilder
import Coin.UI.Utils.CssUtils
import Coin.UI.Utils.CalendarUtils
import Coin.UI.Utils.Observable
import Coin.Utils.ColorUtils
import Coin.Locale.Translate
import Coin.Config.Version

data MiniCalendarWidget = MiniCalendarWidget {
    miniCalendarContainer  :: Gtk.Box,
    miniCalendarYearLabel  :: Gtk.Label,
    miniCalendarMonthLabel :: Gtk.Label,
    miniCalendarYear       :: IORef Integer,
    miniCalendarMonth      :: IORef Int,
    miniCalendarChange     :: Observable (Integer, Int)
}

instance Gtk.GObjectClass MiniCalendarWidget where
    toGObject = Gtk.toGObject . miniCalendarContainer
    unsafeCastGObject = undefined

instance Gtk.WidgetClass MiniCalendarWidget

miniCalendarNew :: IO MiniCalendarWidget
miniCalendarNew = do
    (year, month, _, _, _) <- calendarGetDate

    refYear  <- newIORef year
    refMonth <- newIORef month
    calendarObservable <- observableNew

    cal <- Gtk.calendarNew
    calStyle <- Gtk.widgetGetStyle cal
    bg <- colorToString <$> Gtk.styleGetBackground calStyle Gtk.StateNormal
    fg <- colorToString <$> Gtk.styleGetText calStyle Gtk.StateNormal
    sb <- colorToString <$> Gtk.styleGetLight calStyle Gtk.StateSelected

    let css = [ cssStyleReset
              , "* {"
              , "    color: " ++ fg ++ ";"
              , "}"
              , if gtkVersionOld then ".frame {" else "frame {"
              , "    background-color: " ++ bg ++ ";"
              , "    border: 1px;"
              , "    border-style: solid;"
              , "    border-radius: 10px;"
              , "    padding: 4px 4px 4px 4px;"
              , "}"
              , if gtkVersionOld then ".label {" else "label {"
              , "    padding: 2px;"
              , "}"
              , if gtkVersionOld then ".button { " else "button {"
              , "    transition: 200ms ease-in-out;"
              , "    font-size: 1.1em;"
              , "    background-color: " ++ bg ++ ";"
              , "    border-color: " ++ bg ++ ";"
              , "    border-radius: 8px 0px 8px 0px;"
              , "    border-width: 1px;"
              , "    border-style: solid;"
              , "    padding: 2px;"
              , "}"
              , "#TodayButton {"
              , "    transition: none;"
              , "    font-size: 1em;"
              , "    border-radius: 8px 0px 8px 0px;"
              , "    padding: 0px 12px 0px 12px;"
              , "}"
              , "#TodayButton:active {"
              , "    background-color: " ++ sb ++ ";"
              , "}"
              , "#Arrow {"
              , "    font-weight: bold;"
              , "    font-size: 2em;"
#ifdef WINDOWS
              , "    padding: 0px 6px 6px 6px;"
#else
              , "    padding: 0px 6px 0px 6px;"
#endif
              , "    border-style: none;"
              , "    border-radius: 12px;"
              , "}"
              , "#Arrow:hover {"
              , "    background-color: " ++ sb ++ ";"
              , "}"
              , "#TodayButton:hover {"
              , "    border-color: " ++ sb ++ ";"
              , "}"
              ]

    (getObject, root) <- uiBuildGtk $ do
        packing Gtk.PackNatural 0
        vbox Nothing False 0 $ hbox Nothing False 0 $ do
            globalCss css
            hbox Nothing False 0 $ do
                frame Nothing Nothing $ do
                    grid Nothing $ do
                        gridAttach 0 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "monthLeft") "<"
                        gridAttach 1 0 3 1 $ do
                            widgetAttrs [ Gtk.widgetWidthRequest := 100 ]
                            label (Just "month") (show $ intToMonth month)
                        gridAttach 4 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "monthRight") ">"
                        gridAttach 5 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "yearLeft") "<"
                        gridAttach 6 0 3 1 $ do
                            widgetAttrs [ Gtk.widgetWidthRequest := 60 ]
                            label (Just "year") (show year)
                        gridAttach 9 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "yearRight") ">"
                        gridAttach 10 0 3 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "TodayButton" ]
                            button (Just "today") (__"Today")

    let monthLabel = Gtk.castToLabel . fromJust . getObject $ "month"
    let yearLabel  = Gtk.castToLabel . fromJust . getObject $ "year"
    let monthLeft   = Gtk.castToButton . fromJust . getObject $ "monthLeft"
    let monthRight  = Gtk.castToButton . fromJust . getObject $ "monthRight"
    let yearLeft    = Gtk.castToButton . fromJust . getObject $ "yearLeft"
    let yearRight   = Gtk.castToButton . fromJust . getObject $ "yearRight"
    let todayButton = Gtk.castToButton . fromJust . getObject $ "today"

    let miniCalendarWidget = MiniCalendarWidget
                                 (Gtk.castToBox root)
                                 yearLabel
                                 monthLabel
                                 refYear
                                 refMonth
                                 calendarObservable

    void $ Gtk.on todayButton Gtk.buttonActivated $ do
        (y, m, _, _, _) <- calendarGetDate
        miniCalendarSetDate miniCalendarWidget y m

    void $ Gtk.on monthLeft Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget y (m - 1)

    void $ Gtk.on monthRight Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget y (m + 1)

    void $ Gtk.on yearLeft Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget (y - 1) m

    void $ Gtk.on yearRight Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget (y + 1) m

    miniCalendarSetDate miniCalendarWidget year month

    return miniCalendarWidget

miniCalendarNew2 :: IO MiniCalendarWidget
miniCalendarNew2 = do
    (year, month, _, _, _) <- calendarGetDate

    refYear  <- newIORef year
    refMonth <- newIORef month
    calendarObservable <- observableNew

    cal <- Gtk.calendarNew
    calStyle <- Gtk.widgetGetStyle cal
    bg <- colorToString <$> Gtk.styleGetBackground calStyle Gtk.StateNormal
    fg <- colorToString <$> Gtk.styleGetText calStyle Gtk.StateNormal
    sb <- colorToString <$> Gtk.styleGetLight calStyle Gtk.StateSelected

    let css = [ cssStyleReset
              , "* {"
              , "    color: " ++ fg ++ ";"
              , "}"
              , if gtkVersionOld then ".frame {" else "frame {"
              , "    background-color: " ++ bg ++ ";"
              , "    border: 1px;"
              , "    border-style: solid;"
              , "    border-radius: 10px;"
              , "    padding: 4px 4px 4px 4px;"
              , "}"
              , if gtkVersionOld then ".label {" else "label {"
              , "    padding: 2px;"
              , "}"
              , if gtkVersionOld then ".button { " else "button {"
              , "    transition: 200ms ease-in-out;"
              , "    font-size: 1.1em;"
              , "    background-color: " ++ bg ++ ";"
              , "    border-color: " ++ bg ++ ";"
              , "    border-radius: 8px 0px 8px 0px;"
              , "    border-width: 1px;"
              , "    border-style: solid;"
              , "    padding: 2px;"
              , "}"
              , "#TodayButton {"
              , "    transition: none;"
              , "    font-size: 1em;"
              , "    border-radius: 8px 0px 8px 0px;"
              , "    padding: 0px 12px 0px 12px;"
              , "}"
              , "#TodayButton:active {"
              , "    background-color: " ++ sb ++ ";"
              , "}"
              , "#Arrow {"
              , "    font-weight: bold;"
              , "    font-size: 2em;"
#ifdef WINDOWS
              , "    padding: 0px 6px 6px 6px;"
#else
              , "    padding: 0px 6px 0px 6px;"
#endif
              , "    border-style: none;"
              , "    border-radius: 12px;"
              , "}"
              , "#Arrow:hover {"
              , "    background-color: " ++ sb ++ ";"
              , "}"
              , "#TodayButton:hover {"
              , "    border-color: " ++ sb ++ ";"
              , "}"
              ]

    (getObject, root) <- uiBuildGtk $ do
        packing Gtk.PackNatural 0
        vbox Nothing False 0 $ hbox Nothing False 0 $ do
            globalCss css
            hbox Nothing False 0 $ do
                frame Nothing Nothing $ do
                    grid Nothing $ do
                        gridAttach 5 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "yearLeft") "<"
                        gridAttach 6 0 3 1 $ do
                            widgetAttrs [ Gtk.widgetWidthRequest := 60 ]
                            label (Just "year") (show year)
                        gridAttach 9 0 1 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "Arrow" ]
                            button (Just "yearRight") ">"
                        gridAttach 10 0 3 1 $ do
                            buttonAttrs [ Gtk.widgetName := Just "TodayButton" ]
                            button (Just "today") (__"Today")

    let yearLabel  = Gtk.castToLabel . fromJust . getObject $ "year"
    let yearLeft    = Gtk.castToButton . fromJust . getObject $ "yearLeft"
    let yearRight   = Gtk.castToButton . fromJust . getObject $ "yearRight"
    let todayButton = Gtk.castToButton . fromJust . getObject $ "today"

    monthLabel <- Gtk.labelNew $ Just ""

    let miniCalendarWidget = MiniCalendarWidget
                                 (Gtk.castToBox root)
                                 yearLabel
                                 monthLabel
                                 refYear
                                 refMonth
                                 calendarObservable

    void $ Gtk.on todayButton Gtk.buttonActivated $ do
        (y, m, _, _, _) <- calendarGetDate
        miniCalendarSetDate miniCalendarWidget y m

    void $ Gtk.on yearLeft Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget (y - 1) m

    void $ Gtk.on yearRight Gtk.buttonActivated $ do
        (y, m) <- miniCalendarGetDate miniCalendarWidget
        miniCalendarSetDate miniCalendarWidget (y + 1) m

    miniCalendarSetDate miniCalendarWidget year month

    return miniCalendarWidget

miniCalendarSetDate :: MiniCalendarWidget -> Integer -> Int -> IO ()
miniCalendarSetDate cal year month = do
    let (month'', year') = if month < 1 then (12, year - 1) else (if month > 12 then (1, year + 1) else (month, year))
    let year'' = if year' < 0 then 0 else year'

    Gtk.labelSetText (miniCalendarYearLabel cal) $ show year''
    Gtk.labelSetText (miniCalendarMonthLabel cal) $ show (intToMonth month'')

    writeIORef (miniCalendarYear cal) year''
    writeIORef (miniCalendarMonth cal) month''

    observableSet (miniCalendarChange cal) (year'', month'')

miniCalendarGetDate :: MiniCalendarWidget -> IO (Integer, Int)
miniCalendarGetDate cal = do
    y <- readIORef $ miniCalendarYear cal
    m <- readIORef $ miniCalendarMonth cal
    return (y, m)

miniCalendarGetDate2 :: MiniCalendarWidget -> IO Integer
miniCalendarGetDate2 cal = do
    y <- readIORef $ miniCalendarYear cal
    return y

miniCalendarOnChange :: MiniCalendarWidget -> (Integer -> Int -> IO ()) -> IO ()
miniCalendarOnChange cal action = do
    observableRegister (miniCalendarChange cal) $ \(year, month) -> action year month