diff --git a/extra/cairo/authors.txt b/extra/cairo/authors.txt index 4a2736dd93..68d35d192b 100644 --- a/extra/cairo/authors.txt +++ b/extra/cairo/authors.txt @@ -1 +1,2 @@ Sampo Vuori +Doug Coleman diff --git a/extra/cairo/cairo.factor b/extra/cairo/ffi/ffi.factor similarity index 99% rename from extra/cairo/cairo.factor rename to extra/cairo/ffi/ffi.factor index 0d3e0c27e6..d7aa90c464 100644 --- a/extra/cairo/cairo.factor +++ b/extra/cairo/ffi/ffi.factor @@ -10,7 +10,7 @@ USING: alien alien.syntax combinators system ; -IN: cairo +IN: cairo.ffi << "cairo" { { [ win32? ] [ "cairo.dll" ] } diff --git a/extra/cairo/lib/lib.factor b/extra/cairo/lib/lib.factor new file mode 100644 index 0000000000..9e226ee47a --- /dev/null +++ b/extra/cairo/lib/lib.factor @@ -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 +M: cairo-t dispose ( alien -- ) alien>> cairo_destroy ; +: cairo-t-destroy-always ( alien -- ) add-always-destructor ; +: cairo-t-destroy-later ( alien -- ) add-error-destructor ; + +TUPLE: cairo-surface-t alien ; +C: cairo-surface-t +M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ; + +: cairo-surface-t-destroy-always ( alien -- ) + add-always-destructor ; + +: cairo-surface-t-destroy-later ( alien -- ) + 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 ; diff --git a/extra/cairo/png/png.factor b/extra/cairo/png/png.factor new file mode 100644 index 0000000000..b9da14088c --- /dev/null +++ b/extra/cairo/png/png.factor @@ -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 ; + +: ( 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 ; + +: ( path -- gadget ) + png-gadget construct-gadget swap + >>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 ;