diagrams-gtk 1.0 → 1.0.1

raw patch · 3 files changed

+73/−37 lines, 3 filesdep +cairodep ~diagrams-cairodep ~diagrams-lib

Dependencies added: cairo

Dependency ranges changed: diagrams-cairo, diagrams-lib

Files

• CHANGES.markdown +5/−0
• diagrams-gtk.cabal +6/−5
• src/Diagrams/Backend/Gtk.hs +62/−32

@@ -1,3 +1,8 @@+1.0.1: 8 March 2014+-------------------++* Use double buffering. Thanks to Jonas Haag for the patch.+ 1.0: 25 November 2013 --------------------- 

@@ -1,5 +1,5 @@ name:                diagrams-gtk-version:             1.0+version:             1.0.1 synopsis:            Backend for rendering diagrams directly to GTK windows description:         An optional add-on to the diagrams-cairo package                      which allows rendering diagrams directly to GTK windows.@@ -12,7 +12,7 @@ category:            Graphics build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC == 7.2.1, GHC == 7.4.2+tested-with:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1 extra-source-files:  CHANGES.markdown, README.markdown  source-repository head@@ -22,8 +22,9 @@ library   exposed-modules:     Diagrams.Backend.Gtk   build-depends:       base >= 4.2 && < 4.8,-                       diagrams-lib >= 1.0 && < 1.1,-                       diagrams-cairo >= 1.0 && < 1.1,-                       gtk >= 0.12.0 && < 0.13+                       diagrams-lib >= 1.0 && < 1.2,+                       diagrams-cairo >= 1.0 && < 1.2,+                       gtk >= 0.12.0 && < 0.13,+                       cairo >= 0.12.4 && < 0.13   hs-source-dirs:      src   default-language:    Haskell2010

@@ -17,17 +17,17 @@        , renderToGtk        ) where -import Diagrams.Prelude hiding (width, height)-import Diagrams.Backend.Cairo as Cairo+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+import           Diagrams.Backend.Cairo.Internal #endif -import Graphics.UI.Gtk-import qualified Graphics.UI.Gtk.Cairo as CG+import qualified Graphics.Rendering.Cairo        as CG+import           Graphics.UI.Gtk  -- | Convert a Diagram to the backend coordinates. --@@ -48,24 +48,22 @@             (CairoOptions "" Absolute RenderOnly False)             d --- | Render a diagram to a DrawingArea, rescaling to fit the full area.+-- | Render a diagram to a DrawingArea with double buffering,+--   rescaling to fit the full area. defaultRender :: Monoid' m => DrawingArea -> QDiagram Cairo R2 m -> IO ()-defaultRender da d = do-  (w,h) <- widgetGetSize da-  dw <- widgetGetDrawWindow da-  let r = snd $ renderDia Cairo-                  (CairoOptions-                     { _cairoFileName     = ""-                     , _cairoSizeSpec     = Dims (fromIntegral w) (fromIntegral h)-                     , _cairoOutputType   = RenderOnly-                     , _cairoBypassAdjust = False-                     }-                  )-                  d-  CG.renderWithDrawable dw r+defaultRender drawingarea diagram = do+  drawWindow <- (widgetGetDrawWindow drawingarea)+  renderDoubleBuffered drawWindow opts diagram+    where opts w h = (CairoOptions+              { _cairoFileName     = ""+              , _cairoSizeSpec     = Dims (fromIntegral w) (fromIntegral h)+              , _cairoOutputType   = RenderOnly+              , _cairoBypassAdjust = False+              }+           ) --- | Render a diagram to a 'DrawableClass'.  No rescaling or---   transformations will be performed.+-- | 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'.@@ -74,14 +72,46 @@   => dc                     -- ^ widget to render onto   -> QDiagram Cairo R2 m  -- ^ Diagram   -> IO ()-renderToGtk dc d = do-  let r = snd $ renderDia Cairo-                  (CairoOptions-                     { _cairoFileName     = ""-                     , _cairoSizeSpec     = Absolute-                     , _cairoOutputType   = RenderOnly-                     , _cairoBypassAdjust = True-                     }-                  )-                  d-  CG.renderWithDrawable dc r+renderToGtk drawable = do renderDoubleBuffered drawable opts+  where opts _ _ = (CairoOptions+                    { _cairoFileName     = ""+                    , _cairoSizeSpec     = Absolute+                    , _cairoOutputType   = RenderOnly+                    , _cairoBypassAdjust = 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 R2) -- ^ options, depending on drawable width and height+  -> QDiagram Cairo R2 m -- ^ Diagram+  -> IO ()+renderDoubleBuffered drawable renderOpts diagram = do+  (w,h) <- drawableGetSize drawable+  let opts = renderOpts w h+      renderAction = delete w h >> snd (renderDia Cairo opts diagram)+  renderWithDrawable drawable (doubleBuffer renderAction)+++-- | White rectangle of size (w,h).+--+--   Used to clear canvas when using double buffering.+delete :: Int -> Int -> CG.Render ()+delete w h = do+  CG.setSourceRGB 1 1 1+  CG.rectangle 0 0 (fromIntegral w) (fromIntegral h)+  CG.fill+++-- | Wrap the given render action in double buffering.+doubleBuffer :: CG.Render () -> CG.Render ()+doubleBuffer renderAction = do+  CG.pushGroup+  renderAction+  CG.popGroupToSource+  CG.paint