basis/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 destructors libc ;
   6 IN: cairo.gadgets
   7
   8 <PRIVATE
   9 : width>stride ( width -- stride ) 4 * ;
  10
  11 : image-dims ( gadget -- width height stride )
  12     dim>> first2 over width>stride ; inline
  13 : image-buffer ( width height stride -- alien )
  14     * nip malloc ; inline
  15 PRIVATE>
  16
  17 GENERIC: render-cairo* ( gadget -- )
  18
  19 : render-cairo ( gadget -- alien )
  20     [
  21         image-dims
  22         [ image-buffer dup CAIRO_FORMAT_ARGB32 ]
  23         [ cairo_image_surface_create_for_data ] 3bi
  24     ] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ;
  25
  26 TUPLE: cairo-gadget < gadget ;
  27
  28 : <cairo-gadget> ( dim -- gadget )
  29     cairo-gadget new-gadget
  30         swap >>dim ;
  31
  32 M: cairo-gadget draw-gadget*
  33     [
  34         [ dim>> ] [ render-cairo &free ] bi
  35         origin get first2 glRasterPos2i
  36         1.0 -1.0 glPixelZoom
  37         [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
  38         glDrawPixels
  39     ] with-destructors ;
  40
  41 : copy-surface ( surface -- )
  42     cr swap 0 0 cairo_set_source_surface
  43     cr cairo_paint ;