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 ui.gadgets accessors opengl.gl
10 : width>stride ( width -- stride ) 4 * ;
12 : copy-cairo ( dim quot -- byte-array )
13 >r first2 over width>stride
14 [ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
15 [ cairo_image_surface_create_for_data ] 3bi
16 r> with-cairo-from-surface ; inline
18 TUPLE: cairo-gadget < texture-gadget dim quot ;
20 : <cairo-gadget> ( dim quot -- gadget )
21 cairo-gadget construct-gadget
25 M: cairo-gadget cache-key* [ dim>> ] [ quot>> ] bi 2array ;
27 : render-cairo ( dim quot -- bytes format )
28 >r 2^-bounds r> copy-cairo GL_BGRA ; inline
30 ! M: cairo-gadget render*
31 ! [ dim>> dup ] [ quot>> ] bi
32 ! render-cairo render-bytes* ;
34 ! maybe also texture>png
35 ! : cairo>png ( gadget path -- )
36 ! >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
37 ! [ height>> ] tri over width>stride
38 ! cairo_image_surface_create_for_data
39 ! r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
41 : copy-surface ( surface -- )
42 cr swap 0 0 cairo_set_source_surface
45 TUPLE: png-gadget < texture-gadget path ;
46 : <png> ( path -- gadget )
47 png-gadget construct-gadget
51 path>> normalize-path cairo_image_surface_create_from_png
52 [ cairo_image_surface_get_width ]
53 [ cairo_image_surface_get_height 2array dup 2^-bounds ]
54 [ [ copy-surface ] curry copy-cairo ] tri
55 GL_BGRA render-bytes* ;
57 M: png-gadget cache-key* path>> ;