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

images.loader: support for saving images on the gtk-image backend

db4
Björn Lindqvist 2014-03-07 23:42:51 +01:00 committed by John Benediktsson
parent d4a56057f0
commit 3a8164cd8a
5 changed files with 110 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/gdk/pixbuf/ffi/ffi.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.data alien.libraries alien.syntax
USING: alien alien.c-types alien.data alien.libraries alien.syntax
combinators gio.ffi glib.ffi gobject-introspection
gobject-introspection.standard-types kernel libc
sequences system vocabs ;
@ -22,11 +22,32 @@ LIBRARY: gdk.pixbuf
GIR: vocab:gdk/pixbuf/GdkPixbuf-2.0.gir
! <workaround incorrect return-value in gir
! <workaround incorrect return-values in gir
FORGET: gdk_pixbuf_get_pixels
FUNCTION: guint8* gdk_pixbuf_get_pixels ( GdkPixbuf* pixbuf ) ;
FORGET: gdk_pixbuf_new_from_data
FUNCTION: GdkPixbuf* gdk_pixbuf_new_from_data ( guint8* data,
GdkColorspace colorspace,
gboolean has_alpha,
int bits_per_sample,
int width,
int height,
int rowstride,
GdkPixbufDestroyNotify destroy_fn,
gpointer destroy_fn_data ) ;
FORGET: gdk_pixbuf_save_to_bufferv
FUNCTION: gboolean gdk_pixbuf_save_to_bufferv ( GdkPixbuf* pixbuf,
guint8** data,
gsize* buffer_size,
c-string type,
char **option_keys,
char **option_values,
GError **error ) ;
! workaround>
: data>GInputStream ( data -- GInputStream )

21
basis/images/loader/gtk/gtk-tests.factor Normal file
View File

@ -0,0 +1,21 @@
USING: accessors arrays continuations gdk.pixbuf.ffi glib.ffi gobject.ffi
images.loader images.loader.gtk images.loader.gtk.private io
io.encodings.binary io.files kernel tools.test ;
IN: images.loader.gtk.tests
: open-png-image ( -- image )
"vocab:images/testing/png/basi0g01.png" load-image ;
[ t ] [
open-png-image [ dim>> ] [
image>GdkPixbuf &g_object_unref
[ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array
] bi =
] unit-test
[ t ] [
[
open-png-image image>GdkPixbuf &g_object_unref
"frob" GdkPixbuf>byte-array
] [ g-error? ] recover
] unit-test

56
basis/images/loader/gtk/gtk.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2010 Philipp Brüschweiler.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data arrays combinators
destructors gdk.pixbuf.ffi gobject.ffi grouping images
USING: accessors alien.c-types alien.data alien.syntax arrays assocs
combinators destructors gdk.pixbuf.ffi glib.ffi gobject.ffi grouping images
images.loader io kernel locals math sequences
specialized-arrays ;
specialized-arrays unicode.case ;
FROM: system => os linux? ;
IN: images.loader.gtk
SPECIALIZED-ARRAY: uchar
@ -11,6 +11,8 @@ SPECIALIZED-ARRAY: uchar
SINGLETON: gtk-image
os linux? [
! Explicit type initialization needed for glib < 2.36.
g_type_init
"png" gtk-image register-image-class
"tif" gtk-image register-image-class
"tiff" gtk-image register-image-class
@ -44,12 +46,14 @@ os linux? [
] if
] ;
CONSTANT: bits>components {
{ 8 ubyte-components }
{ 16 ushort-components }
{ 32 uint-components }
}
: component-type ( GdkPixbuf -- component-type )
gdk_pixbuf_get_bits_per_sample {
{ 8 [ ubyte-components ] }
{ 16 [ ushort-components ] }
{ 32 [ uint-components ] }
} case ;
gdk_pixbuf_get_bits_per_sample bits>components at ;
: GdkPixbuf>image ( GdkPixbuf -- image )
[ image new ] dip
@ -62,6 +66,39 @@ os linux? [
f >>premultiplied-alpha?
f >>upside-down? ;
: bits-per-sample ( image -- bits )
component-type>> bits>components value-at ;
: rowstride ( image -- rowstride )
[ dim>> first ] [ bits-per-sample 8 / ] [ has-alpha? 4 3 ? ] tri * * ;
: image>GdkPixbuf ( image -- GdkPixbuf )
{
[ bitmap>> ]
[ drop GDK_COLORSPACE_RGB ]
[ has-alpha? ]
[ bits-per-sample ]
[ dim>> first2 ]
[ rowstride ]
} cleave f f gdk_pixbuf_new_from_data ;
: GdkPixbuf>byte-array ( GdkPixbuf type -- byte-array )
{ void* int } [
rot f f
{ { pointer: GError initial: f } } [
gdk_pixbuf_save_to_bufferv drop
] with-out-parameters
] with-out-parameters rot handle-GError memory>byte-array ;
! The type parameter is almost always the same as the file extension,
! except for in the jpg -> jpeg and tif -> tiff cases.
: extension>pixbuf-type ( extension -- type )
>lower { { "jpg" "jpeg" } { "tif" "tiff" } } ?at drop ;
: write-image ( image extension -- )
[ image>GdkPixbuf &g_object_unref ] [ extension>pixbuf-type ] bi*
GdkPixbuf>byte-array write ;
PRIVATE>
M: gtk-image stream>image*
@ -69,3 +106,6 @@ M: gtk-image stream>image*
stream-contents data>GInputStream &g_object_unref
GInputStream>GdkPixbuf &g_object_unref
GdkPixbuf>image ;
M: gtk-image image>stream
drop write-image ;

16
basis/images/loader/loader-tests.factor Normal file
View File

@ -0,0 +1,16 @@
USING: continuations images.loader io.files.temp kernel system tools.test ;
IN: images.loader.tests
os linux? [
[ t ] [
"vocab:images/testing/png/basi0g01.png" load-image dup
"foo.bmp" temp-file [ save-graphic-image ] [ load-image ] bi =
] unit-test
[ t ] [
[
"vocab:images/testing/png/basi0g01.png" load-image
"hai!" save-graphic-image
] [ unknown-image-extension? ] recover
] unit-test
] when

5
basis/images/loader/loader.factor
View File

@ -47,9 +47,8 @@ M: pathname load-image*
[ binary <file-reader> ] dip stream>image ;
! Image Encode
GENERIC: image>stream ( image class -- )
GENERIC: image>stream ( image extension class -- )
: save-graphic-image ( image path -- )
[ image-class ] [ ] bi
dup file-extension dup (image-class) rot
binary [ image>stream ] with-file-writer ;