{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Gtk
-- Copyright   :  (c) 2011 Diagrams-cairo team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Convenient interface to rendering diagrams directly
-- on Gtk widgets using the Cairo backend.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.Gtk
       ( defaultRender
       , toGtkCoords
       , renderToGtk
       ) where

import           Diagrams.Backend.Cairo          as Cairo
import           Diagrams.Prelude                hiding (height, width)

-- Below hack is needed because GHC 7.0.x has a bug regarding export
-- of data family constructors; see comments in Diagrams.Backend.Cairo
#if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704
import           Diagrams.Backend.Cairo.Internal
#endif

import qualified Graphics.Rendering.Cairo        as CG
import           Graphics.UI.Gtk

-- | Convert a Diagram to the backend coordinates.
--
-- Provided to Query the diagram with coordinates from a mouse click
-- event.
--
-- > widget `on` buttonPressEvent $ tryEvent $ do
-- >   click <- eventClick
-- >   (x,y) <- eventCoordinates
-- >   let result = runQuery (query $ toGtkCoords myDiagram) (x ^& y)
-- >   do_something_with result
--
-- `toGtkCoords` does no rescaling of the diagram, however it is centered in
-- the window.
toGtkCoords :: Monoid' m => QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m
toGtkCoords :: QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m
toGtkCoords d :: QDiagram Cairo V2 Double m
d = (\(_,_,d' :: QDiagram Cairo V2 Double m
d') -> QDiagram Cairo V2 Double m
d') ((Options Cairo V2 Double, Transformation V2 Double,
  QDiagram Cairo V2 Double m)
 -> QDiagram Cairo V2 Double m)
-> (Options Cairo V2 Double, Transformation V2 Double,
    QDiagram Cairo V2 Double m)
-> QDiagram Cairo V2 Double m
forall a b. (a -> b) -> a -> b
$
  Cairo
-> Options Cairo V2 Double
-> QDiagram Cairo V2 Double m
-> (Options Cairo V2 Double, Transformation V2 Double,
    QDiagram Cairo V2 Double m)
forall b (v :: * -> *) n m.
(Backend b v n, Additive v, Monoid' m, Num n) =>
b
-> Options b v n
-> QDiagram b v n m
-> (Options b v n, Transformation v n, QDiagram b v n m)
adjustDia Cairo
Cairo
            (String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions "" SizeSpec V2 Double
forall (v :: * -> *) n. (Additive v, Num n) => SizeSpec v n
absolute OutputType
RenderOnly Bool
False)
            QDiagram Cairo V2 Double m
d

-- | Render a diagram to a DrawingArea with double buffering,
--   rescaling to fit the full area.
defaultRender :: Monoid' m => DrawingArea -> QDiagram Cairo V2 Double m -> IO ()
defaultRender :: DrawingArea -> QDiagram Cairo V2 Double m -> IO ()
defaultRender drawingarea :: DrawingArea
drawingarea diagram :: QDiagram Cairo V2 Double m
diagram = do
  DrawWindow
drawWindow <- (DrawingArea -> IO DrawWindow
forall widget. WidgetClass widget => widget -> IO DrawWindow
widgetGetDrawWindow DrawingArea
drawingarea)
  DrawWindow
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> IO ()
forall m dc.
(Monoid' m, DrawableClass dc) =>
dc
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> IO ()
renderDoubleBuffered DrawWindow
drawWindow Int -> Int -> Options Cairo V2 Double
forall a a.
(Integral a, Integral a) =>
a -> a -> Options Cairo V2 Double
opts QDiagram Cairo V2 Double m
diagram
    where opts :: a -> a -> Options Cairo V2 Double
opts w :: a
w h :: a
h = ($WCairoOptions :: String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions
              { _cairoFileName :: String
_cairoFileName     = ""
              , _cairoSizeSpec :: SizeSpec V2 Double
_cairoSizeSpec     = V2 Double -> SizeSpec V2 Double
forall (v :: * -> *) n. v n -> SizeSpec v n
dims (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w) (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h))
              , _cairoOutputType :: OutputType
_cairoOutputType   = OutputType
RenderOnly
              , _cairoBypassAdjust :: Bool
_cairoBypassAdjust = Bool
False
              }
           )

-- | Render a diagram to a 'DrawableClass' with double buffering.  No
--   rescaling or transformations will be performed.
--
--   Typically the diagram will already have been transformed by
--   'toGtkCoords'.
renderToGtk ::
  (DrawableClass dc, Monoid' m)
  => dc                     -- ^ widget to render onto
  -> QDiagram Cairo V2 Double m  -- ^ Diagram
  -> IO ()
renderToGtk :: dc -> QDiagram Cairo V2 Double m -> IO ()
renderToGtk drawable :: dc
drawable = do dc
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> IO ()
forall m dc.
(Monoid' m, DrawableClass dc) =>
dc
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> IO ()
renderDoubleBuffered dc
drawable Int -> Int -> Options Cairo V2 Double
forall p p. p -> p -> Options Cairo V2 Double
opts
  where opts :: p -> p -> Options Cairo V2 Double
opts _ _ = ($WCairoOptions :: String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions
                    { _cairoFileName :: String
_cairoFileName     = ""
                    , _cairoSizeSpec :: SizeSpec V2 Double
_cairoSizeSpec     = SizeSpec V2 Double
forall (v :: * -> *) n. (Additive v, Num n) => SizeSpec v n
absolute
                    , _cairoOutputType :: OutputType
_cairoOutputType   = OutputType
RenderOnly
                    , _cairoBypassAdjust :: Bool
_cairoBypassAdjust = Bool
True
                    }
                   )


-- | Render a diagram onto a 'DrawableClass' using the given CairoOptions.
--
--   This uses cairo double-buffering.
renderDoubleBuffered ::
  (Monoid' m, DrawableClass dc) =>
  dc -- ^ drawable to render onto
  -> (Int -> Int -> Options Cairo V2 Double) -- ^ options, depending on drawable width and height
  -> QDiagram Cairo V2 Double m -- ^ Diagram
  -> IO ()
renderDoubleBuffered :: dc
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> IO ()
renderDoubleBuffered drawable :: dc
drawable renderOpts :: Int -> Int -> Options Cairo V2 Double
renderOpts diagram :: QDiagram Cairo V2 Double m
diagram = do
  (w :: Int
w,h :: Int
h) <- dc -> IO (Int, Int)
forall d. DrawableClass d => d -> IO (Int, Int)
drawableGetSize dc
drawable
  let opts :: Options Cairo V2 Double
opts = Int -> Int -> Options Cairo V2 Double
renderOpts Int
w Int
h
      renderAction :: Render ()
renderAction = Int -> Int -> Render ()
delete Int
w Int
h Render () -> Render () -> Render ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (IO (), Render ()) -> Render ()
forall a b. (a, b) -> b
snd (Cairo
-> Options Cairo V2 Double
-> QDiagram Cairo V2 Double m
-> Result Cairo V2 Double
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Cairo
Cairo Options Cairo V2 Double
opts QDiagram Cairo V2 Double m
diagram)
  dc -> Render () -> IO ()
forall drawable a.
DrawableClass drawable =>
drawable -> Render a -> IO a
renderWithDrawable dc
drawable (Render () -> Render ()
doubleBuffer Render ()
renderAction)


-- | White rectangle of size (w,h).
--
--   Used to clear canvas when using double buffering.
delete :: Int -> Int -> CG.Render ()
delete :: Int -> Int -> Render ()
delete w :: Int
w h :: Int
h = do
  Double -> Double -> Double -> Render ()
CG.setSourceRGB 1 1 1
  Double -> Double -> Double -> Double -> Render ()
CG.rectangle 0 0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
  Render ()
CG.fill


-- | Wrap the given render action in double buffering.
doubleBuffer :: CG.Render () -> CG.Render ()
doubleBuffer :: Render () -> Render ()
doubleBuffer renderAction :: Render ()
renderAction = do
  Render ()
CG.pushGroup
  Render ()
renderAction
  Render ()
CG.popGroupToSource
  Render ()
CG.paint