{-# LANGUAGE CPP #-}
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 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
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
}
)
renderToGtk ::
(DrawableClass dc, Monoid' m)
=> dc
-> QDiagram Cairo V2 Double m
-> 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
}
)
renderDoubleBuffered ::
(Monoid' m, DrawableClass dc) =>
dc
-> (Int -> Int -> Options Cairo V2 Double)
-> QDiagram Cairo V2 Double m
-> 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)
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
doubleBuffer :: CG.Render () -> CG.Render ()
doubleBuffer :: Render () -> Render ()
doubleBuffer renderAction :: Render ()
renderAction = do
Render ()
CG.pushGroup
Render ()
renderAction
Render ()
CG.popGroupToSource
Render ()
CG.paint