[Gtk2hs-commit] (main branch): Add a cairo demo that uses Gtk3

[Daniel W. <dm...@lu...>]

diffing dir...
Mon Apr  8 05:52:02 BST 2013  Hamish Mackenzie <ham...@go...>
  * Add a cairo demo that uses Gtk3
  Ignore-this: 4c8096e1ea3fe9b7c3e3a51b5a6628a0
    addfile ./cairo/demo/DrawingGtk3.hs
    hunk ./cairo/demo/DrawingGtk3.hs 1
    +-- 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 <- dialogGetContentArea dia
    +  canvas <- drawingAreaNew
    +  canvas `on` sizeRequest $ return (Requisition 40 40)
    +  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
    +
    +