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

module Graphics.Rendering.Plot.Gtk.UI.Events (attachHandlers) where

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

import           Data.Char                               (toLower)
import           Data.IORef                              (IORef, modifyIORef,
                                                          readIORef)
import           Data.Text                               (unpack)

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

import           Graphics.Rendering.Plot
import           Graphics.UI.Gtk                         hiding (Circle, Color,
                                                          Cross)

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

import           Graphics.Rendering.Plot.Gtk.UI.Figure   (figurePlot)
import           Graphics.Rendering.Plot.Gtk.UI.Settings

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

attachHandlers :: (ComboBoxClass cbox) =>
                  Builder
                  -> IORef FigureSettings
                  -> [Adjustment]
                  -> (DrawingArea -> IORef FigureSettings
                                  -> [Adjustment]
                                  -> IO ())
                  -> ([Double] -> Double -> Double)
                  -> cbox
                  -> IO ()
attachHandlers builder iofset adjs updateCanvas g combo = do
  -- Canvas
  canvas <- builderGetObject builder castToDrawingArea "Plotting Canvas"
  let redraw = updateCanvas canvas iofset adjs
  _ <- onExpose canvas $ \_ -> redraw >> return False

  -- Adjustments for parameter sliders
  mapM_ (`onValueChanged` redraw) adjs

  -- Plot-Title Entry
  titleEntry <- builderGetObject builder castToEntry "Plot Title Entry"
  _ <- onEntryActivate titleEntry $ do
    titleNew <- entryGetText titleEntry
    modifyIORef iofset $ \f -> f { plotTitle = Just titleNew }
    redraw

  -- Plot-Title Font Size
  titleSize <- builderGetObject builder castToAdjustment "Title Font Size"
  _ <- onValueChanged titleSize $ do
    size <- adjustmentGetValue titleSize
    modifyIORef iofset $ \f -> f { plotTitleSize = size }
    redraw

  -- Subtitle Entry
  subEntry <- builderGetObject builder castToEntry "Subtitle Entry"
  _ <- onEntryActivate subEntry $ do
    titleNew <- entryGetText subEntry
    modifyIORef iofset $ \f -> f { subTitle = Just titleNew }
    redraw

  -- Subtitle Font Size
  subSize  <- builderGetObject builder castToAdjustment "Subtitle Font Size"
  _ <- onValueChanged subSize $ do
    size <- adjustmentGetValue subSize
    modifyIORef iofset $ \f -> f { subTitleSize = size }
    redraw

  -- Show X-Axis CheckButton
  showX <- builderGetObject builder castToCheckButton "X-Axis Check"
  _ <- onToggled showX $ do
    state <- toggleButtonGetActive showX
    modifyIORef iofset
      (\f -> f { showXAxis = state })
    redraw

  -- Show Y-Axis CheckButton
  showY <- builderGetObject builder castToCheckButton "Y-Axis Check"
  _ <- onToggled showY $ do
    state <- toggleButtonGetActive showY
    modifyIORef iofset
      (\f -> f { showYAxis = state })
    redraw

  let adjustmentPairValues (a1, a2) = do v1 <- adjustmentGetValue a1
                                         v2 <- adjustmentGetValue a2
                                         return (v1, v2)
  -- X-Axis Range
  xLower <- builderGetObject builder castToAdjustment "X-Lower"
  xUpper <- builderGetObject builder castToAdjustment "X-Upper"
  let updateX x = onValueChanged x $ do
        (xl, xu) <- adjustmentPairValues (xLower, xUpper)
        modifyIORef iofset $ \f -> f { xRange = Just (xl, xu) }
        redraw
    in mapM_ updateX [xLower, xUpper]

  -- X-Range Auto-determination CheckBox
  xRangeEntries <- builderGetObject builder castToHBox "X-Range Entries"
  autoXCheck <- builderGetObject builder castToCheckButton "X-Range Check"
  _ <- onToggled autoXCheck $ do
    state <- toggleButtonGetActive autoXCheck
    if state
      then error "Invalid xRange"
           -- do modifyIORef iofset $ \f -> f { xRange = Nothing }
           --    widgetHideAll xRangeEntries
      else do lower <- builderGetObject builder castToAdjustment "X-Lower"
              upper <- builderGetObject builder castToAdjustment "X-Upper"
              (l, u) <- adjustmentPairValues (lower, upper)
              widgetShowAll xRangeEntries
              modifyIORef iofset $ \f -> f { xRange = Just (l, u) }
    redraw

  -- Y-Axis Range
  yLower <- builderGetObject builder castToAdjustment "Y-Lower"
  yUpper <- builderGetObject builder castToAdjustment "Y-Upper"
  let updateY y = onValueChanged y $ do
        (yl, yu) <- adjustmentPairValues (yLower, yUpper)
        modifyIORef iofset $ \f -> f { yRange = Just (yl, yu) }
        redraw
    in mapM_ updateY [yLower, yUpper]

  -- Y-Range Auto-determination CheckBox
  yRangeEntries <- builderGetObject builder castToHBox "Y-Range Entries"
  autoYCheck <- builderGetObject builder castToCheckButton "Y-Range Check"
  _ <- onToggled autoYCheck $ do
    state <- toggleButtonGetActive autoYCheck
    if state
      then do modifyIORef iofset $ \f -> f { yRange = Nothing }
              widgetHideAll yRangeEntries
      else do lower <- builderGetObject builder castToAdjustment "Y-Lower"
              upper <- builderGetObject builder castToAdjustment "Y-Upper"
              (l, u) <- adjustmentPairValues (lower, upper)
              widgetShowAll yRangeEntries
              modifyIORef iofset $ \f -> f { yRange = Just (l, u) }
    redraw

  -- Sampling Rate
  sampleRate  <- builderGetObject builder castToAdjustment "Sampling Adj"
  _ <- onValueChanged sampleRate $ do
    rate <- adjustmentGetValue sampleRate
    modifyIORef iofset $ \f -> f { samplingRate = rate }
    redraw

  -- X-Label Entry
  xLabelEntry <- builderGetObject builder castToEntry "X-Label Entry"
  _ <- onEntryActivate xLabelEntry $ do
    label' <- entryGetText xLabelEntry
    modifyIORef iofset $ \f -> f { xLabel = Just label' }
    redraw

  -- X-Label Size
  xlSize <- builderGetObject builder castToAdjustment "X-Label Size"
  _ <- onValueChanged xlSize $ do
    size <- adjustmentGetValue xlSize
    modifyIORef iofset $ \f -> f { xLabelSize = size }
    redraw

  -- Y-Label Entry
  yLabelEntry <- builderGetObject builder castToEntry "Y-Label Entry"
  _ <- onEntryActivate yLabelEntry $ do
    label' <- entryGetText yLabelEntry
    modifyIORef iofset $ \f -> f { yLabel = Just label' }
    redraw

  ylSize <- builderGetObject builder castToAdjustment "Y-Label Size"
  _ <- onValueChanged ylSize $ do
    size <- adjustmentGetValue ylSize
    modifyIORef iofset $ \f -> f { yLabelSize = size }
    redraw

  -- Export Filename extry

  -- Export Button
  export <- builderGetObject builder castToButton "Export Button"
  _ <- onClicked export $ do
    fset      <- readIORef iofset
    comboText <- comboBoxGetActiveText combo
    nameEntry <- builderGetObject builder castToEntry "File Entry"
    nameText  <- entryGetText nameEntry

    modifyIORef iofset $ \f -> f { fileName = nameText }

    figure <- figurePlot g iofset adjs

    let dimensions = exportSize fset

        parseType txt = case txt of
                         "PNG" -> PNG
                         "SVG" -> SVG
                         "PS"  -> PS
                         "PDF" -> PDF
                         _     -> error "Invalid FileType!"

        filetype = parseType $ maybe (error "Invalid Type!") unpack comboText

        parseExt fileType = case fileType of
                              PNG -> "PNG"
                              SVG -> "SVG"
                              PS  -> "PS"
                              PDF -> "PDF"

        filename = nameText ++ "." ++ map toLower (parseExt filetype)
    writeFigure filetype filename dimensions figure
  return ()

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