move cairo to cairo.ffi
add low-level cairo resource disposal add cairo.png viewerdb4
parent
b36f1e4ea5
commit
1e9abc971c
|
@ -1 +1,2 @@
|
|||
Sampo Vuori
|
||||
Doug Coleman
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
|
||||
USING: alien alien.syntax combinators system ;
|
||||
|
||||
IN: cairo
|
||||
IN: cairo.ffi
|
||||
|
||||
<< "cairo" {
|
||||
{ [ win32? ] [ "cairo.dll" ] }
|
|
@ -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 ;
|
|
@ -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 ;
|
Loading…
Reference in New Issue