-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Plot.Gtk.UI
-- Copyright   :  (c) Sumit Sahrawat
-- License     :  GPL-2
--
-- Maintainer  :  sumit.sahrawat.apm13@iitbhu.ac.in
-- Stability   :  provisional
-- Portability :  portable
--
-- Functions related to the plot window
--
--------------------------------------------------------------------------------

module Graphics.Rendering.Plot.Gtk.UI.PlotWindow where

--------------------------------------------------------------------------------
-- Standard Libraries

import           Control.Exception                       (SomeException (..),
                                                          catch)
import           Control.Monad                           (when)
import           Data.IORef                              (IORef, readIORef)
import           Data.Maybe                              (fromJust, isJust,
                                                          isNothing)
import           Data.Text                               (pack)

--------------------------------------------------------------------------------
-- Other Libraries

import           Graphics.Rendering.Plot
import           Graphics.UI.Gtk

--------------------------------------------------------------------------------
-- Custom Modules

import           Graphics.Rendering.Plot.Gtk.UI.ErrorFig (errorFig)
import           Graphics.Rendering.Plot.Gtk.UI.Events   (attachHandlers)
import           Graphics.Rendering.Plot.Gtk.UI.Figure   (figurePlot)
import           Graphics.Rendering.Plot.Gtk.UI.Settings

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

updateCanvas :: ([Double] -> Double -> Double)
             -> DrawingArea
             -> IORef FigureSettings
             -> [Adjustment]
             -> IO ()
updateCanvas g canvas iofset adjs = do
  s@(w, h) <- widgetGetSize canvas
  drw      <- widgetGetDrawWindow canvas
  fig      <- figurePlot g iofset adjs

  box <- regionRectangle $ Rectangle 0 0 w h
  drawWindowBeginPaintRegion drw box
  catch (renderWithDrawable drw (render fig s))
            (\(SomeException _) -> do
               fset <- readIORef iofset
               renderWithDrawable drw (errorFig fset s))
  drawWindowEndPaint drw

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

addSlidersToBox :: [AdjustmentSettings] -> VBox -> IO [Adjustment]
addSlidersToBox conf box = do
  let newAdj (ASet a b c d e f) = adjustmentNew a b c d e f
      newAdjList    = mapM newAdj
      newHScaleList = mapM hScaleNew

  adjs <- newAdjList . reverse $ conf
  sliders <- newHScaleList adjs
  mapM_ (`scaleSetValuePos` PosRight) sliders
  mapM_ (`scaleSetDigits` 2) sliders
  mapM_ (\x -> boxPackEnd box x PackNatural 0) sliders
  return adjs

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

plotWindow :: String -> IORef FigureSettings -> [AdjustmentSettings]
             -> ([Double] -> Double -> Double) -> IO ()
plotWindow plotGlade iofset conf fun = do
  builder <- builderNew
  builderAddFromFile builder plotGlade

  plotBox <- builderGetObject builder castToVBox "Plot Region"
  adjs    <- addSlidersToBox conf plotBox
  fset    <- readIORef iofset

  let updateEntryText entryGlade txt =
        when (isJust txt) $ do entry <- builderGetObject builder
                                        castToEntry entryGlade
                               entrySetText entry $ fromJust txt
    in do updateEntryText "Plot Title Entry" $ plotTitle fset
          updateEntryText "Subtitle Entry"   $ subTitle fset
          updateEntryText "X-Label Entry"    $ xLabel fset
          updateEntryText "Y-Label Entry"    $ yLabel fset
          updateEntryText "File Entry"       $ Just (fileName fset)

  let adjApplyValue adjGlade val = do
        adj <- builderGetObject builder castToAdjustment adjGlade
        adjustmentSetValue adj val
    in do adjApplyValue "Title Font Size"    $ plotTitleSize fset
          adjApplyValue "Subtitle Font Size" $ subTitleSize fset
          adjApplyValue "Sampling Adj"       $ samplingRate fset
          adjApplyValue "X-Label Size"       $ xLabelSize fset
          adjApplyValue "Y-Label Size"       $ yLabelSize fset

  let checkApplyState checkGlade state = do
        check <- builderGetObject builder castToCheckButton checkGlade
        toggleButtonSetActive check state
    in do checkApplyState "X-Axis Check"  $ showXAxis fset
          checkApplyState "Y-Axis Check"  $ showYAxis fset
          checkApplyState "Y-Range Check" $ isNothing . yRange $ fset

  when (isJust . yRange $ fset) $ do
    let (l, u) = fromJust . yRange $ fset
    lower <- builderGetObject builder castToAdjustment "Y-Lower"
    upper <- builderGetObject builder castToAdjustment "Y-Upper"
    adjustmentSetValue lower l
    adjustmentSetValue upper u

  -- X-Axis Range
  let range = xRange fset
    in if isNothing range
       then error "Invalid xRange"
       else let (l, u) = fromJust range
            in do lower <- builderGetObject builder castToAdjustment "X-Lower"
                  upper <- builderGetObject builder castToAdjustment "X-Upper"
                  adjustmentSetValue lower l
                  adjustmentSetValue upper u

  -- Export Size
  let (w, h) = exportSize fset
    in do widthAdj  <- builderGetObject builder castToAdjustment "Export Width"
          heightAdj <- builderGetObject builder castToAdjustment "Export Height"
          adjustmentSetValue widthAdj  $ fromIntegral w
          adjustmentSetValue heightAdj $ fromIntegral h

  -- Export ComboBox
  combo <- comboBoxNewText
  _     <- mapM (\(x, y) -> comboBoxInsertText combo x $ pack y)
           [(1, "PNG"), (2, "SVG"), (3, "PS"), (4, "PDF")]
  comboBoxSetActive combo 0

  comboArea <- builderGetObject builder castToHBox "File Name"
  boxPackEndDefaults comboArea combo

  -- Attach Event Handlers
  _ <- attachHandlers builder iofset adjs (updateCanvas fun) fun combo

  -- Show Widgets
  window <- builderGetObject builder castToWindow "Plot Window"
  widgetShowAll window

  -- Hide the useless checkButton for now
  check <- builderGetObject builder castToCheckButton "X-Range Check"
  widgetHide check

  -- Hide the entries if not required
  let range = yRange fset
    in when (isNothing range) $ do
      entries  <- builderGetObject builder castToHBox "Y-Range Entries"
      widgetHideAll entries

  _ <- onDestroy window mainQuit
  return ()

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