cairo image surface buffer needs to be mallocked

db4
Joe Groff 2008-12-31 12:35:10 -08:00
parent 9705778f4b
commit 89698024cd
1 changed files with 21 additions and 12 deletions

View File

@ -2,19 +2,26 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: sequences math kernel byte-arrays cairo.ffi cairo USING: sequences math kernel byte-arrays cairo.ffi cairo
io.backend ui.gadgets accessors opengl.gl arrays fry io.backend ui.gadgets accessors opengl.gl arrays fry
classes ui.render namespaces ; classes ui.render namespaces destructors libc ;
IN: cairo.gadgets IN: cairo.gadgets
<PRIVATE
: width>stride ( width -- stride ) 4 * ; : 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 ; inline
PRIVATE>
GENERIC: render-cairo* ( gadget -- ) GENERIC: render-cairo* ( gadget -- )
: render-cairo ( gadget -- byte-array ) : render-cairo ( gadget -- alien )
dup dim>> first2 over width>stride [
[ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ] image-dims
[ cairo_image_surface_create_for_data ] 3bi [ image-buffer dup CAIRO_FORMAT_ARGB32 ]
rot '[ _ render-cairo* ] with-cairo-from-surface ; inline [ cairo_image_surface_create_for_data ] 3bi
] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ;
TUPLE: cairo-gadget < gadget ; TUPLE: cairo-gadget < gadget ;
@ -23,11 +30,13 @@ TUPLE: cairo-gadget < gadget ;
swap >>dim ; swap >>dim ;
M: cairo-gadget draw-gadget* M: cairo-gadget draw-gadget*
[ dim>> ] [ render-cairo ] bi [
origin get first2 glRasterPos2i [ dim>> ] [ render-cairo &free ] bi
1.0 -1.0 glPixelZoom origin get first2 glRasterPos2i
[ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip 1.0 -1.0 glPixelZoom
glDrawPixels ; [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
glDrawPixels
] with-destructors ;
: copy-surface ( surface -- ) : copy-surface ( surface -- )
cr swap 0 0 cairo_set_source_surface cr swap 0 0 cairo_set_source_surface