module PlotLab.Main (main) where

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

import PlotLab.Events (attachHandlers)
import PlotLab.FigureSettings

-- 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 axis show location range scale label size = do
  let (position, side) = location

  when show $ 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 title = plotTitle fset
      size  = plotTitleSize fset
    in updateFigureText withTitle title size

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

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

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

    -- Y-Axis
    let show  = showYAxis fset
        text  = yLabel fset
        size  = yLabelSize fset
        loc   = yLocation fset
        range = yRange fset
        scale = plotScaleY fset
      in updateAxis YAxis show loc range scale text 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 conf = mapM newAdj conf
      newHScaleList adjs = mapM hScaleNew adjs

  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 * floor (y - x)) (fromJust $ xRange fset)
      domain  = linspace samples (fromJust $ xRange fset)
      f       = g vars
      dset    = (domain, [line f blue])
      r       = render $ buildFigure dset fset

  region <- regionRectangle $ Rectangle 0 0 w h
  drawWindowBeginPaintRegion drw region
  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 g = do
  builder <- builderNew
  builderAddFromFile builder plotGlade

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

  let updateEntryText entryGlade text =
        when (text /= Nothing) $ do entry <- builderGetObject builder
                                             castToEntry entryGlade
                                    entrySetText entry $ fromJust text
    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 g 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 fst = do
  ref <- newIORef fst

  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

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

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)

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

-- Gaussian Distribution
h :: [Double] -> Double -> Double
h [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi))

g :: [Double] -> Double -> Double
g [a, b, c, d] x = h [a, b] x + h [c, d] x

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

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 $
    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)

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