extra/cairo/gadget/gadget.factor

   1 USING: cairo ui.render kernel opengl.gl opengl
   2 math byte-arrays ui.gadgets accessors arrays
   3 namespaces ;
   4
   5 IN: cairo.gadget
   6
   7 TUPLE: cairo-gadget width height quot ;
   8 : <cairo-gadget> ( width height quot -- cairo-gadget )
   9     cairo-gadget construct-gadget
  10     swap >>quot
  11     swap >>height
  12     swap >>width ;
  13
  14 : with-surface ( surface quot -- )
  15     >r dup cairo_create dup r> call
  16     cairo_destroy cairo_surface_destroy ;
  17
  18 : cairo>bytes ( width height quot -- byte-array )
  19     >r over 4 *
  20     [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
  21     [ cairo_image_surface_create_for_data ] 3bi
  22     r> with-surface ;
  23
  24 M: cairo-gadget draw-gadget* ( gadget -- )
  25     origin get [
  26         0 0 glRasterPos2i
  27         1.0 -1.0 glPixelZoom
  28         [ width>> ] [ height>> ] [ quot>> ] tri
  29         [ drop GL_RGBA GL_UNSIGNED_BYTE ] [ cairo>bytes ] 3bi
  30         glDrawPixels
  31     ] with-translation ;
  32
  33 M: cairo-gadget pref-dim* ( gadget -- rect )
  34     [ width>> ] [ height>> ] bi 2array ;