1 ! Copyright (C) 2010 Philipp Brüschweiler.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data alien.syntax arrays
4 assocs combinators gdk.pixbuf.ffi glib.ffi gobject.ffi grouping
5 images images.loader io kernel math sequences specialized-arrays
8 SPECIALIZED-ARRAY: uchar
13 { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" }
14 [ gtk-image register-image-class ] each
19 : image-data ( GdkPixbuf -- data )
21 [ gdk_pixbuf_get_pixels ]
22 [ gdk_pixbuf_get_width ]
23 [ gdk_pixbuf_get_height ]
24 [ gdk_pixbuf_get_rowstride ]
25 [ gdk_pixbuf_get_n_channels ]
26 [ gdk_pixbuf_get_bits_per_sample ]
28 [let :> ( pixels w h rowstride channels bps )
29 bps channels * 7 + 8 /i w * :> bytes-per-row
31 bytes-per-row rowstride =
32 [ pixels h rowstride * memory>byte-array ]
34 pixels rowstride h * uchar <c-direct-array>
36 [ bytes-per-row head-slice ] map concat
40 CONSTANT: bits>components {
41 { 8 ubyte-components }
42 { 16 ushort-components }
43 { 32 uint-components }
46 : component-type ( GdkPixbuf -- component-type )
47 gdk_pixbuf_get_bits_per_sample bits>components at ;
49 : GdkPixbuf>image ( GdkPixbuf -- image )
52 [ [ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array >>dim ]
53 [ image-data >>bitmap ]
54 [ gdk_pixbuf_get_has_alpha RGBA RGB ? >>component-order ]
55 [ component-type >>component-type ]
57 f >>premultiplied-alpha?
60 : image>GdkPixbuf ( image -- GdkPixbuf )
63 [ drop GDK_COLORSPACE_RGB ]
65 [ component-type>> bytes-per-component 8 * ]
68 } cleave f f gdk_pixbuf_new_from_data ;
70 : GdkPixbuf>byte-array ( GdkPixbuf type -- byte-array )
73 { { pointer: GError initial: f } } [
74 gdk_pixbuf_save_to_bufferv drop
76 ] with-out-parameters rot handle-GError memory>byte-array ;
78 ! The type parameter is almost always the same as the file extension,
79 ! except for in the jpg -> jpeg and tif -> tiff cases.
80 : extension>pixbuf-type ( extension -- type )
81 >lower { { "jpg" "jpeg" } { "tif" "tiff" } } ?at drop ;
83 : write-image ( image extension -- )
84 [ image>GdkPixbuf &g_object_unref ] [ extension>pixbuf-type ] bi*
85 GdkPixbuf>byte-array write ;
89 M: gtk-image stream>image*
91 stream-contents data>GInputStream &g_object_unref
92 GInputStream>GdkPixbuf &g_object_unref
95 M: gtk-image image>stream