steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-03-29 15:50:58 -05:00
parent 7174e8cbc4 606445f790
commit 2928801c4f
2 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/cairo/ffi/ffi.factor
View File

@ -203,6 +203,9 @@ C-ENUM:
CAIRO_HINT_METRICS_ON CAIRO_HINT_METRICS_ON
; ;
FUNCTION: char* cairo_status_to_string ( cairo_status_t status ) ;
FUNCTION: cairo_status_t cairo_status ( cairo_t* cr ) ;
: cairo_create ( cairo_surface_t -- cairo_t ) : cairo_create ( cairo_surface_t -- cairo_t )
"cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ; "cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ;

27
extra/cairo/png/png.factor
View File

@ -1,16 +1,34 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel accessors math ui.gadgets ui.render USING: arrays kernel accessors math ui.gadgets ui.render
opengl.gl byte-arrays namespaces opengl cairo.ffi cairo.lib ; opengl.gl byte-arrays namespaces opengl cairo.ffi cairo.lib
inspector sequences combinators io.backend ;
IN: cairo.png IN: cairo.png
TUPLE: png surface width height cairo-t array ; TUPLE: png surface width height cairo-t array ;
TUPLE: png-gadget png ; TUPLE: png-gadget png ;
ERROR: cairo-error string ;
: check-zero
dup zero? [
"PNG dimension is 0" cairo-error
] when ;
: cairo-png-error ( n -- )
{
{ [ dup CAIRO_STATUS_NO_MEMORY = ] [ "Cairo: no memory" cairo-error ] }
{ [ dup CAIRO_STATUS_FILE_NOT_FOUND = ] [ "Cairo: file not found" cairo-error ] }
{ [ dup CAIRO_STATUS_READ_ERROR = ] [ "Cairo: read error" cairo-error ] }
{ [ t ] [ drop ] }
} cond ;
: <png> ( path -- png ) : <png> ( path -- png )
normalize-pathname
cairo_image_surface_create_from_png cairo_image_surface_create_from_png
dup [ cairo_image_surface_get_width ] dup cairo_surface_status cairo-png-error
[ cairo_image_surface_get_height ] [ ] tri dup [ cairo_image_surface_get_width check-zero ]
[ cairo_image_surface_get_height check-zero ] [ ] tri
cairo-surface>array png construct-boa ; cairo-surface>array png construct-boa ;
: write-png ( png path -- ) : write-png ( png path -- )
@ -33,6 +51,7 @@ M: png-gadget draw-gadget* ( gadget -- )
png>> png>>
[ width>> ] [ width>> ]
[ height>> GL_RGBA GL_UNSIGNED_BYTE ] [ height>> GL_RGBA GL_UNSIGNED_BYTE ]
! [ height>> GL_BGRA GL_UNSIGNED_BYTE ]
[ array>> ] tri [ array>> ] tri
glDrawPixels glDrawPixels
] with-translation ; ] with-translation ;
@ -42,3 +61,5 @@ M: png-gadget graft* ( gadget -- )
M: png-gadget ungraft* ( gadget -- ) M: png-gadget ungraft* ( gadget -- )
png>> surface>> cairo_destroy ; png>> surface>> cairo_destroy ;
! "resource:misc/icons/Factor_1x16.png" USE: cairo.png <png-gadget> gadget.