extra/cairo-gadgets/cairo-gadgets.factor

   1 ! Copyright (C) 2008 Matthew Willis.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors cairo cairo.ffi destructors kernel libc math
   4 namespaces opengl.gl sequences ui.gadgets ui.render ;
   5 IN: cairo-gadgets
   6
   7 SYMBOL: current-cairo
   8
   9 : cr ( -- cairo )
  10     current-cairo get ;
  11
  12 <PRIVATE
  13
  14 : width>stride ( width -- stride ) 4 * ;
  15
  16 : image-dims ( gadget -- width height stride )
  17     dim>> first2 over width>stride ; inline
  18
  19 : image-buffer ( width height stride -- alien )
  20     * nip malloc &free ; inline
  21
  22 : with-cairo ( cairo quot -- )
  23     [ &cairo_destroy current-cairo ] dip
  24     '[ @ current-cairo get check-cairo ] with-variable ; inline
  25
  26 : with-surface ( cairo_surface quot -- alien )
  27     [ &cairo_surface_destroy ] dip [ check-surface ] bi ; inline
  28
  29 : with-cairo-from-surface ( cairo_surface quot -- )
  30     '[ cairo_create _ with-cairo ] with-surface ; inline
  31
  32 PRIVATE>
  33
  34 GENERIC: render-cairo* ( gadget -- )
  35
  36 : render-cairo ( gadget -- alien )
  37     [
  38         image-dims
  39         [ image-buffer dup CAIRO_FORMAT_ARGB32 ]
  40         [ cairo_image_surface_create_for_data ] 3bi
  41     ] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ;
  42
  43 TUPLE: cairo-gadget < gadget ;
  44
  45 : <cairo-gadget> ( dim -- gadget )
  46     cairo-gadget new
  47         swap >>dim ;
  48
  49 M: cairo-gadget draw-gadget*
  50     [
  51         [ dim>> ] [ render-cairo ] bi
  52         0 0 glRasterPos2i
  53         1.0 -1.0 glPixelZoom
  54         [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
  55         glDrawPixels
  56     ] with-destructors ;
  57
  58 : copy-surface ( surface -- )
  59     cr swap 0 0 cairo_set_source_surface
  60     cr cairo_paint ;