basis/cairo/cairo.factor

   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 ;
   7 IN: cairo
   8
   9 ERROR: cairo-error message ;
  10
  11 : (check-cairo) ( cairo_status_t -- )
  12     dup CAIRO_STATUS_SUCCESS =
  13     [ drop ] [ cairo_status_to_string cairo-error ] if ;
  14
  15 : check-cairo ( cairo -- ) cairo_status (check-cairo) ;
  16
  17 : with-cairo ( cairo quot -- )
  18     '[
  19         _ &cairo_destroy
  20         _ [ check-cairo ] bi
  21     ] with-destructors ; inline
  22
  23 : check-surface ( surface -- ) cairo_surface_status (check-cairo) ;
  24
  25 : with-surface ( cairo_surface quot -- )
  26     '[
  27         _ &cairo_surface_destroy
  28         _ [ check-surface ] bi
  29     ] with-destructors ; inline
  30
  31 : with-cairo-from-surface ( cairo_surface quot -- )
  32     '[ cairo_create _ with-cairo ] with-surface ; inline
  33
  34 : width>stride ( width -- stride ) "uint" heap-size * ; inline
  35
  36 : <image-surface> ( data dim -- surface )
  37     [ CAIRO_FORMAT_ARGB32 ] dip first2 over width>stride
  38     cairo_image_surface_create_for_data
  39     dup check-surface ;
  40
  41 : <cairo> ( surface -- cairo ) cairo_create dup check-cairo ; inline
  42
  43 : make-bitmap-image ( dim quot -- image )
  44     '[
  45         <image-surface> &cairo_surface_destroy
  46         cairo_create &cairo_destroy
  47         @
  48     ] make-memory-bitmap
  49     BGRA >>component-order ; inline
  50
  51 : dummy-cairo ( -- cr )
  52     #! Sometimes we want a dummy context; eg with Pango, we want
  53     #! to measure text dimensions to create a new image context with,
  54     #! but we need an existing context to measure text dimensions
  55     #! with so we use the dummy.
  56     \ dummy-cairo [
  57         CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create
  58         cairo_create
  59     ] initialize-alien ;
  60
  61 : set-source-color ( cr color -- )
  62     >rgba-components cairo_set_source_rgba ;