{-# 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 :: forall m.
Monoid' m =>
QDiagram Cairo V2 Double m -> QDiagram Cairo V2 Double m
toGtkCoords QDiagram Cairo V2 Double m
d = (\(Options Cairo V2 Double
_,Transformation V2 Double
_,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 String
"" 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 :: forall m.
Monoid' m =>
DrawingArea -> QDiagram Cairo V2 Double m -> IO ()
defaultRender DrawingArea
drawingarea 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 a
w a
h = (CairoOptions :: String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions
{ _cairoFileName :: String
_cairoFileName = String
""
, _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 :: forall dc m.
(DrawableClass dc, Monoid' m) =>
dc -> QDiagram Cairo V2 Double m -> IO ()
renderToGtk 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 p
_ p
_ = (CairoOptions :: String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions
{ _cairoFileName :: String
_cairoFileName = String
""
, _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 :: 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
renderOpts QDiagram Cairo V2 Double m
diagram = do
(Int
w,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 Int
w Int
h = do
Double -> Double -> Double -> Render ()
CG.setSourceRGB Double
1 Double
1 Double
1
Double -> Double -> Double -> Double -> Render ()
CG.rectangle Double
0 Double
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 Render ()
renderAction = do
Render ()
CG.pushGroup
Render ()
renderAction
Render ()
CG.popGroupToSource
Render ()
CG.paint