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 opengl.gadgets kernel
   4 byte-arrays cairo.ffi cairo io.backend
   5 opengl.gl arrays ;
   6
   7 IN: cairo.gadgets
   8
   9 : width>stride ( width -- stride ) 4 * ;
  10
  11 : copy-cairo ( dim quot -- byte-array )
  12     >r first2 over width>stride
  13     [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
  14     [ cairo_image_surface_create_for_data ] 3bi
  15     r> with-cairo-from-surface ;
  16
  17 : <cairo-gadget> ( dim quot -- )
  18     over 2^-bounds swap copy-cairo
  19     GL_BGRA rot <texture-gadget> ;
  20
  21 ! maybe also texture>png
  22 ! : cairo>png ( gadget path -- )
  23 !    >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
  24 !    [ height>> ] tri over width>stride
  25 !    cairo_image_surface_create_for_data
  26 !    r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
  27
  28 : copy-surface ( surface -- )
  29     cr swap 0 0 cairo_set_source_surface
  30     cr cairo_paint ;
  31
  32 : <png-gadget> ( path -- gadget )
  33     normalize-path cairo_image_surface_create_from_png
  34     [ cairo_image_surface_get_width ]
  35     [ cairo_image_surface_get_height 2array dup 2^-bounds ]
  36     [ [ copy-surface ] curry copy-cairo ] tri
  37     GL_BGRA rot <texture-gadget> ;
  38
  39