factor/basis/cairo/cairo.factor

! Copyright (C) 2008 Doug Coleman.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: colors fonts cairo.ffi alien alien.c-types kernel accessors
sequences namespaces fry continuations destructors math images
images.memory math.rectangles ;
IN: cairo

ERROR: cairo-error n message ;

: (check-cairo) ( cairo_status_t -- )
    dup CAIRO_STATUS_SUCCESS =
    [ drop ] [ [ ] [ cairo_status_to_string ] bi cairo-error ] if ;

: check-cairo ( cairo -- ) cairo_status (check-cairo) ;

: check-surface ( surface -- ) cairo_surface_status (check-cairo) ;

: width>stride ( width -- stride ) uint heap-size * ; inline

: <image-surface> ( data dim -- surface )
    [ CAIRO_FORMAT_ARGB32 ] dip first2 over width>stride
    cairo_image_surface_create_for_data
    dup check-surface ;

: <cairo> ( surface -- cairo ) cairo_create dup check-cairo ; inline

: make-bitmap-image ( dim quot -- image )
    '[
        <image-surface> &cairo_surface_destroy
        <cairo> &cairo_destroy
        @
    ] make-memory-bitmap
    BGRA >>component-order
    ubyte-components >>component-type ; inline

: dummy-cairo ( -- cr )
    ! Sometimes we want a dummy context; eg with Pango, we want
    ! to measure text dimensions to create a new image context with,
    ! but we need an existing context to measure text dimensions
    ! with so we use the dummy.
    \ dummy-cairo [
        CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
        cairo_create
    ] initialize-alien ;

: set-source-color ( cr color -- )
    >rgba-components cairo_set_source_rgba ;

: fill-rect ( cr rect -- )
    [ rect-bounds [ first2 ] bi@ cairo_rectangle ]
    [ drop cairo_fill ]
    2bi ;