extra/cairo/gadgets/gadgets.factor

   1 ! Copyright (C) 2008 Matthew Willis.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences math kernel byte-arrays cairo.ffi cairo
   4 io.backend ui.gadgets accessors opengl.gl arrays fry
   5 classes ui.render namespaces ;
   6
   7 IN: cairo.gadgets
   8
   9 : width>stride ( width -- stride ) 4 * ;
  10
  11 GENERIC: render-cairo* ( gadget -- )
  12
  13 : render-cairo ( gadget -- byte-array )
  14     dup dim>> first2 over width>stride
  15     [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
  16     [ cairo_image_surface_create_for_data ] 3bi
  17     rot '[ _ render-cairo* ] with-cairo-from-surface ; inline
  18
  19 TUPLE: cairo-gadget < gadget ;
  20
  21 : <cairo-gadget> ( dim -- gadget )
  22     cairo-gadget new-gadget
  23         swap >>dim ;
  24
  25 M: cairo-gadget draw-gadget*
  26     [ dim>> ] [ render-cairo ] bi
  27     origin get first2 glRasterPos2i
  28     1.0 -1.0 glPixelZoom
  29     >r first2 GL_BGRA GL_UNSIGNED_BYTE r>
  30     glDrawPixels ;
  31
  32 : copy-surface ( surface -- )
  33     cr swap 0 0 cairo_set_source_surface
  34     cr cairo_paint ;