---------------------------------------------------------
--
-- Module        : HasloGUI
-- Copyright     : Bartosz Wójcik (2012)
-- License       : BSD3
--
-- Maintainer    : bartek@sudety.it
-- Stability     : Unstable
-- Portability   : portable
--
-- | Example of usage two libraries: wtk-gtk and Haslo.
--   Simply loan calculator with Gtk GUI.
---------------------------------------------------------

module Main
where
import Haslo
import Data.Maybe (fromJust)

import Graphics.UI.Gtk
import Data.IORef
import Data.Lenses
import Data.List
import Control.Monad.Reader

import Haslo.GUI.Gtk.HasloGUIState
import Haslo.GUI.Gtk.HasloGUILogic
import Haslo.GUI.Gtk.HasloGUIGtk
import Graphics.UI.Gtk.WtkGui
import Graphics.UI.Gtk.WtkGtk

-- ============ LICENCE =====================
thisVersion = "0.1"
thisLicenceType = "Evaluation"
thisLicenceTill = "31.12.2012"
thisLicenceFor  = "Public"
-- ==========================================

main :: IO ()
main = do
     initGUI

     vbox <- vBoxNew False 0

     ntbk <- notebookNew

     st <- initState ntbk                       -- notebook
                     initMyState
                     showTable                  -- input page formating and packing function
                                                -- Here, in showTable everything is hidden
                     newSt                      -- user state update function
                     False                      -- debug off

     window <- windowNew
     set window [windowTitle := "Haslo GUI",
                 windowDefaultWidth := 350,
                 windowDefaultHeight := 700 ]
     containerAdd window vbox

     (vb,collection) <- showTable 0 st
     notebookInsertPage ntbk vb "Input" 0
     widgetShowAll vb

     about <- actionNew "ABOUT" "About" Nothing (Just stockAbout)
     onActionActivate about aboutDialog

--     param <- actionNew "PARAM" "Parameters" Nothing Nothing
--     onActionActivate param $ paramDialog st

     agr <- actionGroupNew "AGR"
     mapM_ (\a -> actionGroupAddActionWithAccel agr a Nothing) [about
--                                                               ,param
                                                               ]

     ui <- uiManagerNew
     uiManagerAddUiFromString ui uiDecl
     uiManagerInsertActionGroup ui agr 0

     maybeMenubar <- uiManagerGetWidget ui "/ui/menubar"
     let menubar = case maybeMenubar of
                        (Just x) -> x
                        Nothing -> error "Cannot get menubar from string."
     boxPackStart vbox menubar PackNatural 0

     maybeToolbar <- uiManagerGetWidget ui "/ui/toolbar"
     let toolbar = case maybeToolbar of
                        (Just x) -> x
                        Nothing -> error "Cannot get toolbar from string."
     boxPackStart vbox toolbar PackNatural 0

     boxPackStart vbox ntbk PackGrow 0

     widgetShowAll window
     onDestroy window mainQuit
     mainGUI

uiDecl=  "<ui>\
\           <menubar>\
\              <menuitem action=\"ABOUT\" />\
\           </menubar>\
\           <toolbar>\
\           </toolbar>\
\         </ui>"

olduiDecl=  "<ui>\
\           <menubar>\
\              <menu action=\"CONTRACT\">\
\                 <menuitem action=\"RELOAD\" />\
\                 <menuitem action=\"FIND\" />\
\                 <menuitem action=\"SAVE\" />\
\              </menu>\
\              <menuitem action=\"ABOUT\" />\
\              <menuitem action=\"PARAM\" />\
\           </menubar>\
\           <toolbar>\
\              <toolitem action=\"RELOAD\" />\
\              <toolitem action=\"FIND\" />\
\              <toolitem action=\"SAVE\" />\
\             </toolbar>\
\         </ui>"

aboutDialog = do
  dia <- aboutDialogNew
  -- Displayed version is a combination of ElcaGUI and elca engine versions.
  aboutDialogSetVersion dia $ thisVersion ++ "\non engine " ++ getVersionHaslo
  aboutDialogSetCopyright dia "(c) Bartosz Wojcik 2012"
  aboutDialogSetComments dia thisLicenceFor
  aboutDialogSetLicense dia (Just thisLicenceType)
  aboutDialogSetAuthors dia ["Bartosz Wojcik"]
  answer <- dialogRun dia
  widgetDestroy dia

-- | User defined layout of the input. Each inputable widget has to have its own
--   entry in the state, as 'InputField'.
--
--   Following order of packing:
--   window, notebook, notebook's page, vbox, scrolledWindow, table
--   What is important: this function has to return vbox, so it's not necessarily
--  scrolledWindow and table to be packed in.
showTable  :: Int                            -- ^ id of widget with focus
           -> IORef (State MyState)          -- ^ state living in IO
           -> IO (VBox, [WidgetsCollection]) -- ^ vbox containing table of the content, list of widgets needed for grabing focus
showTable nr state = do
   vb <- vBoxNew False 0
   scrwin <- scrolledWindowNew Nothing Nothing
   scrolledWindowSetPolicy scrwin PolicyNever PolicyAutomatic
   boxPackStart vb scrwin PackGrow 0

   -- H-box put into scrolled window
   vbFramesA <- hBoxNew False 0
   scrolledWindowAddWithViewport scrwin vbFramesA

   st <- readIORef state

   -- V-box on the left hand side of vbFramesA
   vbFrames <- vBoxNew False 0
   boxPackStart vbFramesA vbFrames PackGrow 0

   -- V-box on the right hand side of vbFramesA
   vbFramesR <- vBoxNew False 0
   boxPackStart vbFramesA vbFramesR PackGrow 0

--   showDBDetails vbFrames $ usrSt st

   table <- myNewTable "Loan" vbFrames 29 4

   -- Loan frame and its content
   textToTableCellL "Type of loan" 1 0 table
   cb0 <- showSelection (loanAPI $ usrSt st) 2 0 nr table state >>= \x -> return $ CSL (0,x)
   errMsgToTable (loanAPI $ usrSt st) 2 1 table

   hlineToTable 1 3 table

   textToTableCellL "Principal" 1 2 table
   en1 <- showEntry (principalAPI $ usrSt st) 2 2 nr table state >>= \x -> return $ CEn (1,x)
   textToTableCellL "<small>(accepting arithmetic\n statement) </small>" 3 2 table
   errMsgToTable (principalAPI $ usrSt st) 2 3 table

   en7 <- case (balloonAPI $ usrSt st) `fetch` att_visible of
            True -> do let label = case fromJust $ loanS $ usrSt st of
                                       ClReversBalloon       -> "Instalment amount"
                                       ClUnfoldedBalloon     -> "Residual balloon"
                                       ClUnfoldedBalloonPlus -> "Residual balloon"
                                       _                     -> "Balloon"
                       textToTableCellL label 1 4 table
                       en <- showEntry (balloonAPI $ usrSt st) 2 4 nr table state
                       errMsgToTable (balloonAPI $ usrSt st) 2 5 table
                       return $ CEn (7,en)
            False -> return Dummy

   textToTableCellL "Number of instalments" 1 6 table
   en2 <- showEntry (durationAPI $ usrSt st) 2 6 nr table state >>= \x -> return $ CEn (2,x)
   errMsgToTable (durationAPI $ usrSt st) 2 7 table

   let label3 =  "Effecitve interest rate"
   textToTableCellL label3 1 8 table
   en3 <- showEntry (rateAPI $ usrSt st) 2 8 nr table state >>= \x -> return $ CEn (3,x)
   textToTableCellL "%" 3 8 table
   errMsgToTable (rateAPI $ usrSt st) 2 9 table

   en5 <- case (eXtDurAPI $ usrSt st) `fetch` att_visible of
               True -> do let label = "Max. extended duration"
                          textToTableCellL label 1 10 table
                          en <- showEntry (eXtDurAPI $ usrSt st) 2 10 nr table state
                          errMsgToTable (eXtDurAPI $ usrSt st) 2 11 table
                          return $ CEn (eXtDurId,en)
               False -> return Dummy

   textToTableCellL "1st instalment deferment" 1 12 table
   en4 <- showEntry (delayAPI $ usrSt st) 2 12 nr table state >>= \x -> return $ CEn (4,x)
   errMsgToTable (delayAPI $ usrSt st) 2 13 table

   hlineToTable 16 3 table

   bt1 <- buttonNewWithLabel "Amotization Schedule" >>= \bt ->
          showButton (action100API $ usrSt st) 2 25 nr table state bt openNewPageAbs >>
          return (CBu (8,bt))

   let returnList = cb0 : en1 : en2 : en3 : en5 : en4 : bt1 : en7 : []

   return (vb,returnList)