move cairo to cairo.ffi

add low-level cairo resource disposal
add cairo.png viewer
db4
Doug Coleman 2008-03-15 19:36:28 -05:00
parent b36f1e4ea5
commit 1e9abc971c
4 changed files with 87 additions and 1 deletions

View File

@ -1 +1,2 @@
Sampo Vuori
Doug Coleman

View File

@ -10,7 +10,7 @@
USING: alien alien.syntax combinators system ;
IN: cairo
IN: cairo.ffi
<< "cairo" {
{ [ win32? ] [ "cairo.dll" ] }

View File

@ -0,0 +1,40 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types cairo.ffi continuations destructors
kernel libc locals math combinators.cleave shuffle new-slots
accessors ;
IN: cairo.lib
TUPLE: cairo-t alien ;
C: <cairo-t> cairo-t
M: cairo-t dispose ( alien -- ) alien>> cairo_destroy ;
: cairo-t-destroy-always ( alien -- ) <cairo-t> add-always-destructor ;
: cairo-t-destroy-later ( alien -- ) <cairo-t> add-error-destructor ;
TUPLE: cairo-surface-t alien ;
C: <cairo-surface-t> cairo-surface-t
M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
: cairo-surface-t-destroy-always ( alien -- )
<cairo-surface-t> add-always-destructor ;
: cairo-surface-t-destroy-later ( alien -- )
<cairo-surface-t> add-error-destructor ;
: cairo-surface>array ( surface -- cairo-t byte-array )
[
dup
[ drop CAIRO_FORMAT_ARGB32 ]
[ cairo_image_surface_get_width ]
[ cairo_image_surface_get_height ] tri
over 4 *
2dup * [
malloc dup free-always [
5 -nrot cairo_image_surface_create_for_data
dup cairo-surface-t-destroy-always
cairo_create dup cairo-t-destroy-later
[ swap 0 0 cairo_set_source_surface ] keep
dup cairo_paint
] keep
] keep memory>byte-array
] with-destructors ;

View File

@ -0,0 +1,45 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.cleave kernel new-slots
accessors math ui.gadgets ui.render opengl.gl byte-arrays
namespaces opengl cairo.ffi cairo.lib ;
IN: cairo.png
TUPLE: png surface width height cairo-t array ;
TUPLE: png-gadget png ;
: <png> ( path -- png )
cairo_image_surface_create_from_png
dup [ cairo_image_surface_get_width ]
[ cairo_image_surface_get_height ] [ ] tri
cairo-surface>array png construct-boa ;
: write-png ( png path -- )
>r png-surface r>
cairo_surface_write_to_png
zero? [ "write png failed" throw ] unless ;
: <png-gadget> ( path -- gadget )
png-gadget construct-gadget swap
<png> >>png ;
M: png-gadget pref-dim* ( gadget -- )
png>>
[ width>> ] [ height>> ] bi 2array ;
M: png-gadget draw-gadget* ( gadget -- )
origin get [
0 0 glRasterPos2i
1.0 -1.0 glPixelZoom
png>>
[ width>> ]
[ height>> GL_RGBA GL_UNSIGNED_BYTE ]
[ array>> ] tri
glDrawPixels
] with-translation ;
M: png-gadget graft* ( gadget -- )
drop ;
M: png-gadget ungraft* ( gadget -- )
png>> surface>> cairo_destroy ;