← Back to branch summary

~ubuntu-branches/ubuntu/trusty/haskell-diagrams-gtk/trusty-proposed

« back to all changes in this revision

Viewing changes to src/Diagrams/Backend/Gtk.hs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2013-01-05 13:14:12 UTC
  • Revision ID: package-import@ubuntu.com-20130105131412-q1lxhwc9xdnli2yf
Tags: upstream-0.6
Import upstream version 0.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/Diagrams/Backend/Gtk.hs
 
1
{-# LANGUAGE CPP #-}
 
2
-----------------------------------------------------------------------------
 
3
-- |
 
4
-- Module      :  Diagrams.Backend.Gtk
 
5
-- Copyright   :  (c) 2011 Diagrams-cairo team (see LICENSE)
 
6
-- License     :  BSD-style (see LICENSE)
 
7
-- Maintainer  :  diagrams-discuss@googlegroups.com
 
8
--
 
9
-- Convenient interface to rendering diagrams directly
 
10
-- on Gtk widgets using the Cairo backend.
 
11
--
 
12
-----------------------------------------------------------------------------
 
13
 
 
14
module Diagrams.Backend.Gtk
 
15
       ( defaultRender
 
16
       , toGtkCoords
 
17
       , renderToGtk
 
18
       ) where
 
19
 
 
20
import Diagrams.Prelude hiding (width, height)
 
21
import Diagrams.Backend.Cairo as Cairo
 
22
 
 
23
-- Below hack is needed because GHC 7.0.x has a bug regarding export
 
24
-- of data family constructors; see comments in Diagrams.Backend.Cairo
 
25
#if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704
 
26
import Diagrams.Backend.Cairo.Internal
 
27
#endif
 
28
 
 
29
import Graphics.UI.Gtk
 
30
import qualified Graphics.UI.Gtk.Cairo as CG
 
31
 
 
32
-- | Convert a Diagram to the backend coordinates.
 
33
--
 
34
-- Provided to Query the diagram with coordinates from a mouse click
 
35
-- event.
 
36
--
 
37
-- > widget `on` buttonPressEvent $ tryEvent $ do
 
38
-- >   click <- eventClick
 
39
-- >   (x,y) <- eventCoordinates
 
40
-- >   let result = runQuery (query $ toGtkCoords myDiagram) (P (x,y))
 
41
-- >   do_something_with result
 
42
--
 
43
-- `toGtkCoords` does no rescaling of the diagram, however it is centered in
 
44
-- the window.
 
45
toGtkCoords :: Monoid' m => QDiagram Cairo R2 m -> QDiagram Cairo R2 m
 
46
toGtkCoords d = snd $
 
47
  adjustDia Cairo
 
48
            (CairoOptions "" Absolute RenderOnly False)
 
49
            d
 
50
 
 
51
-- | Render a diagram to a DrawingArea, rescaling to fit the full area.
 
52
defaultRender :: Monoid' m => DrawingArea -> QDiagram Cairo R2 m -> IO ()
 
53
defaultRender da d = do
 
54
  (w,h) <- widgetGetSize da
 
55
  dw <- widgetGetDrawWindow da
 
56
  let r = snd $ renderDia Cairo
 
57
                  (CairoOptions
 
58
                     { cairoFileName     = ""
 
59
                     , cairoSizeSpec     = Dims (fromIntegral w) (fromIntegral h)
 
60
                     , cairoOutputType   = RenderOnly
 
61
                     , cairoBypassAdjust = False
 
62
                     }
 
63
                  )
 
64
                  d
 
65
  CG.renderWithDrawable dw r
 
66
 
 
67
-- | Render a diagram to a 'DrawableClass'.  No rescaling or
 
68
--   transformations will be performed.
 
69
--
 
70
--   Typically the diagram will already have been transformed by
 
71
--   'toGtkCoords'.
 
72
renderToGtk ::
 
73
  (DrawableClass dc, Monoid' m)
 
74
  => dc                     -- ^ widget to render onto
 
75
  -> QDiagram Cairo R2 m  -- ^ Diagram
 
76
  -> IO ()
 
77
renderToGtk dc d = do
 
78
  let r = snd $ renderDia Cairo
 
79
                  (CairoOptions
 
80
                     { cairoFileName     = ""
 
81
                     , cairoSizeSpec     = Absolute
 
82
                     , cairoOutputType   = RenderOnly
 
83
                     , cairoBypassAdjust = True
 
84
                     }
 
85
                  )
 
86
                  d
 
87
  CG.renderWithDrawable dc r