factor/extra/cairo-gadgets/cairo-gadgets.factor

62 lines
1.6 KiB
Factor

! Copyright (C) 2008 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences math kernel byte-arrays cairo.ffi cairo
io.backend ui.gadgets accessors opengl.gl arrays fry
classes ui.render namespaces destructors libc ;
IN: cairo-gadgets
SYMBOL: current-cairo
: cr ( -- cairo )
current-cairo get ;
<PRIVATE
: width>stride ( width -- stride ) 4 * ;
: image-dims ( gadget -- width height stride )
dim>> first2 over width>stride ; inline
: image-buffer ( width height stride -- alien )
* nip malloc &free ; inline
: with-cairo ( cairo quot -- )
[ &cairo_destroy current-cairo ] dip
'[ @ current-cairo get check-cairo ] with-variable ; inline
: with-surface ( cairo_surface quot -- alien )
[ &cairo_surface_destroy ] dip [ check-surface ] bi ; inline
: with-cairo-from-surface ( cairo_surface quot -- )
'[ cairo_create _ with-cairo ] with-surface ; inline
PRIVATE>
GENERIC: render-cairo* ( gadget -- )
: render-cairo ( gadget -- alien )
[
image-dims
[ image-buffer dup CAIRO_FORMAT_ARGB32 ]
[ cairo_image_surface_create_for_data ] 3bi
] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ;
TUPLE: cairo-gadget < gadget ;
: <cairo-gadget> ( dim -- gadget )
cairo-gadget new
swap >>dim ;
M: cairo-gadget draw-gadget*
[
[ dim>> ] [ render-cairo ] bi
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
[ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
glDrawPixels
] with-destructors ;
: copy-surface ( surface -- )
cr swap 0 0 cairo_set_source_surface
cr cairo_paint ;