1-- Example of an drawing graphics onto a canvas.
2import Graphics.UI.Gtk
3import Graphics.Rendering.Cairo
4import Control.Monad.Trans ( liftIO )
5import Graphics.UI.Gtk.Gdk.EventM
6
7run :: Render () -> IO ()
8run act = do
9  initGUI
10  dia <- dialogNew
11  dialogAddButton dia stockClose ResponseClose
12  contain <- dialogGetUpper dia
13  canvas <- drawingAreaNew
14  canvas `onSizeRequest` return (Requisition 250 250)
15  canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas act
16  boxPackStartDefaults contain canvas
17  widgetShow canvas
18  dialogRun dia
19  widgetDestroy dia
20  -- Flush all commands that are waiting to be sent to the graphics server.
21  -- This ensures that the window is actually closed before ghci displays the
22  -- prompt again.
23  flush
24
25  where updateCanvas :: DrawingArea -> Render () -> EventM EExpose ()
26        updateCanvas canvas act = liftIO $ do
27          win <- widgetGetDrawWindow canvas
28          renderWithDrawable win act
29
30setRed :: Render ()
31setRed = do
32  setSourceRGB 1 0 0
33
34
35
36setFat :: Render ()
37setFat = do
38  setLineWidth 20
39  setLineCap LineCapRound
40
41
42
43drawSquare :: Double -> Double -> Render ()
44drawSquare width height = do
45  (x,y) <- getCurrentPoint
46  lineTo (x+width) y
47  lineTo (x+width) (y+height)
48  lineTo x (y+height)
49  closePath
50  stroke
51
52
53
54drawHCirc :: Double -> Double -> Double -> Render ()
55drawHCirc x y radius = do
56  arc x y radius 0 pi
57  stroke
58
59
60
61drawStr :: String -> Render ()
62drawStr txt = do
63  lay <- createLayout txt
64  showLayout lay
65
66
67
68drawStr_ :: String -> Render ()
69drawStr_ txt = do
70  lay <- liftIO $ do
71    ctxt <- cairoCreateContext Nothing
72    descr <- contextGetFontDescription ctxt
73    descr `fontDescriptionSetSize` 20
74    ctxt `contextSetFontDescription` descr
75    layoutText ctxt txt
76  showLayout lay
77