-- -*- haskell -*-
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.PLplot
-- License     :  BSD-style
--
-- Maintainer  :  Yakov ZAYTSEV <yakov@yakov.cc>
-- Stability   :  experimental
-- Portability :  portable
--
-- PlplotCanvas Widget for Gnome/GTK
--
-- Plots can be embedded into Gnome/GTK applications
-- by using the PlplotCanvas widget.
--
-----------------------------------------------------------------------------
module Graphics.PLplot (
  -- * PlplotCanvas Widget
    PlplotCanvas
  , plplotCanvasNew
  , plplotCanvasSetSize

  -- * PLplot API
  , PLplot(..)

  , PLplotM
  , runPLplot

  , BinOpt(..)
  ) where

-- import Control.Monad	(liftM)
-- import Control.Monad.Trans
import Data.Bits ((.|.))
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
import Graphics.UI.Gtk.Types
-- XXX Graphics/UI/GTK/Types.csh needs
import System.Glib.GType	(GType, typeInstanceIsA)

#include <plplotcanvas.h>
-- context lib="gtk" prefix="plplot" ???

-- The usage of foreignPtrToPtr should be safe as the evaluation will only be
-- forced if the object is used afterwards
--
castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String
                                                -> (obj -> obj')
castTo gtype objTypeName obj =
  case toGObject obj of
    gobj@(GObject objFPtr)
      | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype
                  -> unsafeCastGObject gobj
      | otherwise -> error $ "Cannot cast object to " ++ objTypeName

-- Graphics/UI/GTK/Types.chs
{#pointer *PlplotCanvas foreign newtype #}

mkPlplotCanvas = PlplotCanvas
unPlplotCanvas (PlplotCanvas o) = o

-- XXX PlplotCanvas is a subclass of the GnomeCanvas
class LayoutClass o => PlplotCanvasClass o
toPlplotCanvas :: PlplotCanvasClass o => o -> PlplotCanvas
toPlplotCanvas = unsafeCastGObject . toGObject

instance PlplotCanvasClass PlplotCanvas
instance LayoutClass PlplotCanvas
instance ContainerClass PlplotCanvas
instance WidgetClass PlplotCanvas
instance ObjectClass PlplotCanvas
instance GObjectClass PlplotCanvas where
  toGObject = mkGObject . castForeignPtr . unPlplotCanvas
  unsafeCastGObject = mkPlplotCanvas . castForeignPtr . unGObject

castToPlplotCanvas :: GObjectClass obj => obj -> PlplotCanvas
castToPlplotCanvas = castTo gTypePlplotCanvas "PlplotCanvas"

gTypePlplotCanvas :: GType
gTypePlplotCanvas =
  {# call fun unsafe plplot_canvas_get_type #}

-- Graphics/UI/GTK/Layout/PlplotCanvas.chs.pp

--------------------
-- Constructors

-- | Creates a new 'PlplotCanvas' widget.
--
plplotCanvasNew :: IO PlplotCanvas
plplotCanvasNew =
  makeNewObject mkPlplotCanvas $
  {# call unsafe plplot_canvas_new #}

--------------------
-- Methods

-- | Sets 'PlplotCanvas' widget width and height.
--
plplotCanvasSetSize :: PlplotCanvas
 -> Int
 -> Int
 -> IO ()
plplotCanvasSetSize (PlplotCanvas o) width height =
  {# call plplot_canvas_set_size #}
    (unsafeForeignPtrToPtr o)
    (fromIntegral width)
    (fromIntegral height)

#if defined(PL_DOUBLE) || defined(DOUBLE)
-- | Flt mirrors PLFLT
type Flt = Double
-- type Flt = {#type PLFLT#} -- maps to CDouble
#else
type Flt = Float
#endif

#c
enum BinOpt {
  BinDefault = PL_BIN_DEFAULT,
  BinCentred = PL_BIN_CENTRED,
  BinNoExpand = PL_BIN_NOEXPAND,
  BinNoEmpty = PL_BIN_NOEMPTY
};
#endc

{#enum BinOpt {}#}

class Monad (PLplotM p) => PLplot p where
    adv :: Int -> PLplotM p ()
    col0 :: Int -> PLplotM p ()
    wid :: Int -> PLplotM p ()
    vsta :: PLplotM p ()
    wind :: Flt -> Flt -> Flt -> Flt -> PLplotM p ()
    box :: String -> Flt -> Int -> String -> Flt -> Int -> PLplotM p ()
    lab :: String -> String -> String -> PLplotM p ()
    line :: [(Flt, Flt)] -> PLplotM p ()
    bin :: [BinOpt] -> [(Flt, Flt)] -> PLplotM p ()
    ssub :: Int -> Int -> PLplotM p ()

instance PLplot PlplotCanvas where
    adv page = MkP (\(PlplotCanvas o) -> {# call plplot_canvas_adv #} (unsafeForeignPtrToPtr o) (fromIntegral page))
--    adv page = liftIO $ {# call plplot_canvas_adv #} (unsafeForeignPtrToPtr o) (fromIntegral page)
    col0 icol0 = MkP (\(PlplotCanvas o) -> {# call plplot_canvas_col0 #} (unsafeForeignPtrToPtr o) (fromIntegral icol0))
    wid width = MkP $ \(PlplotCanvas o) -> {# call plplot_canvas_wid #} (unsafeForeignPtrToPtr o) (fromIntegral width)
    vsta = MkP $ \(PlplotCanvas o) -> {# call plplot_canvas_vsta #} (unsafeForeignPtrToPtr o)
    wind xmin xmax ymin ymax = MkP $ \(PlplotCanvas o) -> {# call plplot_canvas_wind #} (unsafeForeignPtrToPtr o) (fromRational (toRational xmin)) (fromRational (toRational xmax)) (fromRational (toRational ymin)) (fromRational (toRational ymax))
    box xopt xtick nxsub yopt ytick nysub = MkP $ \(PlplotCanvas o) -> withCString xopt $ \xo -> withCString yopt $ \yo -> {# call plplot_canvas_box #} (unsafeForeignPtrToPtr o) xo (fromRational (toRational xtick)) (fromIntegral nxsub) yo (fromRational (toRational ytick)) (fromIntegral nysub)
    lab xlabel ylabel zlabel = MkP $ \(PlplotCanvas o) -> withCString xlabel $ \xl -> withCString ylabel $ \yl -> withCString zlabel $ \zl -> {# call plplot_canvas_lab #} (unsafeForeignPtrToPtr o) xl yl zl
    line ps = MkP $ \(PlplotCanvas o) -> withArray xs $ \x -> withArray ys $ \y -> {# call plplot_canvas_line #} (unsafeForeignPtrToPtr o) (fromIntegral (length ps)) x y
                               where (xs', ys') = unzip ps
                                     xs = map (fromRational . toRational) xs'
                                     ys = map (fromRational . toRational) ys'
    ssub = gtk_ssub
    bin = gtk_bin

gtk_ssub :: Int -> Int -> PLplotM PlplotCanvas ()
gtk_ssub nx ny = MkP (\(PlplotCanvas o) -> {# call plplot_canvas_ssub #} (unsafeForeignPtrToPtr o)
						(fromIntegral nx) (fromIntegral ny))

gtk_bin :: [BinOpt] -> [(Flt, Flt)] -> PLplotM PlplotCanvas ()
gtk_bin bops ps = MkP $ \(PlplotCanvas o) -> withArray xs $ \x -> withArray ys $ \y -> {# call plplot_canvas_bin #} (unsafeForeignPtrToPtr o) (fromIntegral (length ps)) x y (fromIntegral bops')
                               where
                                   (xs', ys') = unzip ps
                                   xs = map (fromRational . toRational) xs'
                                   ys = map (fromRational . toRational) ys'
                                   bops' = foldl (.|.) (fromEnum BinDefault)
                                         $ map fromEnum bops

data PLplotM p a = MkP (p -> IO a)

instance Monad (PLplotM PlplotCanvas) where
    return x = MkP $ \p -> return x
    (MkP f) >>= act = MkP $ \p -> do
                      a <- f p
                      let MkP g = act a
                      b <- g p
                      return b

-- instance MonadIO (PLplotM PlplotCanvas) where
--     liftIO act = MkP $ \_ -> do { a <- act ; return a }

runPLplot :: p -> (PLplotM p a) -> IO a
runPLplot p (MkP f) = do
  a <- f p
  return a

-- newtype PLplotM' a = PLplotM PlplotCanvas a