{-# OPTIONS_HADDOCK ignore-exports #-}

module GUI.Gtk (makeGUI) where

import Control.Applicative
import Control.Monad(unless)
import Control.Monad.IO.Class
import Diagrams.Prelude
import Diagrams.Backend.Cairo
import Diagrams.Backend.Cairo.Internal
import Graphics.Diagram.Gtk
import Graphics.Diagram.Types
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade
import MyPrelude
import System.Directory
import System.FilePath.Posix
import Text.Read


-- |Monolithic object passed to various GUI functions in order
-- to keep the API stable and not alter the parameters too much.
-- This only holds GUI widgets that are needed to be read during
-- runtime.
data MyGUI = MkMyGUI {
  -- |main Window
  rootWin :: Window,
  -- |Tree Window
  treeWin :: Window,
  -- |delete Button
  delButton  :: Button,
  -- |save Button
  saveButton  :: Button,
  -- |quit Button
  quitButton  :: Button,
  -- |file chooser button
  fileButton  :: FileChooserButton,
  -- |drawing area
  mainDraw  :: DrawingArea,
  -- |drawing area for the tree
  treeDraw :: DrawingArea,
  -- |scaler for point thickness
  ptScale  :: HScale,
  -- |entry widget for lower x bound
  xminEntry  :: Entry,
  -- |entry widget for upper x bound
  xmaxEntry  :: Entry,
  -- |entry widget for lower y bound
  yminEntry  :: Entry,
  -- |entry widget for upper y bound
  ymaxEntry  :: Entry,
  -- |about dialog
  aboutDialog  :: AboutDialog,
  -- |combo box for choosing the algorithm
  algoBox  :: ComboBox,
  -- |grid check button
  gridCheckBox  :: CheckButton,
  -- |coord check button
  coordCheckBox  :: CheckButton,
  -- |Path entry widget for the quad tree.
  quadPathEntry  :: Entry,
  -- |Horizontal box containing the path entry widget.
  vbox7 :: Box
}


-- |The glade file to load the UI from.
gladeFile :: FilePath
gladeFile = "GUI/gtk2.glade"


-- |Loads the glade file and creates the MyGUI object.
makeMyGladeGUI :: IO MyGUI
makeMyGladeGUI = do
  -- load glade file
  Just xml   <- xmlNew gladeFile

  MkMyGUI
    <$> xmlGetWidget xml castToWindow "window1"
    <*> xmlGetWidget xml castToWindow "window2"
    <*> xmlGetWidget xml castToButton "drawButton"
    <*> xmlGetWidget xml castToButton "saveButton"
    <*> xmlGetWidget xml castToButton "quitButton"
    <*> xmlGetWidget xml castToFileChooserButton
          "filechooserButton"
    <*> xmlGetWidget xml castToDrawingArea "drawingarea"
    <*> xmlGetWidget xml castToDrawingArea "treedrawingarea"
    <*> xmlGetWidget xml castToHScale "hscale"
    <*> xmlGetWidget xml castToEntry "xlD"
    <*> xmlGetWidget xml castToEntry "xuD"
    <*> xmlGetWidget xml castToEntry "ylD"
    <*> xmlGetWidget xml castToEntry "yuD"
    <*> xmlGetWidget xml castToAboutDialog "aboutdialog"
    <*> xmlGetWidget xml castToComboBox "comboalgo"
    <*> xmlGetWidget xml castToCheckButton "gridcheckbutton"
    <*> xmlGetWidget xml castToCheckButton "coordcheckbutton"
    <*> xmlGetWidget xml castToEntry "path"
    <*> xmlGetWidget xml castToBox "vbox7"


-- |Main entry point for the GTK GUI routines.
makeGUI :: FilePath -> IO ()
makeGUI startFile = do
  homedir <- getHomeDirectory

  -- init gui
  _ <- initGUI

  -- get GUI object
  mygui <- makeMyGladeGUI

  -- adjust properties
  if startFile == ""
    then do
      _ <- fileChooserSetCurrentFolder (fileButton mygui) homedir
      return ()
    else do
      _ <- fileChooserSetFilename (fileButton mygui) startFile
      return ()
  comboBoxSetActive (algoBox mygui) 0

  -- callbacks
  _ <- onDestroy  (rootWin mygui) mainQuit
  _ <- onClicked  (delButton mygui) $ drawDiag mygui
  _ <- onClicked  (saveButton mygui) $ saveDiag mygui
  _ <- onClicked  (quitButton mygui) mainQuit
  _ <- onResponse (aboutDialog mygui) (\x -> case x of
                                ResponseCancel -> widgetHideAll (aboutDialog mygui)
                                _ -> return ())
  -- have to redraw for window overlapping and resizing on expose
  _ <- onExpose (mainDraw mygui) (\_ -> drawDiag mygui >>=
                             (\_ -> return True))
  _ <- onExpose (treeDraw mygui) (\_ -> drawDiag mygui >>=
                             (\_ -> return True))
  _ <- on (algoBox mygui) changed (drawDiag mygui)
  _ <- on (algoBox mygui) changed (onAlgoBoxChange mygui)
  _ <- on (gridCheckBox mygui) toggled (drawDiag mygui)
  _ <- on (coordCheckBox mygui) toggled (drawDiag mygui)

  -- hotkeys
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "q"       <- eventKeyName
    liftIO mainQuit
  _ <- treeWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "q"       <- eventKeyName
    liftIO (widgetHide $ treeWin mygui)
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "s"       <- eventKeyName
    liftIO $ saveDiag mygui
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "d"       <- eventKeyName
    liftIO $ drawDiag mygui
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "a"       <- eventKeyName
    liftIO $ widgetShowAll (aboutDialog mygui)

  -- draw widgets and start main loop
  widgetShowAll (rootWin mygui)
  widgetShowAll (treeWin mygui)
  widgetHide (vbox7 mygui)
  widgetHide (treeWin mygui)
  mainGUI


-- |Pops up an error Dialog with the given String.
showErrorDialog :: String -> IO ()
showErrorDialog str = do
  errorDialog <- messageDialogNew Nothing
                                  [DialogDestroyWithParent]
                                  MessageError
                                  ButtonsClose
                                  str
  _ <- dialogRun errorDialog
  widgetDestroy errorDialog


-- |May hide or show the widget that holds the quad tree path entry,
-- depending on the context and may also pop up the tree window.
onAlgoBoxChange :: MyGUI
                -> IO ()
onAlgoBoxChange mygui = do
  item <- comboBoxGetActive (algoBox mygui)
  if item == 4
    then do
      widgetShow (vbox7 mygui)
      widgetShow (treeWin mygui)
    else do
      widgetHide (vbox7 mygui)
      widgetHide (treeWin mygui)
  return ()


-- |Draws a Diagram which is built from a given file to
-- the gtk DrawingArea.
drawDiag :: MyGUI
          -> IO ()
drawDiag mygui = do
  fp <- fileChooserGetFilename (fileButton mygui)
  case fp of
    Just x -> do
      ret <- saveAndDrawDiag x "" mygui
      case ret of
        1 -> showErrorDialog "No valid x/y dimensions!"
        2 -> showErrorDialog "No valid Mesh file!"
        _ -> return ()
    Nothing -> return ()


-- |Saves a Diagram which is built from a given file as an SVG.
saveDiag :: MyGUI
          -> IO ()
saveDiag mygui = do
  fp <- fileChooserGetFilename (fileButton mygui)
  case fp of
    Just x -> do
      ret <- saveAndDrawDiag x "out.svg" mygui
      case ret of
        1 -> showErrorDialog "No valid x/y dimensions!"
        2 -> showErrorDialog "No valid Mesh file!"
        _ -> return ()
    Nothing -> return ()


-- |Draws and saves a Diagram which is built from a given file.
-- If the file to save is left empty, then nothing is saved.
saveAndDrawDiag :: FilePath -- ^ obj file to parse
                -> FilePath -- ^ if/where to save the result
                -> MyGUI
                -> IO Int
saveAndDrawDiag fp fps mygui =
  if (==) ".obj" . takeExtension $ fp
    then do
      mesh            <- readFile fp
      mainDrawWindow  <- widgetGetDrawWindow (mainDraw mygui)
      treeDrawWindow  <- widgetGetDrawWindow (treeDraw mygui)
      adjustment      <- rangeGetAdjustment (ptScale mygui)
      scaleVal        <- adjustmentGetValue adjustment
      xminEntryText   <- entryGetText (xminEntry mygui)
      xmaxEntryText   <- entryGetText (xmaxEntry mygui)
      yminEntryText   <- entryGetText (yminEntry mygui)
      ymaxEntryText   <- entryGetText (ymaxEntry mygui)
      algoActive      <- comboBoxGetActive (algoBox mygui)
      (daW, daH)      <- widgetGetSize (mainDraw mygui)
      (daTW, daTH)    <- widgetGetSize (treeDraw mygui)
      gridActive      <- toggleButtonGetActive (gridCheckBox mygui)
      coordTextActive <- toggleButtonGetActive (coordCheckBox mygui)
      quadPathEntry'  <- entryGetText (quadPathEntry mygui)

      let
        xDim = (,)         <$>
          readMaybe xminEntryText <*>
          readMaybe xmaxEntryText :: Maybe (Double, Double)
        yDim = (,)         <$>
          readMaybe yminEntryText <*>
          readMaybe ymaxEntryText :: Maybe (Double, Double)
        renderDiag winWidth winHeight buildDiag xDim' yDim' =
          renderDia Cairo
            (CairoOptions fps
               (Dims (fromIntegral winWidth) (fromIntegral winHeight))
               SVG False)
            (buildDiag (def{
                dotSize       = scaleVal,
                xDimension    = xDim',
                yDimension    = yDim',
                algo          = algoActive,
                haveGrid      = gridActive,
                showCoordText = coordTextActive,
                quadPath      = quadPathEntry'})
              mesh)

      case (xDim, yDim) of
        (Just xDim', Just yDim') -> do
          let (s, r)  = renderDiag daW daH diagS xDim' yDim'
          let (_, r') = renderDiag daTW daTH diagTreeS xDim' yDim'

          renderWithDrawable mainDrawWindow r
          renderWithDrawable treeDrawWindow r'

          unless (null fps) s
          return 0
        _ -> return 1

    else return 2