1 ! Copyright (C) 2010 Philipp Brüschweiler.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data alien.syntax arrays assocs
4 combinators destructors gdk.pixbuf.ffi glib.ffi gobject.ffi grouping images
5 images.loader io kernel locals math sequences system
6 specialized-arrays unicode ;
8 SPECIALIZED-ARRAY: uchar
13 ! Explicit type initialization needed for glib < 2.36.
15 { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" }
16 [ gtk-image register-image-class ] each
21 : image-data ( GdkPixbuf -- data )
23 [ gdk_pixbuf_get_pixels ]
24 [ gdk_pixbuf_get_width ]
25 [ gdk_pixbuf_get_height ]
26 [ gdk_pixbuf_get_rowstride ]
27 [ gdk_pixbuf_get_n_channels ]
28 [ gdk_pixbuf_get_bits_per_sample ]
30 [let :> ( pixels w h rowstride channels bps )
31 bps channels * 7 + 8 /i w * :> bytes-per-row
33 bytes-per-row rowstride =
34 [ pixels h rowstride * memory>byte-array ]
36 pixels rowstride h * uchar <c-direct-array>
38 [ bytes-per-row head-slice ] map concat
42 CONSTANT: bits>components {
43 { 8 ubyte-components }
44 { 16 ushort-components }
45 { 32 uint-components }
48 : component-type ( GdkPixbuf -- component-type )
49 gdk_pixbuf_get_bits_per_sample bits>components at ;
51 : GdkPixbuf>image ( GdkPixbuf -- image )
54 [ [ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array >>dim ]
55 [ image-data >>bitmap ]
56 [ gdk_pixbuf_get_has_alpha RGBA RGB ? >>component-order ]
57 [ component-type >>component-type ]
59 f >>premultiplied-alpha?
62 : image>GdkPixbuf ( image -- GdkPixbuf )
65 [ drop GDK_COLORSPACE_RGB ]
67 [ component-type>> bytes-per-component 8 * ]
70 } cleave f f gdk_pixbuf_new_from_data ;
72 : GdkPixbuf>byte-array ( GdkPixbuf type -- byte-array )
75 { { pointer: GError initial: f } } [
76 gdk_pixbuf_save_to_bufferv drop
78 ] with-out-parameters rot handle-GError memory>byte-array ;
80 ! The type parameter is almost always the same as the file extension,
81 ! except for in the jpg -> jpeg and tif -> tiff cases.
82 : extension>pixbuf-type ( extension -- type )
83 >lower { { "jpg" "jpeg" } { "tif" "tiff" } } ?at drop ;
85 : write-image ( image extension -- )
86 [ image>GdkPixbuf &g_object_unref ] [ extension>pixbuf-type ] bi*
87 GdkPixbuf>byte-array write ;
91 M: gtk-image stream>image*
93 stream-contents data>GInputStream &g_object_unref
94 GInputStream>GdkPixbuf &g_object_unref
97 M: gtk-image image>stream