images.gtk: use GdkPixbuf to load images

diff --git a/basis/glib/ffi/ffi.factor b/basis/glib/ffi/ffi.factor
index 99183a88dc7ada495357e3a68eadc4ad5766be70..7724cf5698f7a299e88de53579fc860b71a46c48 100644 (file)
--- a/basis/glib/ffi/ffi.factor
+++ b/basis/glib/ffi/ffi.factor
@@ -67,7 +67,7 @@ TYPEDEF: guint16 gunichar2
 TYPEDEF: gpointer pointer
 TYPEDEF: gpointer any
 
-IMPLEMENT-STRUCTS: GPollFD GSource GSourceFuncs ;
+IMPLEMENT-STRUCTS: GError GPollFD GSource GSourceFuncs ;
 
 GIR: vocab:glib/GLib-2.0.gir
 

diff --git a/basis/images/gtk/authors.txt b/basis/images/gtk/authors.txt
new file mode 100644 (file)
index 0000000..156a81a
--- /dev/null
+++ b/basis/images/gtk/authors.txt
@@ -0,0 +1 @@
+Philipp Brüschweiler

diff --git a/basis/images/gtk/gtk.factor b/basis/images/gtk/gtk.factor
new file mode 100644 (file)
index 0000000..6f6921d
--- /dev/null
+++ b/basis/images/gtk/gtk.factor
@@ -0,0 +1,89 @@
+! Copyright (C) 2010 Philipp Brüschweiler.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.data alien.strings
+alien.syntax arrays classes.struct combinators destructors
+gdk.pixbuf.ffi gio.ffi glib.ffi gobject.ffi grouping images
+images.loader io io.encodings.utf8
+kernel libc locals math sequences specialized-arrays ;
+IN: images.gtk
+SPECIALIZED-ARRAY: uchar
+
+SINGLETON: gtk-image
+"png"  gtk-image register-image-class
+"tif"  gtk-image register-image-class
+"tiff" gtk-image register-image-class
+"gif"  gtk-image register-image-class
+"jpg"  gtk-image register-image-class
+"jpeg" gtk-image register-image-class
+"bmp"  gtk-image register-image-class
+"ico"  gtk-image register-image-class
+
+ERROR: g-error domain code message ;
+
+<PRIVATE
+
+: data>GInputStream ( data -- GInputStream )
+    [ malloc-byte-array &free ] [ length ] bi
+    f g_memory_input_stream_new_from_data &g_object_unref ;
+
+: GError>g-error ( GError -- g-error )
+    [ domain>> g_quark_to_string utf8 alien>string ]
+    [ code>> ]
+    [ message>> utf8 alien>string ] tri
+    \ g-error boa ;
+
+: handle-GError ( GError/f -- )
+    [
+        [ GError>g-error ]
+        [ g_error_free ] bi
+        throw
+    ] when* ;
+
+STRUCT: GErrorPointer { to pointer: GError } ;
+
+: GInputStream>GdkPixbuf ( GInputStream -- GdkPixbuf )
+    f GErrorPointer malloc-struct &free
+    [ gdk_pixbuf_new_from_stream ] keep
+    to>> handle-GError &g_object_unref ;
+
+: image-data ( GdkPixbuf -- data )
+    [let
+        {
+            [ gdk_pixbuf_get_pixels ]
+            [ gdk_pixbuf_get_width ]
+            [ gdk_pixbuf_get_height ]
+            [ gdk_pixbuf_get_rowstride ]
+            [ gdk_pixbuf_get_n_channels ]
+            [ gdk_pixbuf_get_bits_per_sample ]
+        } cleave :> ( pixels w h rowstride channels bps )
+        bps channels * 7 + 8 /i w * :> bytes-per-row
+        pixels rowstride h * <direct-uchar-array>
+        rowstride <sliced-groups>
+        [ bytes-per-row head-slice ] map concat
+    ] ;
+
+: component-type ( GdkPixbuf -- component-type )
+    gdk_pixbuf_get_bits_per_sample {
+        {  8 [ ubyte-components ] }
+        { 16 [ ushort-components ] }
+        { 32 [ uint-components ] }
+    } case ;
+
+: GdkPixbuf>image ( GdkPixbuf -- image )
+    [ image new ] dip
+        {
+            [ [ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array >>dim ]
+            [ image-data >>bitmap ]
+            [ gdk_pixbuf_get_has_alpha RGBA RGB ? >>component-order ]
+            [ component-type >>component-type ]
+        } cleave
+        f >>premultiplied-alpha?
+        f >>upside-down? ;
+
+PRIVATE>
+
+M: gtk-image stream>image
+    drop [
+        stream-contents data>GInputStream
+        GInputStream>GdkPixbuf GdkPixbuf>image
+    ] with-destructors ;

diff --git a/basis/images/gtk/platforms.txt b/basis/images/gtk/platforms.txt
new file mode 100644 (file)
index 0000000..a26481a
--- /dev/null
+++ b/basis/images/gtk/platforms.txt
@@ -0,0 +1,2 @@
+linux
+bsd

diff --git a/basis/images/gtk/summary.txt b/basis/images/gtk/summary.txt
new file mode 100644 (file)
index 0000000..7813e56
--- /dev/null
+++ b/basis/images/gtk/summary.txt
@@ -0,0 +1 @@
+Image loading using GTK's GdkPixbuf API

diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor
index 7084f1aac1813b95da29c51ec6ef6e3bf4e0c7c8..e5d81b8cccd2f1614c28a616c20aa3a24790b3af 100644 (file)
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
@@ -35,9 +35,6 @@ PRIVATE>
 {
     { [ os macosx? ] [ "images.cocoa"   require ] }
     { [ os winnt?  ] [ "images.gdiplus" require ] }
-    [
-        "images.png" require
-        "images.tiff" require
-    ]
+    [ "images.gtk" require ]
 } cond
 >>