cairo 0.11.0 → 0.11.1

raw patch · 12 files changed

+1128/−2 lines, 12 filesbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Graphics/Rendering/Cairo.hs +3/−0
• Gtk2HsSetup.hs +1/−1
• cairo.cabal +12/−1
• demo/CairoGhci.hs +76/−0
• demo/Clock.hs +409/−0
• demo/Drawing.hs +59/−0
• demo/Drawing2.hs +258/−0
• demo/Graph.hs +98/−0
• demo/Makefile +30/−0
• demo/StarAndRing.hs +111/−0
• demo/Text.hs +71/−0
• demo/cairo-clock-icon.png binary

@@ -207,6 +207,7 @@ #ifdef CAIRO_HAS_PNG_FUNCTIONS   -- ** PNG support   , withImageSurfaceFromPNG+  , imageSurfaceCreateFromPNG   , surfaceWriteToPNG #endif @@ -289,6 +290,8 @@ 			 ,getNumElements #endif                        )+import Graphics.Rendering.Cairo.Internal (imageSurfaceCreateFromPNG)+ import Graphics.Rendering.Cairo.Types import qualified Graphics.Rendering.Cairo.Internal as Internal import Graphics.Rendering.Cairo.Internal (Render(..), bracketR)

@@ -455,7 +455,7 @@ -- existance of a .chs module may not depend on some CPP condition.   extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md-extractDeps md@ModDep { mdLocation = Just f } = withFileContents f $ \con -> do+extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do   let findImports acc (('{':'#':xs):xxs) = case (dropWhile ((==) ' ') xs) of         ('i':'m':'p':'o':'r':'t':' ':ys) ->           case simpleParse (takeWhile ((/=) '#') ys) of

@@ -1,5 +1,5 @@ Name:           cairo-Version:        0.11.0+Version:        0.11.1 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@@ -19,6 +19,17 @@ extra-source-files: cairo-gtk2hs.h                     Gtk2HsSetup.hs +Data-Dir:		demo+Data-Files:		cairo-clock-icon.png+                CairoGhci.hs+                Clock.hs+                Drawing2.hs+                Drawing.hs+                Graph.hs+                Makefile+                StarAndRing.hs+                Text.hs+				 Source-Repository head   type:         darcs   location:     http://code.haskell.org/gtk2hs/

@@ -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

@@ -0,0 +1,409 @@+-- 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.Glib (handleGError, GError(..))+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+  handleGError (\_ -> return ()) $+    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

@@ -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

@@ -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++----------------------------------------------------------------

@@ -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

@@ -0,0 +1,30 @@++PROGS  = drawing drawing2 starandring text clock graph+SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.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)++HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)++clean:+	rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)++HC=ghc

@@ -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

@@ -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 ()

binary file changed (absent → 4384 bytes)