1 ! Copyright (C) 2008 Doug Coleman.
2 ! Copyright (C) 2009 Slava Pestov.
3 ! See http://factorcode.org/license.txt for BSD license.
4 USING: colors fonts cairo.ffi alien alien.c-types kernel accessors
5 sequences namespaces fry continuations destructors math images
6 images.memory math.rectangles ;
9 ERROR: cairo-error n message ;
11 : (check-cairo) ( cairo_status_t -- )
12 dup CAIRO_STATUS_SUCCESS =
13 [ drop ] [ [ ] [ cairo_status_to_string ] bi throw-cairo-error ] if ;
15 : check-cairo ( cairo -- ) cairo_status (check-cairo) ;
17 : check-surface ( surface -- ) cairo_surface_status (check-cairo) ;
19 : width>stride ( width -- stride ) uint heap-size * ; inline
21 : <image-surface> ( data dim -- surface )
22 [ CAIRO_FORMAT_ARGB32 ] dip first2 over width>stride
23 cairo_image_surface_create_for_data
26 : <cairo> ( surface -- cairo ) cairo_create dup check-cairo ; inline
28 : make-bitmap-image ( dim quot -- image )
30 <image-surface> &cairo_surface_destroy
31 <cairo> &cairo_destroy
34 BGRA >>component-order
35 ubyte-components >>component-type ; inline
37 : dummy-cairo ( -- cr )
38 #! Sometimes we want a dummy context; eg with Pango, we want
39 #! to measure text dimensions to create a new image context with,
40 #! but we need an existing context to measure text dimensions
41 #! with so we use the dummy.
43 CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
47 : set-source-color ( cr color -- )
48 >rgba-components cairo_set_source_rgba ;
50 : fill-rect ( cr rect -- )
51 [ rect-bounds [ first2 ] bi@ cairo_rectangle ]