basis/images/gtk/gtk.factor

   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 arrays combinators
   4 destructors gdk.pixbuf.ffi gobject.ffi grouping images
   5 images.loader io kernel locals math sequences
   6 specialized-arrays ;
   7 IN: images.gtk
   8 SPECIALIZED-ARRAY: uchar
   9
  10 SINGLETON: gtk-image
  11 "png"  gtk-image register-image-class
  12 "tif"  gtk-image register-image-class
  13 "tiff" gtk-image register-image-class
  14 "gif"  gtk-image register-image-class
  15 "jpg"  gtk-image register-image-class
  16 "jpeg" gtk-image register-image-class
  17 "bmp"  gtk-image register-image-class
  18 "ico"  gtk-image register-image-class
  19
  20 <PRIVATE
  21
  22 : image-data ( GdkPixbuf -- data )
  23     {
  24         [ gdk_pixbuf_get_pixels ]
  25         [ gdk_pixbuf_get_width ]
  26         [ gdk_pixbuf_get_height ]
  27         [ gdk_pixbuf_get_rowstride ]
  28         [ gdk_pixbuf_get_n_channels ]
  29         [ gdk_pixbuf_get_bits_per_sample ]
  30     } cleave
  31     [let :> ( pixels w h rowstride channels bps )
  32         bps channels * 7 + 8 /i w * :> bytes-per-row
  33
  34         bytes-per-row rowstride =
  35         [ pixels h rowstride * memory>byte-array ]
  36         [
  37             pixels rowstride h * <direct-uchar-array>
  38             rowstride <sliced-groups>
  39             [ bytes-per-row head-slice ] map concat
  40         ] if
  41     ] ;
  42
  43 : component-type ( GdkPixbuf -- component-type )
  44     gdk_pixbuf_get_bits_per_sample {
  45         {  8 [ ubyte-components ] }
  46         { 16 [ ushort-components ] }
  47         { 32 [ uint-components ] }
  48     } case ;
  49
  50 : GdkPixbuf>image ( GdkPixbuf -- image )
  51     [ image new ] dip
  52         {
  53             [ [ gdk_pixbuf_get_width ] [ gdk_pixbuf_get_height ] bi 2array >>dim ]
  54             [ image-data >>bitmap ]
  55             [ gdk_pixbuf_get_has_alpha RGBA RGB ? >>component-order ]
  56             [ component-type >>component-type ]
  57         } cleave
  58         f >>premultiplied-alpha?
  59         f >>upside-down? ;
  60
  61 PRIVATE>
  62
  63 M: gtk-image stream>image
  64     drop [
  65         stream-contents data>GInputStream &g_object_unref
  66         GInputStream>GdkPixbuf &g_object_unref
  67         GdkPixbuf>image
  68     ] with-destructors ;