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