module Diagrams.Backend.Gtk
( defaultRender
, toGtkCoords
, renderToGtk
) where
import Diagrams.Backend.Cairo as Cairo
import Diagrams.Prelude hiding (height, width)
#if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704
import Diagrams.Backend.Cairo.Internal
#endif
import qualified Graphics.Rendering.Cairo as CG
import Graphics.UI.Gtk
toGtkCoords :: Monoid' m => QDiagram Cairo R2 m -> QDiagram Cairo R2 m
toGtkCoords d = (\(_,_,d') -> d') $
adjustDia Cairo
(CairoOptions "" Absolute RenderOnly False)
d
defaultRender :: Monoid' m => DrawingArea -> QDiagram Cairo R2 m -> IO ()
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
}
)
renderToGtk ::
(DrawableClass dc, Monoid' m)
=> dc
-> QDiagram Cairo R2 m
-> IO ()
renderToGtk drawable = do renderDoubleBuffered drawable opts
where opts _ _ = (CairoOptions
{ _cairoFileName = ""
, _cairoSizeSpec = Absolute
, _cairoOutputType = RenderOnly
, _cairoBypassAdjust = True
}
)
renderDoubleBuffered ::
(Monoid' m, DrawableClass dc) =>
dc
-> (Int -> Int -> Options Cairo R2)
-> QDiagram Cairo R2 m
-> 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)
delete :: Int -> Int -> CG.Render ()
delete w h = do
CG.setSourceRGB 1 1 1
CG.rectangle 0 0 (fromIntegral w) (fromIntegral h)
CG.fill
doubleBuffer :: CG.Render () -> CG.Render ()
doubleBuffer renderAction = do
CG.pushGroup
renderAction
CG.popGroupToSource
CG.paint