basis/cairo/cairo.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: cairo.ffi kernel accessors sequences
   4 namespaces fry continuations destructors ;
   5 IN: cairo
   6
   7 TUPLE: cairo-t alien ;
   8 C: <cairo-t> cairo-t
   9 M: cairo-t dispose ( alien -- ) alien>> cairo_destroy ;
  10
  11 TUPLE: cairo-surface-t alien ;
  12 C: <cairo-surface-t> cairo-surface-t
  13 M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
  14
  15 : check-cairo ( cairo_status_t -- )
  16     dup CAIRO_STATUS_SUCCESS = [ drop ]
  17     [ cairo_status_to_string "Cairo error: " prepend throw ] if ;
  18
  19 SYMBOL: cairo
  20 : cr ( -- cairo ) cairo get ; inline
  21
  22 : (with-cairo) ( cairo-t quot -- )
  23     [ alien>> cairo ] dip
  24     '[ @ cr cairo_status check-cairo ]
  25     with-variable ; inline
  26
  27 : with-cairo ( cairo quot -- )
  28     [ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline
  29
  30 : (with-surface) ( cairo-surface-t quot -- )
  31     [ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline
  32
  33 : with-surface ( cairo_surface quot -- )
  34     [ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline
  35
  36 : with-cairo-from-surface ( cairo_surface quot -- )
  37     '[ cairo_create _ with-cairo ] with-surface ; inline