HPlot-0.1: Graphics/PLplot.chs

-- -*- haskell -*-
-- {-# LANGUAGE: ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.PLplot
-- License     :  BSD-style
-- 
-- Maintainer  :  Yakov Z <iakovz@gmail.com>
-- 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(..)
  -- , adv
  -- , col0
  -- , wid
  -- , vsta
  -- , wind
  -- , box
  -- , lab
  -- , line

  , PLplotM
  , runPLplot
  ) where

-- import Control.Monad	(liftM)
-- import Control.Monad.Trans
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)

class Monad (PLplotM p) => PLplot p where
    adv :: Int -> PLplotM p () -- p -> IO ()
    col0 :: Int -> PLplotM p ()
    wid :: Int -> PLplotM p ()
    vsta :: PLplotM p ()
    wind :: Float -> Float -> Float -> Float -> PLplotM p ()
    box :: String -> Float -> Int -> String -> Float -> Int -> PLplotM p ()
    lab :: String -> String -> String -> PLplotM p ()
    line :: [(Double, Double)] -> PLplotM p ()   -- XXX

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'

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