module PlotLab.Main (main) where

import           PlotLab.Events          (attachHandlers)
import           PlotLab.FigureSettings

import           Control.Monad           (when)
import           Data.Colour.Names
import           Data.IORef              (IORef, modifyIORef, newIORef,
                                          readIORef)
import           Data.Maybe              (fromJust)
import           Data.Text               (pack)
import           Graphics.Rendering.Plot
import           Graphics.UI.Gtk         hiding (Circle, Color, Cross, Scale)
import           Numeric.LinearAlgebra   (linspace)

-- import Control.Concurrent
-- import Control.Concurrent.MVar
-- import qualified Graphics.Rendering.Pango as P
-- import qualified Graphics.Rendering.Cairo as C
-- import Data.Packed.Vector
-- import Data.Packed.Random
-- import Data.Packed()
-- import Numeric.LinearAlgebra.Instances
-- import Numeric.LinearAlgebra.Interface
-- import Numeric.GSL.Statistics
-- import Debug.Trace
-- import qualified Data.Array.IArray as A

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

updateFigureText :: (Text () -> Figure ())
                 -> (Maybe String) -> Double -> Figure ()
updateFigureText withSomething txt size =
  withSomething $ do if txt == Nothing
                       then setText ""
                       else setText (fromJust txt)
                     setFontSize size

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

updateAxis :: AxisType -> Bool -> (AxisPosn, AxisSide) -> Maybe (Double, Double)
           -> Scale -> Maybe String -> FontSize -> Plot ()
updateAxis axis state location range scale label size = do
  let (position, side) = location

  when state $ addAxis axis position
    (when (label /= Nothing) $ withAxisLabel $ do setText $ fromJust label
                                                  setFontSize size)
  if range == Nothing
    then setRangeFromData axis side scale
    else uncurry (setRange axis side scale) (fromJust range)

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

buildFigure :: (Dataset a) => a -> FigureSettings -> Figure ()
buildFigure dset fset = do
  withTextDefaults $ setFontFamily (fontFamily fset)

  let str  = plotTitle fset
      size = plotTitleSize fset
    in updateFigureText withTitle str size

  let str  = subTitle fset
      size = subTitleSize fset
    in updateFigureText withSubTitle str size

  setPlots 1 1
  withPlot (1, 1) $ do
    setDataset dset

    -- X-Axis
    let state = showXAxis fset
        label = xLabel fset
        size  = xLabelSize fset
        loc   = xLocation fset
        range = xRange fset
        scale = plotScaleX fset
      in updateAxis XAxis state loc range scale label size

    -- Y-Axis
    let state = showYAxis fset
        label = yLabel fset
        size  = yLabelSize fset
        loc   = yLocation fset
        range = yRange fset
        scale = plotScaleY fset
      in updateAxis YAxis state loc range scale label size

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

type AdjustmentSettings = (Double, Double, Double, Double, Double, Double)

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

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

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

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

updateCanvas :: DrawingArea -> IORef FigureSettings -> [Adjustment] -> IO ()
updateCanvas canvas iofset adjs = do
  fset     <- readIORef iofset
  s@(w, h) <- widgetGetSize canvas
  drw      <- widgetGetDrawWindow canvas
  vars     <- mapM adjustmentGetValue adjs

  let rate    = samplingRate fset
      samples = (\(x, y) -> rate * ceiling (y - x)) (fromJust $ xRange fset)
      domain  = linspace samples (fromJust $ xRange fset)
      f       = g vars
      colour  = blue :: Color
      dset    = (domain, [line f colour])
      r       = render $ buildFigure dset fset

  box <- regionRectangle $ Rectangle 0 0 w h
  drawWindowBeginPaintRegion drw box
  renderWithDrawable drw (r s)
  drawWindowEndPaint drw

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

-- Create a new window
-- Initially fill the values
-- Call PlotLab.Events.attachHandlers to attach Event Handlers
figureWindow :: String -> IORef FigureSettings -> [AdjustmentSettings]
             -> ([Double] -> Double -> Double) -> IO ()
figureWindow 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 (txt /= Nothing) $ 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"       $ fromIntegral $ 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 $ if state then True else False
    in do checkApplyState "X-Axis Check"  $ showXAxis fset
          checkApplyState "Y-Axis Check"  $ showYAxis fset
          checkApplyState "Y-Range Check" $ yRange fset == Nothing

  -- Y-Axis Range and CheckButton
  let range = yRange fset
    in if range == Nothing
       then do entries  <- builderGetObject builder castToHBox "Y-Range Entries"
               widgetHideAll entries
       else let (l, u) = fromJust range
            in do 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 range == Nothing
       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 width  <- builderGetObject builder castToAdjustment "Export Width"
          height <- builderGetObject builder castToAdjustment "Export Height"
          adjustmentSetValue width $ fromIntegral w
          adjustmentSetValue height $ 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 buildFigure combo

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

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

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

giveSettings :: FigureSettings -> IO (IORef FigureSettings)
giveSettings fset = do
  ref <- newIORef fset

  modifyIORef ref $ \f ->
    f { plotTitle     = Just "Example: Sum of two gaussian distributions"
      , subTitle      = Just "Play with the sliders, and other options"
      , xRange        = Just (-5, 5)
      , yRange        = Just ( 0, 2)
      , plotTitleSize = 12.5
      }
  return ref

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

-- Gaussian Distribution
func :: [Double] -> Double -> Double
func [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi))
func _ _ = error "Invalid arguments"

g :: [Double] -> Double -> Double
g [a, b, c, d] x = func [a, b] x + func [c, d] x
g _ _ = error "Invalid arguments"

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

main :: FilePath -> String -> IO ()
main mainGlade plotGlade = do
  _ <- initGUI
  builder <- builderNew
  builderAddFromFile builder mainGlade
  mainWindow <- builderGetObject builder castToWindow "Main Window"
  plotButton <- builderGetObject builder castToButton "Plot Button"
  _ <- onDestroy mainWindow mainQuit
  widgetShowAll mainWindow
  settings <- giveSettings defaultSettings
  _ <- onClicked plotButton $
       let mu1    = (-5.00, -5.00, 5.00, 0.01, 0.01, 0.00)
           sigma1 = ( 1.00,  0.01, 6.00, 0.01, 0.01, 0.00)
           mu2    = ( 0.00, -5.00, 5.00, 0.01, 0.01, 0.00)
           sigma2 = ( 1.00,  0.01, 6.00, 0.01, 0.01, 0.00)
       in figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g
  mainGUI

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

-- xs = linspace ln (-2.5, 2.5) :: Vector Double
-- ys = ln |> [exp (-x ** 2) | x <- [(-2.5),(-2.475)..2.5] :: [Double]]

-- figure = buildFigure (domain, [point (ys, xs) (Cross, red),
--                                line f1 red, line f2 green,
--                                line f3 blue, line f4 black]) default_fset

-- export = writeFigure SVG "plot.svg" (1000,1000) $ buildFigure dset fset

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

-- applyParameters :: (Function a) => a -> [Double] -> (Double -> Double)

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