cairo 0.13.3.1 → 0.13.4.0
raw patch · 26 files changed
+2181/−1131 lines, 26 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Graphics/Rendering/Cairo/Internal/Utilities.chs +2/−1
- cairo.cabal +25/−17
- demo/CairoGhci.hs +0/−76
- demo/Clock.hs +0/−407
- demo/Drawing.hs +0/−59
- demo/Drawing2.hs +0/−258
- demo/Graph.hs +0/−98
- demo/Makefile +0/−33
- demo/StarAndRing.hs +0/−111
- demo/Text.hs +0/−71
- demo/gtk2/CairoGhci.hs +76/−0
- demo/gtk2/Clock.hs +407/−0
- demo/gtk2/Drawing.hs +59/−0
- demo/gtk2/Drawing2.hs +258/−0
- demo/gtk2/Graph.hs +98/−0
- demo/gtk2/Makefile +33/−0
- demo/gtk2/StarAndRing.hs +111/−0
- demo/gtk2/Text.hs +71/−0
- demo/gtk3/CairoGhci.hs +76/−0
- demo/gtk3/Clock.hs +329/−0
- demo/gtk3/Drawing.hs +58/−0
- demo/gtk3/Drawing2.hs +261/−0
- demo/gtk3/Graph.hs +102/−0
- demo/gtk3/Makefile +33/−0
- demo/gtk3/StarAndRing.hs +111/−0
- demo/gtk3/Text.hs +71/−0
Graphics/Rendering/Cairo/Internal/Utilities.chs view
@@ -18,7 +18,8 @@ import Foreign import Foreign.C-#if __GLASGOW_HASKELL__ >= 707+-- TODO work around cpphs https://ghc.haskell.org/trac/ghc/ticket/13553+#if __GLASGOW_HASKELL__ >= 707 || __GLASGOW_HASKELL__ == 0 import System.IO.Unsafe (unsafePerformIO) #endif
cairo.cabal view
@@ -1,5 +1,5 @@ Name: cairo-Version: 0.13.3.1+Version: 0.13.4.0 License: BSD3 License-file: COPYRIGHT Copyright: (c) 2001-2010 The Gtk2Hs Team, (c) Paolo Martini 2005, (c) Abraham Egnor 2003, 2004, (c) Aetion Technologies LLC 2004@@ -18,17 +18,25 @@ Tested-With: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.1 extra-source-files: cairo-gtk2hs.h -Data-Dir: demo-Data-Files: cairo-clock-icon.png- CairoGhci.hs- Clock.hs- Drawing2.hs- Drawing.hs- Graph.hs- Makefile- StarAndRing.hs- Text.hs- +Data-Dir: demo+Data-Files: cairo-clock-icon.png+ gtk2/CairoGhci.hs+ gtk2/Clock.hs+ gtk2/Drawing2.hs+ gtk2/Drawing.hs+ gtk2/Graph.hs+ gtk2/Makefile+ gtk2/StarAndRing.hs+ gtk2/Text.hs+ gtk3/CairoGhci.hs+ gtk3/Clock.hs+ gtk3/Drawing2.hs+ gtk3/Drawing.hs+ gtk3/Graph.hs+ gtk3/Makefile+ gtk3/StarAndRing.hs+ gtk3/Text.hs+ Source-Repository head type: git location: https://github.com/gtk2hs/gtk2hs@@ -36,13 +44,13 @@ Flag cairo_pdf Description: Build the PDF backend of Cairo.- + Flag cairo_ps Description: Build the PostScript backend of Cairo. Flag cairo_svg Description: Build the Scalable Vector Graphics (SVG) backend of Cairo.- + custom-setup setup-depends: base >= 4.6, Cabal >= 1.24 && < 1.25,@@ -56,8 +64,8 @@ exposed-modules: Graphics.Rendering.Cairo Graphics.Rendering.Cairo.Matrix Graphics.Rendering.Cairo.Types- -- this module is only meant to be used by other- -- modules implementing a Cairo interface+ -- this module is only meant to be used by other+ -- modules implementing a Cairo interface Graphics.Rendering.Cairo.Internal other-modules: Graphics.Rendering.Cairo.Internal.Drawing.Cairo@@ -85,5 +93,5 @@ pkgconfig-depends: cairo-ps if flag(cairo_svg) pkgconfig-depends: cairo-svg- if os(darwin)+ if os(darwin) || os(freebsd) cpp-options: -D__attribute__(A)= -D_Nullable= -D_Nonnull=
− demo/CairoGhci.hs
@@ -1,76 +0,0 @@--- Example of an drawing graphics onto a canvas.-import Graphics.UI.Gtk-import Graphics.Rendering.Cairo-import Control.Monad.Trans ( liftIO )-import Graphics.UI.Gtk.Gdk.EventM--run :: Render () -> IO ()-run act = do- initGUI- dia <- dialogNew- dialogAddButton dia stockClose ResponseClose- contain <- dialogGetUpper dia- canvas <- drawingAreaNew- canvas `onSizeRequest` return (Requisition 250 250)- canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas act- boxPackStartDefaults contain canvas- widgetShow canvas- dialogRun dia- widgetDestroy dia- -- Flush all commands that are waiting to be sent to the graphics server.- -- This ensures that the window is actually closed before ghci displays the- -- prompt again.- flush-- where updateCanvas :: DrawingArea -> Render () -> EventM EExpose ()- updateCanvas canvas act = liftIO $ do- win <- widgetGetDrawWindow canvas- renderWithDrawable win act--setRed :: Render ()-setRed = do- setSourceRGB 1 0 0----setFat :: Render ()-setFat = do- setLineWidth 20- setLineCap LineCapRound----drawSquare :: Double -> Double -> Render ()-drawSquare width height = do- (x,y) <- getCurrentPoint- lineTo (x+width) y- lineTo (x+width) (y+height)- lineTo x (y+height)- closePath- stroke----drawHCirc :: Double -> Double -> Double -> Render ()-drawHCirc x y radius = do- arc x y radius 0 pi- stroke----drawStr :: String -> Render ()-drawStr txt = do- lay <- createLayout txt- showLayout lay----drawStr_ :: String -> Render ()-drawStr_ txt = do- lay <- liftIO $ do- ctxt <- cairoCreateContext Nothing- descr <- contextGetFontDescription ctxt- descr `fontDescriptionSetSize` 20- ctxt `contextSetFontDescription` descr- layoutText ctxt txt- showLayout lay
− demo/Clock.hs
@@ -1,407 +0,0 @@--- original author:--- Mirco "MacSlow" Mueller <macslow@bangang.de>------ created:--- 10.1.2006 (or so)------ http://www.gnu.org/licenses/licenses.html#GPL------ ported to Haskell by:--- Duncan Coutts <duncan.coutts@worc.ox.ac.uk>-----import Graphics.Rendering.Cairo-import Graphics.UI.Gtk-import Graphics.UI.Gtk.Gdk.EventM-import System.Time-import Control.Monad (when)-import Data.Maybe (isJust)-import Data.IORef--drawClockBackground :: Bool -> Int -> Int -> Render ()-drawClockBackground quality width height = do- save- scale (fromIntegral width) (fromIntegral height)-- save- setOperator OperatorOver- when quality drawDropShadow- drawClockFace quality- restore-- translate 0.5 0.5- scale 0.4 0.4- setSourceRGB 0.16 0.18 0.19- setLineWidth (1.5/60)- setLineCap LineCapRound- setLineJoin LineJoinRound- drawHourMarks-- restore--drawClockHands :: Bool -> Int -> Int -> Render ()-drawClockHands quality width height = do- save- scale (fromIntegral width) (fromIntegral height)-- translate 0.5 0.5- scale 0.4 0.4- setSourceRGB 0.16 0.18 0.19- setLineWidth (1.5/60)- setLineCap LineCapRound- setLineJoin LineJoinRound-- time <- liftIO (getClockTime >>= toCalendarTime)- let hours = fromIntegral (if ctHour time >= 12- then ctHour time - 12- else ctHour time)- minutes = fromIntegral (ctMin time)- seconds = fromIntegral (ctSec time)-- drawHourHand quality hours minutes seconds- drawMinuteHand quality minutes seconds- drawSecondHand quality seconds-- restore--drawClockForeground :: Bool -> Int -> Int -> Render ()-drawClockForeground quality width height = do- scale (fromIntegral width) (fromIntegral height)-- save- translate 0.5 0.5- scale 0.4 0.4- setSourceRGB 0.16 0.18 0.19- setLineWidth (1.5/60)- setLineCap LineCapRound- setLineJoin LineJoinRound-- when quality drawInnerShadow- when quality drawReflection- drawFrame quality- restore--drawDropShadow =- withRadialPattern 0.55 0.55 0.25 0.5 0.5 0.525 $ \pattern -> do- patternAddColorStopRGBA pattern 0 0 0 0 0.811- patternAddColorStopRGBA pattern 0.64 0.345 0.345 0.345 0.317- patternAddColorStopRGBA pattern 0.84 0.713 0.713 0.713 0.137- patternAddColorStopRGBA pattern 1 1 1 1 0- patternSetFilter pattern FilterFast- setSource pattern- arc 0.5 0.5 (142/150) 0 (pi*2)- fill--drawClockFace True =- withLinearPattern 0.5 0 0.5 1 $ \pattern -> do- patternAddColorStopRGB pattern 0 0.91 0.96 0.93- patternAddColorStopRGB pattern 1 0.65 0.68 0.68- patternSetFilter pattern FilterFast- setSource pattern- translate 0.5 0.5- arc 0 0 (60/150) 0 (pi*2)- fill-drawClockFace False = do- setSourceRGB 0.78 0.82 0.805- translate 0.5 0.5- arc 0 0 (60/150) 0 (pi*2)- fill--drawHourMarks = do- save- forM_ [1..12] $ \_ -> do- rotate (pi/6)- moveTo (4.5/6) 0- lineTo (5.0/6) 0- stroke- restore--forM_ = flip mapM_--drawHourHand quality hours minutes seconds = do- save- rotate (-pi/2)- setLineCap LineCapSquare- setLineJoin LineJoinMiter- rotate ( (pi/6) * hours- + (pi/360) * minutes- + (pi/21600) * seconds)-- -- hour hand's shadow- when quality $ do- setLineWidth (1.75/60)- setOperator OperatorAtop- setSourceRGBA 0.16 0.18 0.19 0.125- moveTo (-2/15 + 0.025) 0.025- lineTo (7/15 + 0.025) 0.025- stroke-- -- the hand itself- setLineWidth (1/60)- setOperator OperatorOver- setSourceRGB 0.16 0.18 0.19- moveTo (-2/15) 0- lineTo (7/15) 0- stroke- restore--drawMinuteHand quality minutes seconds = do- save- rotate (-pi/2)- setLineCap LineCapSquare- setLineJoin LineJoinMiter- rotate ( (pi/30) * minutes- + (pi/1800) * seconds)-- -- minute hand's shadow- when quality $ do- setLineWidth (1.75/60)- setOperator OperatorAtop- setSourceRGBA 0.16 0.18 0.19 0.125- moveTo (-16/75 - 0.025) (-0.025)- lineTo (2/3 - 0.025) (-0.025)- stroke-- -- the minute hand itself- setLineWidth (1/60)- setOperator OperatorOver- setSourceRGB 0.16 0.18 0.19- moveTo (-16/75) 0- lineTo (2/3) 0- stroke- restore--drawSecondHand quality seconds = do- save- rotate (-pi/2)- setLineCap LineCapSquare- setLineJoin LineJoinMiter- rotate (seconds * pi/30);-- -- shadow of second hand-part- when quality $ do- setOperator OperatorAtop- setSourceRGBA 0.16 0.18 0.19 0.125- setLineWidth (1.3125 / 60)- moveTo (-1.5/5 + 0.025) 0.025- lineTo (3/5 + 0.025) 0.025- stroke-- -- second hand- setOperator OperatorOver- setSourceRGB 0.39 0.58 0.77- setLineWidth (0.75/60)- moveTo (-1.5/5) 0- lineTo (3/5) 0- stroke-- arc 0 0 (1/20) 0 (pi*2)- fill- arc (63/100) 0 (1/35) 0 (pi*2)- stroke- setLineWidth (1/100)- moveTo (10/15) 0- lineTo (12/15) 0- stroke- setSourceRGB 0.31 0.31 0.31- arc 0 0 (1/25) 0 (pi*2)- fill- restore--drawInnerShadow = do- save- setOperator OperatorOver- arc 0 0 (142/150) 0 (pi*2)- clip- withRadialPattern 0.3 0.3 0.1 0 0 0.95 $ \pattern -> do- patternAddColorStopRGBA pattern 0 1 1 1 0- patternAddColorStopRGBA pattern 0.64 0.713 0.713 0.713 0.137- patternAddColorStopRGBA pattern 0.84 0.345 0.345 0.345 0.317- patternAddColorStopRGBA pattern 1 0 0 0 0.811- patternSetFilter pattern FilterFast- setSource pattern- arc 0 0 (142/150) 0 (pi*2)- fill- restore--drawReflection = do- save- arc 0 0 (142/150) 0 (pi*2)- clip- rotate (-75 * pi/180)- setSourceRGBA 0.87 0.9 0.95 0.25- moveTo (-1) (-1)- lineTo 1 (-1)- lineTo 1 1- curveTo 1 0.15 (-0.15) (-1) (-1) (-1)- fill- moveTo (-1) (-1)- lineTo (-1) 1- lineTo 1 1- curveTo (-0.5) 1 (-1) 0.5 (-1) (-1)- fill- restore--drawFrame True = do- save- withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do- patternAddColorStopRGB pattern 0 0.4 0.4 0.4- patternAddColorStopRGB pattern 0.2 0.95 0.95 0.95- patternSetFilter pattern FilterFast- setSource pattern- setLineWidth (10/75)- arc 0 0 (142/150) 0 (pi*2)- stroke-- withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do- patternAddColorStopRGB pattern 0 0.9 0.9 0.9- patternAddColorStopRGB pattern 0.2 0.35 0.35 0.35- patternSetFilter pattern FilterFast- setSource pattern- setLineWidth (10/75)- arc 0 0 (150/150) 0 (pi*2)- stroke- restore-drawFrame False = do- save- setSourceRGB 0 0 0- setLineWidth (10/75)- arc 0 0 1 0 (pi*2)- stroke- restore--initialSize :: Int-initialSize = 256--main = do- initGUI-- window <- windowNew- windowSetDecorated window False- windowSetResizable window True- windowSetPosition window WinPosCenterAlways-- widgetSetAppPaintable window True- windowSetIconFromFile window "cairo-clock-icon.png"- windowSetTitle window "Gtk2Hs Cairo Clock"- windowSetDefaultSize window initialSize initialSize- windowSetGeometryHints window (Just window)- (Just (32, 32)) (Just (512, 512))- Nothing Nothing (Just (1,1))-- let setAlpha widget = do- screen <- widgetGetScreen widget- colormap <- screenGetRGBAColormap screen- maybe (return ()) (widgetSetColormap widget) colormap- setAlpha window --TODO: also call setAlpha on alpha screen change-- window `on` keyPressEvent $ tryEvent $ do- "Escape" <- eventKeyName- liftIO mainQuit-- window `on` buttonPressEvent $ tryEvent $ do- LeftButton <- eventButton- time <- eventTime- (x,y) <- eventRootCoordinates- liftIO $ windowBeginMoveDrag window LeftButton (round x) (round y) time-- window `on` buttonPressEvent $ tryEvent $ do- MiddleButton <- eventButton- time <- eventTime- (x,y) <- eventRootCoordinates- liftIO $ windowBeginResizeDrag window WindowEdgeSouthEast MiddleButton- (round x) (round y) time-- timeoutAdd (widgetQueueDraw window >> return True) 1000-- backgroundRef <- newIORef (Just undefined)- foregroundRef <- newIORef (Just undefined)-- let redrawStaticLayers = do- (width, height) <- widgetGetSize window- drawWin <- widgetGetDrawWindow window- background <- createImageSurface FormatARGB32 width height- foreground <- createImageSurface FormatARGB32 width height- let clear = do- save- setOperator OperatorClear- paint- restore- renderWith background $ do- clear- drawClockBackground True width height- renderWith foreground $ do- clear- drawClockForeground True width height- writeIORef backgroundRef (Just background)- writeIORef foregroundRef (Just foreground)-- onRealize window redrawStaticLayers-- sizeRef <- newIORef (initialSize, initialSize)- timeoutHandlerRef <- newIORef Nothing- window `on` configureEvent $ do- (w,h) <- eventSize- liftIO $ do- size <- readIORef sizeRef- writeIORef sizeRef (w,h)- when (size /= (w,h)) $ do-- background <- readIORef backgroundRef- foreground <- readIORef foregroundRef- maybe (return ()) surfaceFinish background- maybe (return ()) surfaceFinish foreground-- writeIORef backgroundRef Nothing- writeIORef foregroundRef Nothing-- timeoutHandler <- readIORef timeoutHandlerRef- maybe (return ()) timeoutRemove timeoutHandler-- handler <- timeoutAddFull (do- writeIORef timeoutHandlerRef Nothing- redrawStaticLayers- widgetQueueDraw window- return False- ) priorityDefaultIdle 300- writeIORef timeoutHandlerRef (Just handler)-- return False-- window `on` exposeEvent $ do- drawWin <- eventWindow- exposeRegion <- eventRegion- liftIO $ do- (width, height) <- drawableGetSize drawWin-- background <- readIORef backgroundRef- foreground <- readIORef foregroundRef-- renderWithDrawable drawWin $ do- region exposeRegion- clip-- save- setOperator OperatorSource- setSourceRGBA 0 0 0 0- paint- restore-- case background of- Nothing -> drawClockBackground False width height- Just background -> do- setSourceSurface background 0 0- paint-- drawClockHands (isJust background) width height-- case foreground of- Nothing -> drawClockForeground False width height- Just foreground -> do- setSourceSurface foreground 0 0- paint-- return True-- widgetShowAll window- mainGUI
− demo/Drawing.hs
@@ -1,59 +0,0 @@--- Example of an drawing graphics onto a canvas.-import Graphics.UI.Gtk-import Graphics.Rendering.Cairo-import Graphics.UI.Gtk.Gdk.EventM--main = do- initGUI- dia <- dialogNew- dialogAddButton dia stockOk ResponseOk- contain <- dialogGetUpper dia- canvas <- drawingAreaNew- canvas `on` sizeRequest $ return (Requisition 40 40)- ctxt <- cairoCreateContext Nothing- text <- layoutEmpty ctxt- text `layoutSetText` "Hello World."- canvas `on` exposeEvent $ updateCanvas text- boxPackStartDefaults contain canvas- widgetShow canvas- dialogRun dia- return ()--updateCanvas :: PangoLayout -> EventM EExpose Bool-updateCanvas text = do- win <- eventWindow- liftIO $ do- (width',height') <- drawableGetSize win- let width = realToFrac width'- height = realToFrac height'-- -- Draw using the cairo api- renderWithDrawable win $ do- setSourceRGB 1 0 0- setLineWidth 20- setLineCap LineCapRound- setLineJoin LineJoinRound-- moveTo 30 30- lineTo (width-30) (height-30)- lineTo (width-30) 30- lineTo 30 (height-30)- stroke-- setSourceRGB 1 1 0- setLineWidth 4-- save- translate (width / 2) (height / 2)- scale (width / 2) (height / 2)- arc 0 0 1 (135 * pi/180) (225 * pi/180)- restore- stroke-- setSourceRGB 0 0 0- moveTo 30 (realToFrac height / 4)- rotate (pi/4)- showLayout text--- return True
− demo/Drawing2.hs
@@ -1,258 +0,0 @@------ Author: Johan Bockgård <bojohan@dd.chalmers.se>------ This code is in the public domain.-----import qualified Graphics.UI.Gtk as G-import qualified Graphics.Rendering.Cairo as C-import qualified Graphics.Rendering.Cairo.Matrix as M---windowWidth, windowHeight :: Int-windowWidth = 500-windowHeight = 500---- Write image to file-writePng :: IO ()-writePng =- C.withImageSurface C.FormatARGB32 width height $ \ result -> do- C.renderWith result $ example width height- C.surfaceWriteToPNG result "Draw.png"- where width = windowWidth- height = windowHeight---- Display image in window-main = do- G.initGUI- window <- G.windowNew- canvas <- G.drawingAreaNew- -- fix size- -- G.windowSetResizable window False- G.widgetSetSizeRequest window windowWidth windowHeight- -- press any key to quit- G.onKeyPress window $ const (do G.widgetDestroy window; return True)- G.onDestroy window G.mainQuit- G.onExpose canvas $ const (updateCanvas canvas)- G.set window [G.containerChild G.:= canvas]- G.widgetShowAll window- G.mainGUI--updateCanvas :: G.DrawingArea -> IO Bool-updateCanvas canvas = do- win <- G.widgetGetDrawWindow canvas- (width, height) <- G.widgetGetSize canvas- G.renderWithDrawable win $- example width height- return True--------------------------------------------------------------------foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]-foreach = flip mapM--keepState render = do- C.save- render- C.restore--drawCircle x y r = do- C.arc x y r 0 (2 * pi)- fillStroke--drawRectangle x y w h = do- C.rectangle x y w h- fillStroke--stroke =- keepState $ do- C.setSourceRGBA 0 0 0 0.7- C.stroke--fillStroke = do- C.fillPreserve- stroke---------------------------------------------------------------------- Example--example width height = do- prologue width height- example1---- Set up stuff-prologue wWidth wHeight = do- let width = 10- height = 10- xmax = width / 2- xmin = - xmax- ymax = height / 2- ymin = - ymax- scaleX = realToFrac wWidth / width- scaleY = realToFrac wHeight / height-- -- style and color- C.setLineCap C.LineCapRound- C.setLineJoin C.LineJoinRound- C.setLineWidth $ 1 / max scaleX scaleY- C.setSourceRGBA 0.5 0.7 0.5 0.5-- -- Set up user coordinates- C.scale scaleX scaleY- -- center origin- C.translate (width / 2) (height / 2)- -- positive y-axis upwards- let flipY = M.Matrix 1 0 0 (-1) 0 0- C.transform flipY-- grid xmin xmax ymin ymax----- Grid and axes-grid xmin xmax ymin ymax =- keepState $ do- C.setSourceRGBA 0 0 0 0.7- -- axes- C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke- C.moveTo xmin 0; C.lineTo xmax 0; C.stroke- -- grid- C.setDash [0.01, 0.99] 0- foreach [xmin .. xmax] $ \ x ->- do C.moveTo x ymin- C.lineTo x ymax- C.stroke--example1 = do- -- circles- drawCircle 0 0 1- drawCircle 2 2 3- -- a bunch of rectangles- keepState $- foreach [1 .. 5] $ \ _ ->- do drawRectangle 0 1 2 3- C.rotate (pi/8)- -- some cute stuff- thought- apple- snake--thought =- keepState $ do- C.scale 0.04 0.04- C.translate (200) (380)- C.rotate pi- C.setSourceRGBA 0.5 0.5 1 0.7- C.setLineWidth 1- image- fillStroke- where- m = C.moveTo- c = C.curveTo- z = C.closePath- image = do- m 184 327- c 176 327 170 332 168 339- c 166 333 160 329 153 329- c 147 329 141 333 138 339- c 137 339 136 338 134 338- c 125 338 118 345 118 354- c 118 363 125 371 134 371- c 137 371 140 370 142 368- c 142 368 142 368 142 369- c 142 377 149 385 158 385- c 162 385 166 383 168 381- c 171 386 176 390 183 390- c 188 390 193 387 196 383- c 198 384 201 385 204 385- c 212 385 220 378 220 369- c 222 371 225 372 228 372- c 237 372 244 364 244 355- c 244 346 237 339 228 339- c 227 339 226 339 225 340- c 223 332 217 327 209 327- c 204 327 199 330 196 333- c 193 330 189 327 184 327- z- m 164 387- c 158 387 153 391 153 397- c 153 402 158 407 164 407- c 170 407 174 402 174 397- c 174 391 170 387 164 387- z- m 152 408- c 149 408 146 411 146 414- c 146 417 149 420 152 420- c 155 420 158 417 158 414- c 158 411 155 408 152 408- z- m 143 422- c 141 422 139 424 139 426- c 139 428 141 429 143 429- c 144 429 146 428 146 426- c 146 424 144 422 143 422- z--apple =- keepState $ do- C.scale 0.05 0.05- C.translate (1110) (220)- C.rotate pi- C.setLineWidth 0.5- C.setSourceRGBA 0 0 0 0.7- image1- fillStroke- C.setSourceRGBA 1 0 0 0.7- image2- fillStroke- where- m = C.moveTo- c = C.curveTo- z = C.closePath- l = C.lineTo- image1 = do- m 1149 245- l 1156 244- l 1155 252- l 1149 245- z- image2 = do- m 1151 249- c 1145 249 1140 254 1140 261- c 1140 268 1145 273 1151 273- c 1152 273 1153 273 1154 272- c 1156 273 1157 273 1158 273- c 1164 273 1169 268 1169 261- c 1169 254 1164 249 1158 249- c 1157 249 1156 249 1154 250- c 1153 249 1152 249 1151 249- z--snake =- keepState $ do- C.scale 0.04 0.04- C.translate (150) (220)- C.rotate pi- C.setLineWidth 0.5- C.setSourceRGBA 0.1 0.1 0 0.7- image- fillStroke- where- m = C.moveTo- c = C.curveTo- z = C.closePath- l = C.lineTo- image = do- m 146 320- c 143 308 130 314 123 319- c 115 324 108 311 100 314- c 93 317 92 319 81 318- c 76 318 60 309 60 320- c 60 328 73 321 82 323- c 94 326 98 317 106 320- c 113 323 120 330 128 323- c 133 318 142 312 146 320- l 146 320- z------------------------------------------------------------------
− demo/Graph.hs
@@ -1,98 +0,0 @@------ Author: Michael Sloan <mgsloan@gmail.com>------ This code is in the public domain.------ Based off Johan Bockgård's Drawing2.hs-----import qualified Graphics.UI.Gtk as G-import qualified Graphics.Rendering.Cairo as C-import qualified Graphics.Rendering.Cairo.Matrix as M--f x = sin (x*5) / (x*5)--main = graph f--graph :: (Double -> Double) -> IO ()-graph f = do- G.initGUI- window <- G.windowNew- canvas <- G.drawingAreaNew- G.windowSetResizable window False- G.widgetSetSizeRequest window 600 600- -- press any key to quit- G.onKeyPress window $ const (do G.widgetDestroy window; return True)- G.onDestroy window G.mainQuit- G.onExpose canvas $ const $ render f canvas- G.set window [G.containerChild G.:= canvas]- G.widgetShowAll window- G.mainGUI--render :: (Double -> Double) -> G.DrawingArea -> IO Bool-render f canvas = do- win <- G.widgetGetDrawWindow canvas- (width, height) <- G.widgetGetSize canvas- G.renderWithDrawable win $ (prologue width height >> renderG f)- return True--foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]-foreach = flip mapM--deriv :: (Double -> Double) -> Double -> Double-deriv f x = ((f $ x + 0.05) - (f $ x - 0.05)) * 10--gen :: Double -> Double -> (Double -> Double) -> [Double]-gen v t f | v > t = []-gen v t f = v : (gen (f v) t f)--skipBy f = foldr (\x c -> if f x then c else x : c) []--falloff x = 0.25 * (x + 1.5) / ((x+0.5)^5 + 1)--renderG :: (Double -> Double) -> C.Render ()-renderG f = do- C.moveTo (-5) (f (-5))- sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) [-4.9,-4.8..5]- --Adaptive attempt (falloff func is what really needs work)- --sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) $ tail $ gen (-5) 5 (\x -> x + (falloff $ abs $ deriv (deriv f) x))- C.stroke---- Set up stuff-prologue wWidth wHeight = do- let width = 10- height = 10- xmax = width / 2- xmin = - xmax- ymax = height / 2- ymin = - ymax- scaleX = realToFrac wWidth / width- scaleY = realToFrac wHeight / height-- -- style and color- C.setLineCap C.LineCapRound- C.setLineJoin C.LineJoinRound- C.setLineWidth $ 1 / max scaleX scaleY-- -- Set up user coordinates- C.scale scaleX scaleY- -- center origin- C.translate (width / 2) (height / 2)- -- positive y-axis upwards- let flipY = M.Matrix 1 0 0 (-1) 0 0- C.transform flipY- C.setSourceRGBA 0 0 0 1- grid xmin xmax ymin ymax---- Grid and axes-grid xmin xmax ymin ymax = do- -- axes- C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke- C.moveTo xmin 0; C.lineTo xmax 0; C.stroke- -- grid- C.setDash [0.01, 0.99] 0- foreach [xmin .. xmax] $ \ x ->- do C.moveTo x ymin- C.lineTo x ymax- C.stroke- C.setDash [] 0
− demo/Makefile
@@ -1,33 +0,0 @@--PROGS = drawing drawing2 starandring text clock graph sdldrawing-SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs CairoSDL.hs--all : $(PROGS)--drawing : Drawing.hs- $(HC_RULE)--drawing2 : Drawing2.hs- $(HC_RULE)--starandring : StarAndRing.hs- $(HC_RULE)--text : Text.hs- $(HC_RULE)--clock : Clock.hs- $(HC_RULE)--graph : Graph.hs- $(HC_RULE)--sdldrawing : CairoSDL.hs- $(HC_RULE)--HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)--clean:- rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)--HC=ghc
− demo/StarAndRing.hs
@@ -1,111 +0,0 @@-import Graphics.Rendering.Cairo-import qualified Graphics.Rendering.Cairo.Matrix as M--ringPath :: Render ()-ringPath = do- moveTo 200.86568 667.80795- curveTo 110.32266 562.62134 122.22863 403.77940 227.41524 313.23637- curveTo 332.60185 222.69334 491.42341 234.57563 581.96644 339.76224- curveTo 672.50948 444.94884 660.64756 603.79410 555.46095 694.33712- curveTo 450.27436 784.88016 291.40871 772.99456 200.86568 667.80795- closePath- moveTo 272.14411 365.19927- curveTo 195.64476 431.04875 186.97911 546.57972 252.82859 623.07908- curveTo 318.67807 699.57844 434.23272 708.22370 510.73208 642.37422- curveTo 587.23144 576.52474 595.85301 460.99047 530.00354 384.49112- curveTo 464.15406 307.99176 348.64347 299.34979 272.14411 365.19927- closePath--starPath :: Render ()-starPath = do- transform (M.Matrix 0.647919 (-0.761710) 0.761710 0.647919 (-208.7977) 462.0608)- moveTo 505.80857 746.23606- lineTo 335.06870 555.86488- lineTo 91.840384 635.31360- lineTo 282.21157 464.57374- lineTo 202.76285 221.34542- lineTo 373.50271 411.71660- lineTo 616.73103 332.26788- lineTo 426.35984 503.00775- lineTo 505.80857 746.23606- closePath--fillRing :: Render ()-fillRing = do- save- translate (-90) (-205)- ringPath- setSourceRGBA 1.0 0.0 0.0 0.75- fill- restore--fillStar :: Render ()-fillStar = do- save- translate (-90) (-205)- starPath- setSourceRGBA 0.0 0.0 ((fromIntegral 0xae) / (fromIntegral 0xff)) 0.55135137- fill- restore--clipToTopAndBottom :: Int -> Int -> Render ()-clipToTopAndBottom width height = do- moveTo 0 0- lineTo (fromIntegral width) 0.0- lineTo 0.0 (fromIntegral height)- lineTo (fromIntegral width) (fromIntegral height)- closePath- clip- newPath--clipToLeftAndRight :: Int -> Int -> Render ()-clipToLeftAndRight width height = do- moveTo 0 0- lineTo 0.0 (fromIntegral height)- lineTo (fromIntegral width) 0.0- lineTo (fromIntegral width) (fromIntegral height)- closePath- clip- newPath--starAndRing :: Int -> Int -> Render ()-starAndRing width height = do- setOperator OperatorClear- paint-- setOperator OperatorAdd-- renderWithSimilarSurface ContentColorAlpha width height $ \ringOverStar -> do- renderWith ringOverStar $ do- clipToTopAndBottom width height- fillStar- fillRing- setSourceSurface ringOverStar 0 0- paint-- renderWithSimilarSurface ContentColorAlpha width height $ \starOverRing -> do- renderWith starOverRing $ do- clipToLeftAndRight width height- fillRing- fillStar- setSourceSurface starOverRing 0 0- paint--main :: IO ()-main = do- withImageSurface FormatARGB32 width height $ \result -> do- renderWith result $ starAndRing width height- surfaceWriteToPNG result "StarAndRing.png"- putStrLn "wrote StarAndRing.png"- withPDFSurface "StarAndRing.pdf" (fromIntegral width) (fromIntegral height)- (flip renderWith $ starAndRing width height >> showPage)- putStrLn "wrote StarAndRing.pdf"- withPSSurface "StarAndRing.ps" (fromIntegral width) (fromIntegral height)- (flip renderWith $ starAndRing width height >> showPage)- putStrLn "wrote StarAndRing.ps"- withSVGSurface "StarAndRing.svg" (fromIntegral width) (fromIntegral height)- (flip renderWith $ starAndRing width height)- putStrLn "wrote StarAndRing.svg"-- where width = 600- height = 600
− demo/Text.hs
@@ -1,71 +0,0 @@-import Graphics.Rendering.Cairo-import qualified Graphics.Rendering.Cairo.Matrix as M--boxText :: String -> Double -> Double -> Render ()-boxText text x y = do- save-- lineWidth <- getLineWidth-- (TextExtents xb yb w h _ _) <- textExtents text-- rectangle (x + xb - lineWidth)- (y + yb - lineWidth)- (w + 2 * lineWidth)- (h + 2 * lineWidth)- stroke- moveTo x y- textPath text- fillPreserve- setSourceRGBA 0 0 1 0.5- setLineWidth 3.0- stroke-- restore--transpSurface :: Double -> Double -> Render ()-transpSurface w h = do- save- rectangle 0 0 w h- setSourceRGBA 0 0 0 0- setOperator OperatorSource- fill- restore--width = 400-height = 300--main :: IO ()-main = withImageSurface FormatARGB32 width height $ \surface -> do- renderWith surface $ do- setSourceRGB 0.0 0.0 0.0- setLineWidth 2.0-- transpSurface (fromIntegral width) (fromIntegral height)-- selectFontFace "sans" FontSlantNormal FontWeightNormal- setFontSize 40-- extents <- fontExtents- let fontHeight = fontExtentsHeight extents-- boxText "Howdy, world!" 10 fontHeight-- translate 0 fontHeight-- save- translate 10 fontHeight- rotate (10.0 * pi / 180.0)- boxText "Yay for Haskell!" 0 0- restore-- translate 0 (3 * fontHeight)-- save- setFontMatrix $ M.rotate ((-10.0) * pi / 180.0) $ M.scale 40.0 40.0 M.identity- boxText "...and Cairo!" 10 fontHeight- restore-- surfaceWriteToPNG surface "Text.png"-- return ()
+ demo/gtk2/CairoGhci.hs view
@@ -0,0 +1,76 @@+-- Example of an drawing graphics onto a canvas.+import Graphics.UI.Gtk+import Graphics.Rendering.Cairo+import Control.Monad.Trans ( liftIO )+import Graphics.UI.Gtk.Gdk.EventM++run :: Render () -> IO ()+run act = do+ initGUI+ dia <- dialogNew+ dialogAddButton dia stockClose ResponseClose+ contain <- dialogGetUpper dia+ canvas <- drawingAreaNew+ canvas `onSizeRequest` return (Requisition 250 250)+ canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas act+ boxPackStartDefaults contain canvas+ widgetShow canvas+ dialogRun dia+ widgetDestroy dia+ -- Flush all commands that are waiting to be sent to the graphics server.+ -- This ensures that the window is actually closed before ghci displays the+ -- prompt again.+ flush++ where updateCanvas :: DrawingArea -> Render () -> EventM EExpose ()+ updateCanvas canvas act = liftIO $ do+ win <- widgetGetDrawWindow canvas+ renderWithDrawable win act++setRed :: Render ()+setRed = do+ setSourceRGB 1 0 0++++setFat :: Render ()+setFat = do+ setLineWidth 20+ setLineCap LineCapRound++++drawSquare :: Double -> Double -> Render ()+drawSquare width height = do+ (x,y) <- getCurrentPoint+ lineTo (x+width) y+ lineTo (x+width) (y+height)+ lineTo x (y+height)+ closePath+ stroke++++drawHCirc :: Double -> Double -> Double -> Render ()+drawHCirc x y radius = do+ arc x y radius 0 pi+ stroke++++drawStr :: String -> Render ()+drawStr txt = do+ lay <- createLayout txt+ showLayout lay++++drawStr_ :: String -> Render ()+drawStr_ txt = do+ lay <- liftIO $ do+ ctxt <- cairoCreateContext Nothing+ descr <- contextGetFontDescription ctxt+ descr `fontDescriptionSetSize` 20+ ctxt `contextSetFontDescription` descr+ layoutText ctxt txt+ showLayout lay
+ demo/gtk2/Clock.hs view
@@ -0,0 +1,407 @@+-- original author:+-- Mirco "MacSlow" Mueller <macslow@bangang.de>+--+-- created:+-- 10.1.2006 (or so)+--+-- http://www.gnu.org/licenses/licenses.html#GPL+--+-- ported to Haskell by:+-- Duncan Coutts <duncan.coutts@worc.ox.ac.uk>+--++import Graphics.Rendering.Cairo+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Gdk.EventM+import System.Time+import Control.Monad (when)+import Data.Maybe (isJust)+import Data.IORef++drawClockBackground :: Bool -> Int -> Int -> Render ()+drawClockBackground quality width height = do+ save+ scale (fromIntegral width) (fromIntegral height)++ save+ setOperator OperatorOver+ when quality drawDropShadow+ drawClockFace quality+ restore++ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound+ drawHourMarks++ restore++drawClockHands :: Bool -> Int -> Int -> Render ()+drawClockHands quality width height = do+ save+ scale (fromIntegral width) (fromIntegral height)++ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ time <- liftIO (getClockTime >>= toCalendarTime)+ let hours = fromIntegral (if ctHour time >= 12+ then ctHour time - 12+ else ctHour time)+ minutes = fromIntegral (ctMin time)+ seconds = fromIntegral (ctSec time)++ drawHourHand quality hours minutes seconds+ drawMinuteHand quality minutes seconds+ drawSecondHand quality seconds++ restore++drawClockForeground :: Bool -> Int -> Int -> Render ()+drawClockForeground quality width height = do+ scale (fromIntegral width) (fromIntegral height)++ save+ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ when quality drawInnerShadow+ when quality drawReflection+ drawFrame quality+ restore++drawDropShadow =+ withRadialPattern 0.55 0.55 0.25 0.5 0.5 0.525 $ \pattern -> do+ patternAddColorStopRGBA pattern 0 0 0 0 0.811+ patternAddColorStopRGBA pattern 0.64 0.345 0.345 0.345 0.317+ patternAddColorStopRGBA pattern 0.84 0.713 0.713 0.713 0.137+ patternAddColorStopRGBA pattern 1 1 1 1 0+ patternSetFilter pattern FilterFast+ setSource pattern+ arc 0.5 0.5 (142/150) 0 (pi*2)+ fill++drawClockFace True =+ withLinearPattern 0.5 0 0.5 1 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.91 0.96 0.93+ patternAddColorStopRGB pattern 1 0.65 0.68 0.68+ patternSetFilter pattern FilterFast+ setSource pattern+ translate 0.5 0.5+ arc 0 0 (60/150) 0 (pi*2)+ fill+drawClockFace False = do+ setSourceRGB 0.78 0.82 0.805+ translate 0.5 0.5+ arc 0 0 (60/150) 0 (pi*2)+ fill++drawHourMarks = do+ save+ forM_ [1..12] $ \_ -> do+ rotate (pi/6)+ moveTo (4.5/6) 0+ lineTo (5.0/6) 0+ stroke+ restore++forM_ = flip mapM_++drawHourHand quality hours minutes seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate ( (pi/6) * hours+ + (pi/360) * minutes+ + (pi/21600) * seconds)++ -- hour hand's shadow+ when quality $ do+ setLineWidth (1.75/60)+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ moveTo (-2/15 + 0.025) 0.025+ lineTo (7/15 + 0.025) 0.025+ stroke++ -- the hand itself+ setLineWidth (1/60)+ setOperator OperatorOver+ setSourceRGB 0.16 0.18 0.19+ moveTo (-2/15) 0+ lineTo (7/15) 0+ stroke+ restore++drawMinuteHand quality minutes seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate ( (pi/30) * minutes+ + (pi/1800) * seconds)++ -- minute hand's shadow+ when quality $ do+ setLineWidth (1.75/60)+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ moveTo (-16/75 - 0.025) (-0.025)+ lineTo (2/3 - 0.025) (-0.025)+ stroke++ -- the minute hand itself+ setLineWidth (1/60)+ setOperator OperatorOver+ setSourceRGB 0.16 0.18 0.19+ moveTo (-16/75) 0+ lineTo (2/3) 0+ stroke+ restore++drawSecondHand quality seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate (seconds * pi/30);++ -- shadow of second hand-part+ when quality $ do+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ setLineWidth (1.3125 / 60)+ moveTo (-1.5/5 + 0.025) 0.025+ lineTo (3/5 + 0.025) 0.025+ stroke++ -- second hand+ setOperator OperatorOver+ setSourceRGB 0.39 0.58 0.77+ setLineWidth (0.75/60)+ moveTo (-1.5/5) 0+ lineTo (3/5) 0+ stroke++ arc 0 0 (1/20) 0 (pi*2)+ fill+ arc (63/100) 0 (1/35) 0 (pi*2)+ stroke+ setLineWidth (1/100)+ moveTo (10/15) 0+ lineTo (12/15) 0+ stroke+ setSourceRGB 0.31 0.31 0.31+ arc 0 0 (1/25) 0 (pi*2)+ fill+ restore++drawInnerShadow = do+ save+ setOperator OperatorOver+ arc 0 0 (142/150) 0 (pi*2)+ clip+ withRadialPattern 0.3 0.3 0.1 0 0 0.95 $ \pattern -> do+ patternAddColorStopRGBA pattern 0 1 1 1 0+ patternAddColorStopRGBA pattern 0.64 0.713 0.713 0.713 0.137+ patternAddColorStopRGBA pattern 0.84 0.345 0.345 0.345 0.317+ patternAddColorStopRGBA pattern 1 0 0 0 0.811+ patternSetFilter pattern FilterFast+ setSource pattern+ arc 0 0 (142/150) 0 (pi*2)+ fill+ restore++drawReflection = do+ save+ arc 0 0 (142/150) 0 (pi*2)+ clip+ rotate (-75 * pi/180)+ setSourceRGBA 0.87 0.9 0.95 0.25+ moveTo (-1) (-1)+ lineTo 1 (-1)+ lineTo 1 1+ curveTo 1 0.15 (-0.15) (-1) (-1) (-1)+ fill+ moveTo (-1) (-1)+ lineTo (-1) 1+ lineTo 1 1+ curveTo (-0.5) 1 (-1) 0.5 (-1) (-1)+ fill+ restore++drawFrame True = do+ save+ withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.4 0.4 0.4+ patternAddColorStopRGB pattern 0.2 0.95 0.95 0.95+ patternSetFilter pattern FilterFast+ setSource pattern+ setLineWidth (10/75)+ arc 0 0 (142/150) 0 (pi*2)+ stroke++ withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.9 0.9 0.9+ patternAddColorStopRGB pattern 0.2 0.35 0.35 0.35+ patternSetFilter pattern FilterFast+ setSource pattern+ setLineWidth (10/75)+ arc 0 0 (150/150) 0 (pi*2)+ stroke+ restore+drawFrame False = do+ save+ setSourceRGB 0 0 0+ setLineWidth (10/75)+ arc 0 0 1 0 (pi*2)+ stroke+ restore++initialSize :: Int+initialSize = 256++main = do+ initGUI++ window <- windowNew+ windowSetDecorated window False+ windowSetResizable window True+ windowSetPosition window WinPosCenterAlways++ widgetSetAppPaintable window True+ windowSetIconFromFile window "../cairo-clock-icon.png"+ windowSetTitle window "Gtk2Hs Cairo Clock"+ windowSetDefaultSize window initialSize initialSize+ windowSetGeometryHints window (Just window)+ (Just (32, 32)) (Just (512, 512))+ Nothing Nothing (Just (1,1))++ let setAlpha widget = do+ screen <- widgetGetScreen widget+ colormap <- screenGetRGBAColormap screen+ maybe (return ()) (widgetSetColormap widget) colormap+ setAlpha window --TODO: also call setAlpha on alpha screen change++ window `on` keyPressEvent $ tryEvent $ do+ "Escape" <- eventKeyName+ liftIO mainQuit++ window `on` buttonPressEvent $ tryEvent $ do+ LeftButton <- eventButton+ time <- eventTime+ (x,y) <- eventRootCoordinates+ liftIO $ windowBeginMoveDrag window LeftButton (round x) (round y) time++ window `on` buttonPressEvent $ tryEvent $ do+ MiddleButton <- eventButton+ time <- eventTime+ (x,y) <- eventRootCoordinates+ liftIO $ windowBeginResizeDrag window WindowEdgeSouthEast MiddleButton+ (round x) (round y) time++ timeoutAdd (widgetQueueDraw window >> return True) 1000++ backgroundRef <- newIORef (Just undefined)+ foregroundRef <- newIORef (Just undefined)++ let redrawStaticLayers = do+ (width, height) <- widgetGetSize window+ drawWin <- widgetGetDrawWindow window+ background <- createImageSurface FormatARGB32 width height+ foreground <- createImageSurface FormatARGB32 width height+ let clear = do+ save+ setOperator OperatorClear+ paint+ restore+ renderWith background $ do+ clear+ drawClockBackground True width height+ renderWith foreground $ do+ clear+ drawClockForeground True width height+ writeIORef backgroundRef (Just background)+ writeIORef foregroundRef (Just foreground)++ onRealize window redrawStaticLayers++ sizeRef <- newIORef (initialSize, initialSize)+ timeoutHandlerRef <- newIORef Nothing+ window `on` configureEvent $ do+ (w,h) <- eventSize+ liftIO $ do+ size <- readIORef sizeRef+ writeIORef sizeRef (w,h)+ when (size /= (w,h)) $ do++ background <- readIORef backgroundRef+ foreground <- readIORef foregroundRef+ maybe (return ()) surfaceFinish background+ maybe (return ()) surfaceFinish foreground++ writeIORef backgroundRef Nothing+ writeIORef foregroundRef Nothing++ timeoutHandler <- readIORef timeoutHandlerRef+ maybe (return ()) timeoutRemove timeoutHandler++ handler <- timeoutAddFull (do+ writeIORef timeoutHandlerRef Nothing+ redrawStaticLayers+ widgetQueueDraw window+ return False+ ) priorityDefaultIdle 300+ writeIORef timeoutHandlerRef (Just handler)++ return False++ window `on` exposeEvent $ do+ drawWin <- eventWindow+ exposeRegion <- eventRegion+ liftIO $ do+ (width, height) <- drawableGetSize drawWin++ background <- readIORef backgroundRef+ foreground <- readIORef foregroundRef++ renderWithDrawable drawWin $ do+ region exposeRegion+ clip++ save+ setOperator OperatorSource+ setSourceRGBA 0 0 0 0+ paint+ restore++ case background of+ Nothing -> drawClockBackground False width height+ Just background -> do+ setSourceSurface background 0 0+ paint++ drawClockHands (isJust background) width height++ case foreground of+ Nothing -> drawClockForeground False width height+ Just foreground -> do+ setSourceSurface foreground 0 0+ paint++ return True++ widgetShowAll window+ mainGUI
+ demo/gtk2/Drawing.hs view
@@ -0,0 +1,59 @@+-- Example of an drawing graphics onto a canvas.+import Graphics.UI.Gtk+import Graphics.Rendering.Cairo+import Graphics.UI.Gtk.Gdk.EventM++main = do+ initGUI+ dia <- dialogNew+ dialogAddButton dia stockOk ResponseOk+ contain <- dialogGetUpper dia+ canvas <- drawingAreaNew+ canvas `on` sizeRequest $ return (Requisition 40 40)+ ctxt <- cairoCreateContext Nothing+ text <- layoutEmpty ctxt+ text `layoutSetText` "Hello World."+ canvas `on` exposeEvent $ updateCanvas text+ boxPackStartDefaults contain canvas+ widgetShow canvas+ dialogRun dia+ return ()++updateCanvas :: PangoLayout -> EventM EExpose Bool+updateCanvas text = do+ win <- eventWindow+ liftIO $ do+ (width',height') <- drawableGetSize win+ let width = realToFrac width'+ height = realToFrac height'++ -- Draw using the cairo api+ renderWithDrawable win $ do+ setSourceRGB 1 0 0+ setLineWidth 20+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ moveTo 30 30+ lineTo (width-30) (height-30)+ lineTo (width-30) 30+ lineTo 30 (height-30)+ stroke++ setSourceRGB 1 1 0+ setLineWidth 4++ save+ translate (width / 2) (height / 2)+ scale (width / 2) (height / 2)+ arc 0 0 1 (135 * pi/180) (225 * pi/180)+ restore+ stroke++ setSourceRGB 0 0 0+ moveTo 30 (realToFrac height / 4)+ rotate (pi/4)+ showLayout text+++ return True
+ demo/gtk2/Drawing2.hs view
@@ -0,0 +1,258 @@+--+-- Author: Johan Bockgård <bojohan@dd.chalmers.se>+--+-- This code is in the public domain.+--++import qualified Graphics.UI.Gtk as G+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as M+++windowWidth, windowHeight :: Int+windowWidth = 500+windowHeight = 500++-- Write image to file+writePng :: IO ()+writePng =+ C.withImageSurface C.FormatARGB32 width height $ \ result -> do+ C.renderWith result $ example width height+ C.surfaceWriteToPNG result "Draw.png"+ where width = windowWidth+ height = windowHeight++-- Display image in window+main = do+ G.initGUI+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ -- fix size+ -- G.windowSetResizable window False+ G.widgetSetSizeRequest window windowWidth windowHeight+ -- press any key to quit+ G.onKeyPress window $ const (do G.widgetDestroy window; return True)+ G.onDestroy window G.mainQuit+ G.onExpose canvas $ const (updateCanvas canvas)+ G.set window [G.containerChild G.:= canvas]+ G.widgetShowAll window+ G.mainGUI++updateCanvas :: G.DrawingArea -> IO Bool+updateCanvas canvas = do+ win <- G.widgetGetDrawWindow canvas+ (width, height) <- G.widgetGetSize canvas+ G.renderWithDrawable win $+ example width height+ return True++----------------------------------------------------------------++foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]+foreach = flip mapM++keepState render = do+ C.save+ render+ C.restore++drawCircle x y r = do+ C.arc x y r 0 (2 * pi)+ fillStroke++drawRectangle x y w h = do+ C.rectangle x y w h+ fillStroke++stroke =+ keepState $ do+ C.setSourceRGBA 0 0 0 0.7+ C.stroke++fillStroke = do+ C.fillPreserve+ stroke++----------------------------------------------------------------++-- Example++example width height = do+ prologue width height+ example1++-- Set up stuff+prologue wWidth wHeight = do+ let width = 10+ height = 10+ xmax = width / 2+ xmin = - xmax+ ymax = height / 2+ ymin = - ymax+ scaleX = realToFrac wWidth / width+ scaleY = realToFrac wHeight / height++ -- style and color+ C.setLineCap C.LineCapRound+ C.setLineJoin C.LineJoinRound+ C.setLineWidth $ 1 / max scaleX scaleY+ C.setSourceRGBA 0.5 0.7 0.5 0.5++ -- Set up user coordinates+ C.scale scaleX scaleY+ -- center origin+ C.translate (width / 2) (height / 2)+ -- positive y-axis upwards+ let flipY = M.Matrix 1 0 0 (-1) 0 0+ C.transform flipY++ grid xmin xmax ymin ymax+++-- Grid and axes+grid xmin xmax ymin ymax =+ keepState $ do+ C.setSourceRGBA 0 0 0 0.7+ -- axes+ C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke+ C.moveTo xmin 0; C.lineTo xmax 0; C.stroke+ -- grid+ C.setDash [0.01, 0.99] 0+ foreach [xmin .. xmax] $ \ x ->+ do C.moveTo x ymin+ C.lineTo x ymax+ C.stroke++example1 = do+ -- circles+ drawCircle 0 0 1+ drawCircle 2 2 3+ -- a bunch of rectangles+ keepState $+ foreach [1 .. 5] $ \ _ ->+ do drawRectangle 0 1 2 3+ C.rotate (pi/8)+ -- some cute stuff+ thought+ apple+ snake++thought =+ keepState $ do+ C.scale 0.04 0.04+ C.translate (200) (380)+ C.rotate pi+ C.setSourceRGBA 0.5 0.5 1 0.7+ C.setLineWidth 1+ image+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ image = do+ m 184 327+ c 176 327 170 332 168 339+ c 166 333 160 329 153 329+ c 147 329 141 333 138 339+ c 137 339 136 338 134 338+ c 125 338 118 345 118 354+ c 118 363 125 371 134 371+ c 137 371 140 370 142 368+ c 142 368 142 368 142 369+ c 142 377 149 385 158 385+ c 162 385 166 383 168 381+ c 171 386 176 390 183 390+ c 188 390 193 387 196 383+ c 198 384 201 385 204 385+ c 212 385 220 378 220 369+ c 222 371 225 372 228 372+ c 237 372 244 364 244 355+ c 244 346 237 339 228 339+ c 227 339 226 339 225 340+ c 223 332 217 327 209 327+ c 204 327 199 330 196 333+ c 193 330 189 327 184 327+ z+ m 164 387+ c 158 387 153 391 153 397+ c 153 402 158 407 164 407+ c 170 407 174 402 174 397+ c 174 391 170 387 164 387+ z+ m 152 408+ c 149 408 146 411 146 414+ c 146 417 149 420 152 420+ c 155 420 158 417 158 414+ c 158 411 155 408 152 408+ z+ m 143 422+ c 141 422 139 424 139 426+ c 139 428 141 429 143 429+ c 144 429 146 428 146 426+ c 146 424 144 422 143 422+ z++apple =+ keepState $ do+ C.scale 0.05 0.05+ C.translate (1110) (220)+ C.rotate pi+ C.setLineWidth 0.5+ C.setSourceRGBA 0 0 0 0.7+ image1+ fillStroke+ C.setSourceRGBA 1 0 0 0.7+ image2+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ l = C.lineTo+ image1 = do+ m 1149 245+ l 1156 244+ l 1155 252+ l 1149 245+ z+ image2 = do+ m 1151 249+ c 1145 249 1140 254 1140 261+ c 1140 268 1145 273 1151 273+ c 1152 273 1153 273 1154 272+ c 1156 273 1157 273 1158 273+ c 1164 273 1169 268 1169 261+ c 1169 254 1164 249 1158 249+ c 1157 249 1156 249 1154 250+ c 1153 249 1152 249 1151 249+ z++snake =+ keepState $ do+ C.scale 0.04 0.04+ C.translate (150) (220)+ C.rotate pi+ C.setLineWidth 0.5+ C.setSourceRGBA 0.1 0.1 0 0.7+ image+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ l = C.lineTo+ image = do+ m 146 320+ c 143 308 130 314 123 319+ c 115 324 108 311 100 314+ c 93 317 92 319 81 318+ c 76 318 60 309 60 320+ c 60 328 73 321 82 323+ c 94 326 98 317 106 320+ c 113 323 120 330 128 323+ c 133 318 142 312 146 320+ l 146 320+ z++----------------------------------------------------------------
+ demo/gtk2/Graph.hs view
@@ -0,0 +1,98 @@+--+-- Author: Michael Sloan <mgsloan@gmail.com>+--+-- This code is in the public domain.+--+-- Based off Johan Bockgård's Drawing2.hs+--++import qualified Graphics.UI.Gtk as G+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as M++f x = sin (x*5) / (x*5)++main = graph f++graph :: (Double -> Double) -> IO ()+graph f = do+ G.initGUI+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ G.windowSetResizable window False+ G.widgetSetSizeRequest window 600 600+ -- press any key to quit+ G.onKeyPress window $ const (do G.widgetDestroy window; return True)+ G.onDestroy window G.mainQuit+ G.onExpose canvas $ const $ render f canvas+ G.set window [G.containerChild G.:= canvas]+ G.widgetShowAll window+ G.mainGUI++render :: (Double -> Double) -> G.DrawingArea -> IO Bool+render f canvas = do+ win <- G.widgetGetDrawWindow canvas+ (width, height) <- G.widgetGetSize canvas+ G.renderWithDrawable win $ (prologue width height >> renderG f)+ return True++foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]+foreach = flip mapM++deriv :: (Double -> Double) -> Double -> Double+deriv f x = ((f $ x + 0.05) - (f $ x - 0.05)) * 10++gen :: Double -> Double -> (Double -> Double) -> [Double]+gen v t f | v > t = []+gen v t f = v : (gen (f v) t f)++skipBy f = foldr (\x c -> if f x then c else x : c) []++falloff x = 0.25 * (x + 1.5) / ((x+0.5)^5 + 1)++renderG :: (Double -> Double) -> C.Render ()+renderG f = do+ C.moveTo (-5) (f (-5))+ sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) [-4.9,-4.8..5]+ --Adaptive attempt (falloff func is what really needs work)+ --sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) $ tail $ gen (-5) 5 (\x -> x + (falloff $ abs $ deriv (deriv f) x))+ C.stroke++-- Set up stuff+prologue wWidth wHeight = do+ let width = 10+ height = 10+ xmax = width / 2+ xmin = - xmax+ ymax = height / 2+ ymin = - ymax+ scaleX = realToFrac wWidth / width+ scaleY = realToFrac wHeight / height++ -- style and color+ C.setLineCap C.LineCapRound+ C.setLineJoin C.LineJoinRound+ C.setLineWidth $ 1 / max scaleX scaleY++ -- Set up user coordinates+ C.scale scaleX scaleY+ -- center origin+ C.translate (width / 2) (height / 2)+ -- positive y-axis upwards+ let flipY = M.Matrix 1 0 0 (-1) 0 0+ C.transform flipY+ C.setSourceRGBA 0 0 0 1+ grid xmin xmax ymin ymax++-- Grid and axes+grid xmin xmax ymin ymax = do+ -- axes+ C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke+ C.moveTo xmin 0; C.lineTo xmax 0; C.stroke+ -- grid+ C.setDash [0.01, 0.99] 0+ foreach [xmin .. xmax] $ \ x ->+ do C.moveTo x ymin+ C.lineTo x ymax+ C.stroke+ C.setDash [] 0
+ demo/gtk2/Makefile view
@@ -0,0 +1,33 @@++PROGS = drawing drawing2 starandring text clock graph sdldrawing+SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs CairoSDL.hs++all : $(PROGS)++drawing : Drawing.hs+ $(HC_RULE)++drawing2 : Drawing2.hs+ $(HC_RULE)++starandring : StarAndRing.hs+ $(HC_RULE)++text : Text.hs+ $(HC_RULE)++clock : Clock.hs+ $(HC_RULE)++graph : Graph.hs+ $(HC_RULE)++sdldrawing : CairoSDL.hs+ $(HC_RULE)++HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)++clean:+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)++HC=ghc
+ demo/gtk2/StarAndRing.hs view
@@ -0,0 +1,111 @@+import Graphics.Rendering.Cairo+import qualified Graphics.Rendering.Cairo.Matrix as M++ringPath :: Render ()+ringPath = do+ moveTo 200.86568 667.80795+ curveTo 110.32266 562.62134 122.22863 403.77940 227.41524 313.23637+ curveTo 332.60185 222.69334 491.42341 234.57563 581.96644 339.76224+ curveTo 672.50948 444.94884 660.64756 603.79410 555.46095 694.33712+ curveTo 450.27436 784.88016 291.40871 772.99456 200.86568 667.80795+ closePath+ moveTo 272.14411 365.19927+ curveTo 195.64476 431.04875 186.97911 546.57972 252.82859 623.07908+ curveTo 318.67807 699.57844 434.23272 708.22370 510.73208 642.37422+ curveTo 587.23144 576.52474 595.85301 460.99047 530.00354 384.49112+ curveTo 464.15406 307.99176 348.64347 299.34979 272.14411 365.19927+ closePath++starPath :: Render ()+starPath = do+ transform (M.Matrix 0.647919 (-0.761710) 0.761710 0.647919 (-208.7977) 462.0608)+ moveTo 505.80857 746.23606+ lineTo 335.06870 555.86488+ lineTo 91.840384 635.31360+ lineTo 282.21157 464.57374+ lineTo 202.76285 221.34542+ lineTo 373.50271 411.71660+ lineTo 616.73103 332.26788+ lineTo 426.35984 503.00775+ lineTo 505.80857 746.23606+ closePath++fillRing :: Render ()+fillRing = do+ save+ translate (-90) (-205)+ ringPath+ setSourceRGBA 1.0 0.0 0.0 0.75+ fill+ restore++fillStar :: Render ()+fillStar = do+ save+ translate (-90) (-205)+ starPath+ setSourceRGBA 0.0 0.0 ((fromIntegral 0xae) / (fromIntegral 0xff)) 0.55135137+ fill+ restore++clipToTopAndBottom :: Int -> Int -> Render ()+clipToTopAndBottom width height = do+ moveTo 0 0+ lineTo (fromIntegral width) 0.0+ lineTo 0.0 (fromIntegral height)+ lineTo (fromIntegral width) (fromIntegral height)+ closePath+ clip+ newPath++clipToLeftAndRight :: Int -> Int -> Render ()+clipToLeftAndRight width height = do+ moveTo 0 0+ lineTo 0.0 (fromIntegral height)+ lineTo (fromIntegral width) 0.0+ lineTo (fromIntegral width) (fromIntegral height)+ closePath+ clip+ newPath++starAndRing :: Int -> Int -> Render ()+starAndRing width height = do+ setOperator OperatorClear+ paint++ setOperator OperatorAdd++ renderWithSimilarSurface ContentColorAlpha width height $ \ringOverStar -> do+ renderWith ringOverStar $ do+ clipToTopAndBottom width height+ fillStar+ fillRing+ setSourceSurface ringOverStar 0 0+ paint++ renderWithSimilarSurface ContentColorAlpha width height $ \starOverRing -> do+ renderWith starOverRing $ do+ clipToLeftAndRight width height+ fillRing+ fillStar+ setSourceSurface starOverRing 0 0+ paint++main :: IO ()+main = do+ withImageSurface FormatARGB32 width height $ \result -> do+ renderWith result $ starAndRing width height+ surfaceWriteToPNG result "StarAndRing.png"+ putStrLn "wrote StarAndRing.png"+ withPDFSurface "StarAndRing.pdf" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height >> showPage)+ putStrLn "wrote StarAndRing.pdf"+ withPSSurface "StarAndRing.ps" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height >> showPage)+ putStrLn "wrote StarAndRing.ps"+ withSVGSurface "StarAndRing.svg" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height)+ putStrLn "wrote StarAndRing.svg"++ where width = 600+ height = 600
+ demo/gtk2/Text.hs view
@@ -0,0 +1,71 @@+import Graphics.Rendering.Cairo+import qualified Graphics.Rendering.Cairo.Matrix as M++boxText :: String -> Double -> Double -> Render ()+boxText text x y = do+ save++ lineWidth <- getLineWidth++ (TextExtents xb yb w h _ _) <- textExtents text++ rectangle (x + xb - lineWidth)+ (y + yb - lineWidth)+ (w + 2 * lineWidth)+ (h + 2 * lineWidth)+ stroke+ moveTo x y+ textPath text+ fillPreserve+ setSourceRGBA 0 0 1 0.5+ setLineWidth 3.0+ stroke++ restore++transpSurface :: Double -> Double -> Render ()+transpSurface w h = do+ save+ rectangle 0 0 w h+ setSourceRGBA 0 0 0 0+ setOperator OperatorSource+ fill+ restore++width = 400+height = 300++main :: IO ()+main = withImageSurface FormatARGB32 width height $ \surface -> do+ renderWith surface $ do+ setSourceRGB 0.0 0.0 0.0+ setLineWidth 2.0++ transpSurface (fromIntegral width) (fromIntegral height)++ selectFontFace "sans" FontSlantNormal FontWeightNormal+ setFontSize 40++ extents <- fontExtents+ let fontHeight = fontExtentsHeight extents++ boxText "Howdy, world!" 10 fontHeight++ translate 0 fontHeight++ save+ translate 10 fontHeight+ rotate (10.0 * pi / 180.0)+ boxText "Yay for Haskell!" 0 0+ restore++ translate 0 (3 * fontHeight)++ save+ setFontMatrix $ M.rotate ((-10.0) * pi / 180.0) $ M.scale 40.0 40.0 M.identity+ boxText "...and Cairo!" 10 fontHeight+ restore++ surfaceWriteToPNG surface "Text.png"++ return ()
+ demo/gtk3/CairoGhci.hs view
@@ -0,0 +1,76 @@+-- Example of an drawing graphics onto a canvas.+import Graphics.UI.Gtk+import Graphics.Rendering.Cairo+import Control.Monad.Trans ( liftIO )+import Graphics.UI.Gtk.Gdk.EventM++run :: Render () -> IO ()+run act = do+ initGUI+ dia <- dialogNew+ dialogAddButton dia stockClose ResponseClose+ contain <- dialogGetUpper dia+ canvas <- drawingAreaNew+ canvas `onSizeRequest` return (Requisition 250 250)+ canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas act+ boxPackStartDefaults contain canvas+ widgetShow canvas+ dialogRun dia+ widgetDestroy dia+ -- Flush all commands that are waiting to be sent to the graphics server.+ -- This ensures that the window is actually closed before ghci displays the+ -- prompt again.+ flush++ where updateCanvas :: DrawingArea -> Render () -> EventM EExpose ()+ updateCanvas canvas act = liftIO $ do+ win <- widgetGetDrawWindow canvas+ renderWithDrawable win act++setRed :: Render ()+setRed = do+ setSourceRGB 1 0 0++++setFat :: Render ()+setFat = do+ setLineWidth 20+ setLineCap LineCapRound++++drawSquare :: Double -> Double -> Render ()+drawSquare width height = do+ (x,y) <- getCurrentPoint+ lineTo (x+width) y+ lineTo (x+width) (y+height)+ lineTo x (y+height)+ closePath+ stroke++++drawHCirc :: Double -> Double -> Double -> Render ()+drawHCirc x y radius = do+ arc x y radius 0 pi+ stroke++++drawStr :: String -> Render ()+drawStr txt = do+ lay <- createLayout txt+ showLayout lay++++drawStr_ :: String -> Render ()+drawStr_ txt = do+ lay <- liftIO $ do+ ctxt <- cairoCreateContext Nothing+ descr <- contextGetFontDescription ctxt+ descr `fontDescriptionSetSize` 20+ ctxt `contextSetFontDescription` descr+ layoutText ctxt txt+ showLayout lay
+ demo/gtk3/Clock.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE OverloadedStrings #-}++-- original author:+-- Mirco "MacSlow" Mueller <macslow@bangang.de>+--+-- created:+-- 10.1.2006 (or so)+--+-- http://www.gnu.org/licenses/licenses.html#GPL+--+-- ported to Haskell by:+-- Duncan Coutts <duncan.coutts@worc.ox.ac.uk>+--+-- updated to GTK 3 by Catherine Holloway+--++import Graphics.Rendering.Cairo+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Gdk.EventM+import System.Time+import Control.Monad (when)+import Data.Maybe (isJust)+import Data.IORef+import Data.Text++drawClockBackground :: WidgetClass widget => widget -> Bool -> Render ()+drawClockBackground canvas quality = do++ width <- liftIO $ widgetGetAllocatedWidth canvas+ height <- liftIO $ widgetGetAllocatedHeight canvas+ save+ scale (fromIntegral width) (fromIntegral height)++ save+ setOperator OperatorOver+ when quality drawDropShadow+ drawClockFace quality+ restore++ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound+ drawHourMarks++ restore++drawClockHands :: WidgetClass widget => widget -> Bool -> Render ()+drawClockHands canvas quality = do++ width <- liftIO $ widgetGetAllocatedWidth canvas+ height <- liftIO $ widgetGetAllocatedHeight canvas+ save+ scale (fromIntegral width) (fromIntegral height)++ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ time <- liftIO (getClockTime >>= toCalendarTime)+ let hours = fromIntegral (if ctHour time >= 12+ then ctHour time - 12+ else ctHour time)+ minutes = fromIntegral (ctMin time)+ seconds = fromIntegral (ctSec time)++ drawHourHand quality hours minutes seconds+ drawMinuteHand quality minutes seconds+ drawSecondHand quality seconds++ restore++drawClockForeground :: Bool -> Int -> Int -> Render ()+drawClockForeground quality width height = do+ scale (fromIntegral width) (fromIntegral height)++ save+ translate 0.5 0.5+ scale 0.4 0.4+ setSourceRGB 0.16 0.18 0.19+ setLineWidth (1.5/60)+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ when quality drawInnerShadow+ when quality drawReflection+ drawFrame quality+ restore++drawDropShadow =+ withRadialPattern 0.55 0.55 0.25 0.5 0.5 0.525 $ \pattern -> do+ patternAddColorStopRGBA pattern 0 0 0 0 0.811+ patternAddColorStopRGBA pattern 0.64 0.345 0.345 0.345 0.317+ patternAddColorStopRGBA pattern 0.84 0.713 0.713 0.713 0.137+ patternAddColorStopRGBA pattern 1 1 1 1 0+ patternSetFilter pattern FilterFast+ setSource pattern+ arc 0.5 0.5 (142/150) 0 (pi*2)+ fill++drawClockFace True =+ withLinearPattern 0.5 0 0.5 1 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.91 0.96 0.93+ patternAddColorStopRGB pattern 1 0.65 0.68 0.68+ patternSetFilter pattern FilterFast+ setSource pattern+ translate 0.5 0.5+ arc 0 0 (60/150) 0 (pi*2)+ fill+drawClockFace False = do+ setSourceRGB 0.78 0.82 0.805+ translate 0.5 0.5+ arc 0 0 (60/150) 0 (pi*2)+ fill++drawHourMarks = do+ save+ forM_ [1..12] $ \_ -> do+ rotate (pi/6)+ moveTo (4.5/6) 0+ lineTo (5.0/6) 0+ stroke+ restore++forM_ = flip mapM_++drawHourHand quality hours minutes seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate ( (pi/6) * hours+ + (pi/360) * minutes+ + (pi/21600) * seconds)++ -- hour hand's shadow+ when quality $ do+ setLineWidth (1.75/60)+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ moveTo (-2/15 + 0.025) 0.025+ lineTo (7/15 + 0.025) 0.025+ stroke++ -- the hand itself+ setLineWidth (1/60)+ setOperator OperatorOver+ setSourceRGB 0.16 0.18 0.19+ moveTo (-2/15) 0+ lineTo (7/15) 0+ stroke+ restore++drawMinuteHand quality minutes seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate ( (pi/30) * minutes+ + (pi/1800) * seconds)++ -- minute hand's shadow+ when quality $ do+ setLineWidth (1.75/60)+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ moveTo (-16/75 - 0.025) (-0.025)+ lineTo (2/3 - 0.025) (-0.025)+ stroke++ -- the minute hand itself+ setLineWidth (1/60)+ setOperator OperatorOver+ setSourceRGB 0.16 0.18 0.19+ moveTo (-16/75) 0+ lineTo (2/3) 0+ stroke+ restore++drawSecondHand quality seconds = do+ save+ rotate (-pi/2)+ setLineCap LineCapSquare+ setLineJoin LineJoinMiter+ rotate (seconds * pi/30);++ -- shadow of second hand-part+ when quality $ do+ setOperator OperatorAtop+ setSourceRGBA 0.16 0.18 0.19 0.125+ setLineWidth (1.3125 / 60)+ moveTo (-1.5/5 + 0.025) 0.025+ lineTo (3/5 + 0.025) 0.025+ stroke++ -- second hand+ setOperator OperatorOver+ setSourceRGB 0.39 0.58 0.77+ setLineWidth (0.75/60)+ moveTo (-1.5/5) 0+ lineTo (3/5) 0+ stroke++ arc 0 0 (1/20) 0 (pi*2)+ fill+ arc (63/100) 0 (1/35) 0 (pi*2)+ stroke+ setLineWidth (1/100)+ moveTo (10/15) 0+ lineTo (12/15) 0+ stroke+ setSourceRGB 0.31 0.31 0.31+ arc 0 0 (1/25) 0 (pi*2)+ fill+ restore++drawInnerShadow = do+ save+ setOperator OperatorOver+ arc 0 0 (142/150) 0 (pi*2)+ clip+ withRadialPattern 0.3 0.3 0.1 0 0 0.95 $ \pattern -> do+ patternAddColorStopRGBA pattern 0 1 1 1 0+ patternAddColorStopRGBA pattern 0.64 0.713 0.713 0.713 0.137+ patternAddColorStopRGBA pattern 0.84 0.345 0.345 0.345 0.317+ patternAddColorStopRGBA pattern 1 0 0 0 0.811+ patternSetFilter pattern FilterFast+ setSource pattern+ arc 0 0 (142/150) 0 (pi*2)+ fill+ restore++drawReflection = do+ save+ arc 0 0 (142/150) 0 (pi*2)+ clip+ rotate (-75 * pi/180)+ setSourceRGBA 0.87 0.9 0.95 0.25+ moveTo (-1) (-1)+ lineTo 1 (-1)+ lineTo 1 1+ curveTo 1 0.15 (-0.15) (-1) (-1) (-1)+ fill+ moveTo (-1) (-1)+ lineTo (-1) 1+ lineTo 1 1+ curveTo (-0.5) 1 (-1) 0.5 (-1) (-1)+ fill+ restore++drawFrame True = do+ save+ withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.4 0.4 0.4+ patternAddColorStopRGB pattern 0.2 0.95 0.95 0.95+ patternSetFilter pattern FilterFast+ setSource pattern+ setLineWidth (10/75)+ arc 0 0 (142/150) 0 (pi*2)+ stroke++ withRadialPattern (-0.1) (-0.1) 0.8 0 0 1.5 $ \pattern -> do+ patternAddColorStopRGB pattern 0 0.9 0.9 0.9+ patternAddColorStopRGB pattern 0.2 0.35 0.35 0.35+ patternSetFilter pattern FilterFast+ setSource pattern+ setLineWidth (10/75)+ arc 0 0 (150/150) 0 (pi*2)+ stroke+ restore+drawFrame False = do+ save+ setSourceRGB 0 0 0+ setLineWidth (10/75)+ arc 0 0 1 0 (pi*2)+ stroke+ restore++initialSize :: Int+initialSize = 256++main = do+ initGUI+ window <- windowNew+ windowSetPosition window WinPosCenterAlways++ widgetSetAppPaintable window True+ windowSetIconFromFile window "../cairo-clock-icon.png"++ windowSetDefaultSize window initialSize initialSize+ windowSetGeometryHints window (Just window)+ (Just (32, 32)) (Just (512, 512))+ Nothing Nothing (Just (1,1))+++ window `on` keyPressEvent $ tryEvent $ do+ "Escape" <- eventKeyName+ liftIO mainQuit++ window `on` buttonPressEvent $ tryEvent $ do+ LeftButton <- eventButton+ time <- eventTime+ (x,y) <- eventRootCoordinates+ liftIO $ windowBeginMoveDrag window LeftButton (round x) (round y) time++ window `on` buttonPressEvent $ tryEvent $ do+ MiddleButton <- eventButton+ time <- eventTime+ (x,y) <- eventRootCoordinates+ liftIO $ windowBeginResizeDrag window WindowEdgeSouthEast MiddleButton+ (round x) (round y) time++ canvas <- drawingAreaNew+ ctxt <- cairoCreateContext Nothing+ text <- layoutEmpty ctxt+ text `layoutSetText` (pack "Hello World.")++ canvas `on` draw $ drawClockBackground canvas True+ canvas `on` draw $ drawClockHands canvas True+ set window [ containerChild := canvas, windowDecorated := False,+ windowResizable := True, windowTitle := (pack "Gtk2Hs Cairo Clock") ]+ widgetShowAll window+ timeoutAdd (widgetQueueDraw window >> return True) 1000+ mainGUI
+ demo/gtk3/Drawing.hs view
@@ -0,0 +1,58 @@+-- Example of an drawing graphics onto a canvas.+import Graphics.UI.Gtk+import qualified Graphics.UI.Gtk as Gtk+import Graphics.Rendering.Cairo+import Graphics.UI.Gtk.Gdk.EventM++main = do+ initGUI+ dia <- dialogNew+ -- in newer versions of GTK, 'size-request' is an invalid signal for Drawing areas,+ -- so the default size of the window will be changed instead.+ windowSetDefaultSize dia 400 400+ dialogAddButton dia stockOk ResponseOk+ contain <- dialogGetContentArea dia+ canvas <- drawingAreaNew+ ctxt <- cairoCreateContext Nothing+ text <- layoutEmpty ctxt+ text `layoutSetText` "Hello World."+ canvas `on` draw $ updateCanvas canvas text+ boxPackStart (castToBox contain) canvas PackGrow 0+ widgetShow canvas+ dialogRun dia+ return ()++updateCanvas :: WidgetClass widget => widget -> PangoLayout -> Render ()+updateCanvas canvas text = do+ width' <- liftIO $ widgetGetAllocatedWidth canvas+ height' <- liftIO $ widgetGetAllocatedHeight canvas+ let width = realToFrac width'+ height = realToFrac height'++ setSourceRGB 1 0 0+ setLineWidth 20+ setLineCap LineCapRound+ setLineJoin LineJoinRound++ moveTo 30 30+ lineTo (width-30) (height-30)+ lineTo (width-30) 30+ lineTo 30 (height-30)+ stroke++ setSourceRGB 1 1 0+ setLineWidth 4++ save+ translate (width / 2) (height / 2)+ scale (width / 2) (height / 2)+ arc 0 0 1 (135 * pi/180) (225 * pi/180)+ restore+ stroke++ setSourceRGB 0 0 0+ moveTo 30 (realToFrac height / 4)+ rotate (pi/4)+ showLayout text++
+ demo/gtk3/Drawing2.hs view
@@ -0,0 +1,261 @@+--+-- Author: Johan Bockgård <bojohan@dd.chalmers.se>+--+-- This code is in the public domain.+--++import qualified Graphics.UI.Gtk as G+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as M+++windowWidth, windowHeight :: Int+windowWidth = 500+windowHeight = 500++-- Write image to file+writePng :: IO ()+writePng =+ C.withImageSurface C.FormatARGB32 width height $ \ result -> do+ C.renderWith result $ example width height+ C.surfaceWriteToPNG result "Draw.png"+ where width = windowWidth+ height = windowHeight++-- Display image in window+main = do+ G.initGUI+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ G.windowSetDefaultSize window windowWidth windowWidth+ G.windowSetGeometryHints window (Just window)+ (Just (1, 1)) (Just (windowWidth, windowWidth))+ Nothing Nothing (Just (1,1))++ -- press any key to quit+ window `G.on` G.keyPressEvent $ G.tryEvent $ do C.liftIO G.mainQuit++ canvas `G.on` G.draw $ updateCanvas canvas++ G.set window [G.containerChild G.:= canvas]+ G.widgetShowAll window+ G.mainGUI++updateCanvas :: G.WidgetClass widget => widget -> C.Render ()+updateCanvas canvas = do+ width' <- C.liftIO $ G.widgetGetAllocatedWidth canvas+ height' <- C.liftIO $ G.widgetGetAllocatedHeight canvas+ let width = realToFrac width'+ height = realToFrac height'+ example width height++----------------------------------------------------------------++foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]+foreach = flip mapM++keepState render = do+ C.save+ render+ C.restore++drawCircle x y r = do+ C.arc x y r 0 (2 * pi)+ fillStroke++drawRectangle x y w h = do+ C.rectangle x y w h+ fillStroke++stroke =+ keepState $ do+ C.setSourceRGBA 0 0 0 0.7+ C.stroke++fillStroke = do+ C.fillPreserve+ stroke++----------------------------------------------------------------++-- Example++example width height = do+ prologue width height+ example1++-- Set up stuff+prologue wWidth wHeight = do+ let width = 10+ height = 10+ xmax = width / 2+ xmin = - xmax+ ymax = height / 2+ ymin = - ymax+ scaleX = realToFrac wWidth / width+ scaleY = realToFrac wHeight / height++ -- style and color+ C.setLineCap C.LineCapRound+ C.setLineJoin C.LineJoinRound+ C.setLineWidth $ 1 / max scaleX scaleY+ C.setSourceRGBA 0.5 0.7 0.5 0.5++ -- Set up user coordinates+ C.scale scaleX scaleY+ -- center origin+ C.translate (width / 2) (height / 2)+ -- positive y-axis upwards+ let flipY = M.Matrix 1 0 0 (-1) 0 0+ C.transform flipY++ grid xmin xmax ymin ymax+++-- Grid and axes+grid xmin xmax ymin ymax =+ keepState $ do+ C.setSourceRGBA 0 0 0 0.7+ -- axes+ C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke+ C.moveTo xmin 0; C.lineTo xmax 0; C.stroke+ -- grid+ C.setDash [0.01, 0.99] 0+ foreach [xmin .. xmax] $ \ x ->+ do C.moveTo x ymin+ C.lineTo x ymax+ C.stroke++example1 = do+ -- circles+ drawCircle 0 0 1+ drawCircle 2 2 3+ -- a bunch of rectangles+ keepState $+ foreach [1 .. 5] $ \ _ ->+ do drawRectangle 0 1 2 3+ C.rotate (pi/8)+ -- some cute stuff+ thought+ apple+ snake++thought =+ keepState $ do+ C.scale 0.04 0.04+ C.translate (200) (380)+ C.rotate pi+ C.setSourceRGBA 0.5 0.5 1 0.7+ C.setLineWidth 1+ image+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ image = do+ m 184 327+ c 176 327 170 332 168 339+ c 166 333 160 329 153 329+ c 147 329 141 333 138 339+ c 137 339 136 338 134 338+ c 125 338 118 345 118 354+ c 118 363 125 371 134 371+ c 137 371 140 370 142 368+ c 142 368 142 368 142 369+ c 142 377 149 385 158 385+ c 162 385 166 383 168 381+ c 171 386 176 390 183 390+ c 188 390 193 387 196 383+ c 198 384 201 385 204 385+ c 212 385 220 378 220 369+ c 222 371 225 372 228 372+ c 237 372 244 364 244 355+ c 244 346 237 339 228 339+ c 227 339 226 339 225 340+ c 223 332 217 327 209 327+ c 204 327 199 330 196 333+ c 193 330 189 327 184 327+ z+ m 164 387+ c 158 387 153 391 153 397+ c 153 402 158 407 164 407+ c 170 407 174 402 174 397+ c 174 391 170 387 164 387+ z+ m 152 408+ c 149 408 146 411 146 414+ c 146 417 149 420 152 420+ c 155 420 158 417 158 414+ c 158 411 155 408 152 408+ z+ m 143 422+ c 141 422 139 424 139 426+ c 139 428 141 429 143 429+ c 144 429 146 428 146 426+ c 146 424 144 422 143 422+ z++apple =+ keepState $ do+ C.scale 0.05 0.05+ C.translate (1110) (220)+ C.rotate pi+ C.setLineWidth 0.5+ C.setSourceRGBA 0 0 0 0.7+ image1+ fillStroke+ C.setSourceRGBA 1 0 0 0.7+ image2+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ l = C.lineTo+ image1 = do+ m 1149 245+ l 1156 244+ l 1155 252+ l 1149 245+ z+ image2 = do+ m 1151 249+ c 1145 249 1140 254 1140 261+ c 1140 268 1145 273 1151 273+ c 1152 273 1153 273 1154 272+ c 1156 273 1157 273 1158 273+ c 1164 273 1169 268 1169 261+ c 1169 254 1164 249 1158 249+ c 1157 249 1156 249 1154 250+ c 1153 249 1152 249 1151 249+ z++snake =+ keepState $ do+ C.scale 0.04 0.04+ C.translate (150) (220)+ C.rotate pi+ C.setLineWidth 0.5+ C.setSourceRGBA 0.1 0.1 0 0.7+ image+ fillStroke+ where+ m = C.moveTo+ c = C.curveTo+ z = C.closePath+ l = C.lineTo+ image = do+ m 146 320+ c 143 308 130 314 123 319+ c 115 324 108 311 100 314+ c 93 317 92 319 81 318+ c 76 318 60 309 60 320+ c 60 328 73 321 82 323+ c 94 326 98 317 106 320+ c 113 323 120 330 128 323+ c 133 318 142 312 146 320+ l 146 320+ z++----------------------------------------------------------------
+ demo/gtk3/Graph.hs view
@@ -0,0 +1,102 @@+--+-- Author: Michael Sloan <mgsloan@gmail.com>+--+-- This code is in the public domain.+--+-- Based off Johan Bockgård's Drawing2.hs+--+-- updated to GTK 3 by Catherine Holloway+--+import qualified Graphics.UI.Gtk as G+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as M++f x = sin (x*5) / (x*5)++main = graph f++windowSize :: Int+windowSize = 400++graph :: (Double -> Double) -> IO ()+graph f = do+ G.initGUI+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ -- Gtk3 no longer has size requests, and window does not have a drawable+ -- area to fill, thus we must explicitly tell it how to draw the window size.+ G.windowSetDefaultSize window windowSize windowSize+ G.windowSetGeometryHints window (Just window)+ (Just (0, 0)) (Just (windowSize, windowSize))+ Nothing Nothing (Just (1,1))+ -- press any key to quit+ window `G.on` G.keyPressEvent $ G.tryEvent $ do C.liftIO G.mainQuit+ canvas `G.on` G.draw $ (prologue canvas >> renderG f)+ G.set window [G.containerChild G.:= canvas, G.windowResizable G.:= False]+ G.widgetShowAll window+ G.mainGUI++foreach :: (Monad m) => [a] -> (a -> m b) -> m [b]+foreach = flip mapM++deriv :: (Double -> Double) -> Double -> Double+deriv f x = ((f $ x + 0.05) - (f $ x - 0.05)) * 10++gen :: Double -> Double -> (Double -> Double) -> [Double]+gen v t f | v > t = []+gen v t f = v : (gen (f v) t f)++skipBy f = foldr (\x c -> if f x then c else x : c) []++falloff x = 0.25 * (x + 1.5) / ((x+0.5)^5 + 1)++renderG :: (Double -> Double) -> C.Render ()+renderG f = do+ C.moveTo (-5) (f (-5))+ sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) [-4.9,-4.8..5]+ --Adaptive attempt (falloff func is what really needs work)+ --sequence_ $ map (\d -> C.lineTo d $ f d) $ skipBy (isInfinite . f) $ tail $ gen (-5) 5 (\x -> x + (falloff $ abs $ deriv (deriv f) x))+ C.stroke++-- Set up stuff+prologue canvas = do+ wWidth' <- C.liftIO $ G.widgetGetAllocatedWidth canvas+ wHeight' <- C.liftIO $ G.widgetGetAllocatedHeight canvas+ let wWidth = realToFrac wWidth'+ wHeight = realToFrac wHeight'+ width = 10+ height = 10+ xmax = width / 2+ xmin = - xmax+ ymax = height / 2+ ymin = - ymax+ scaleX = realToFrac wWidth / width+ scaleY = realToFrac wHeight / height++ -- style and color+ C.setLineCap C.LineCapRound+ C.setLineJoin C.LineJoinRound+ C.setLineWidth $ 1 / max scaleX scaleY++ -- Set up user coordinates+ C.scale scaleX scaleY+ -- center origin+ C.translate (width / 2) (height / 2)+ -- positive y-axis upwards+ let flipY = M.Matrix 1 0 0 (-1) 0 0+ C.transform flipY+ C.setSourceRGBA 0 0 0 1+ grid xmin xmax ymin ymax++-- Grid and axes+grid xmin xmax ymin ymax = do+ -- axes+ C.moveTo 0 ymin; C.lineTo 0 ymax; C.stroke+ C.moveTo xmin 0; C.lineTo xmax 0; C.stroke+ -- grid+ C.setDash [0.01, 0.99] 0+ foreach [xmin .. xmax] $ \ x ->+ do C.moveTo x ymin+ C.lineTo x ymax+ C.stroke+ C.setDash [] 0
+ demo/gtk3/Makefile view
@@ -0,0 +1,33 @@++PROGS = drawing drawing2 starandring text clock graph sdldrawing+SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs CairoSDL.hs++all : $(PROGS)++drawing : Drawing.hs+ $(HC_RULE)++drawing2 : Drawing2.hs+ $(HC_RULE)++starandring : StarAndRing.hs+ $(HC_RULE)++text : Text.hs+ $(HC_RULE)++clock : Clock.hs+ $(HC_RULE)++graph : Graph.hs+ $(HC_RULE)++sdldrawing : CairoSDL.hs+ $(HC_RULE)++HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)++clean:+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)++HC=ghc
+ demo/gtk3/StarAndRing.hs view
@@ -0,0 +1,111 @@+import Graphics.Rendering.Cairo+import qualified Graphics.Rendering.Cairo.Matrix as M++ringPath :: Render ()+ringPath = do+ moveTo 200.86568 667.80795+ curveTo 110.32266 562.62134 122.22863 403.77940 227.41524 313.23637+ curveTo 332.60185 222.69334 491.42341 234.57563 581.96644 339.76224+ curveTo 672.50948 444.94884 660.64756 603.79410 555.46095 694.33712+ curveTo 450.27436 784.88016 291.40871 772.99456 200.86568 667.80795+ closePath+ moveTo 272.14411 365.19927+ curveTo 195.64476 431.04875 186.97911 546.57972 252.82859 623.07908+ curveTo 318.67807 699.57844 434.23272 708.22370 510.73208 642.37422+ curveTo 587.23144 576.52474 595.85301 460.99047 530.00354 384.49112+ curveTo 464.15406 307.99176 348.64347 299.34979 272.14411 365.19927+ closePath++starPath :: Render ()+starPath = do+ transform (M.Matrix 0.647919 (-0.761710) 0.761710 0.647919 (-208.7977) 462.0608)+ moveTo 505.80857 746.23606+ lineTo 335.06870 555.86488+ lineTo 91.840384 635.31360+ lineTo 282.21157 464.57374+ lineTo 202.76285 221.34542+ lineTo 373.50271 411.71660+ lineTo 616.73103 332.26788+ lineTo 426.35984 503.00775+ lineTo 505.80857 746.23606+ closePath++fillRing :: Render ()+fillRing = do+ save+ translate (-90) (-205)+ ringPath+ setSourceRGBA 1.0 0.0 0.0 0.75+ fill+ restore++fillStar :: Render ()+fillStar = do+ save+ translate (-90) (-205)+ starPath+ setSourceRGBA 0.0 0.0 ((fromIntegral 0xae) / (fromIntegral 0xff)) 0.55135137+ fill+ restore++clipToTopAndBottom :: Int -> Int -> Render ()+clipToTopAndBottom width height = do+ moveTo 0 0+ lineTo (fromIntegral width) 0.0+ lineTo 0.0 (fromIntegral height)+ lineTo (fromIntegral width) (fromIntegral height)+ closePath+ clip+ newPath++clipToLeftAndRight :: Int -> Int -> Render ()+clipToLeftAndRight width height = do+ moveTo 0 0+ lineTo 0.0 (fromIntegral height)+ lineTo (fromIntegral width) 0.0+ lineTo (fromIntegral width) (fromIntegral height)+ closePath+ clip+ newPath++starAndRing :: Int -> Int -> Render ()+starAndRing width height = do+ setOperator OperatorClear+ paint++ setOperator OperatorAdd++ renderWithSimilarSurface ContentColorAlpha width height $ \ringOverStar -> do+ renderWith ringOverStar $ do+ clipToTopAndBottom width height+ fillStar+ fillRing+ setSourceSurface ringOverStar 0 0+ paint++ renderWithSimilarSurface ContentColorAlpha width height $ \starOverRing -> do+ renderWith starOverRing $ do+ clipToLeftAndRight width height+ fillRing+ fillStar+ setSourceSurface starOverRing 0 0+ paint++main :: IO ()+main = do+ withImageSurface FormatARGB32 width height $ \result -> do+ renderWith result $ starAndRing width height+ surfaceWriteToPNG result "StarAndRing.png"+ putStrLn "wrote StarAndRing.png"+ withPDFSurface "StarAndRing.pdf" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height >> showPage)+ putStrLn "wrote StarAndRing.pdf"+ withPSSurface "StarAndRing.ps" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height >> showPage)+ putStrLn "wrote StarAndRing.ps"+ withSVGSurface "StarAndRing.svg" (fromIntegral width) (fromIntegral height)+ (flip renderWith $ starAndRing width height)+ putStrLn "wrote StarAndRing.svg"++ where width = 600+ height = 600
+ demo/gtk3/Text.hs view
@@ -0,0 +1,71 @@+import Graphics.Rendering.Cairo+import qualified Graphics.Rendering.Cairo.Matrix as M++boxText :: String -> Double -> Double -> Render ()+boxText text x y = do+ save++ lineWidth <- getLineWidth++ (TextExtents xb yb w h _ _) <- textExtents text++ rectangle (x + xb - lineWidth)+ (y + yb - lineWidth)+ (w + 2 * lineWidth)+ (h + 2 * lineWidth)+ stroke+ moveTo x y+ textPath text+ fillPreserve+ setSourceRGBA 0 0 1 0.5+ setLineWidth 3.0+ stroke++ restore++transpSurface :: Double -> Double -> Render ()+transpSurface w h = do+ save+ rectangle 0 0 w h+ setSourceRGBA 0 0 0 0+ setOperator OperatorSource+ fill+ restore++sWidth = 400+sHeight = 300++main :: IO ()+main = withImageSurface FormatARGB32 sWidth sHeight $ \surface -> do+ renderWith surface $ do+ setSourceRGB 0.0 0.0 0.0+ setLineWidth 2.0++ transpSurface (fromIntegral sWidth) (fromIntegral sHeight)++ selectFontFace "sans" FontSlantNormal FontWeightNormal+ setFontSize 40++ extents <- fontExtents+ let fontHeight = fontExtentsHeight extents++ boxText "Howdy, world!" 10 fontHeight++ translate 0 fontHeight++ save+ translate 10 fontHeight+ rotate (10.0 * pi / 180.0)+ boxText "Yay for Haskell!" 0 0+ restore++ translate 0 (3 * fontHeight)++ save+ setFontMatrix $ M.rotate ((-10.0) * pi / 180.0) $ M.scale 40.0 40.0 M.identity+ boxText "...and Cairo!" 10 fontHeight+ restore++ surfaceWriteToPNG surface "Text.png"++ return ()