basis/images/loader/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 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.case ;
   7 IN: images.loader.gtk
   8 SPECIALIZED-ARRAY: uchar
   9
  10 SINGLETON: gtk-image
  11
  12 os linux? [
  13     ! Explicit type initialization needed for glib < 2.36.
  14     g_type_init
  15     { "png" "tif" "tiff" "gif" "jpg" "jpeg" "bmp" "ico" }
  16     [ gtk-image register-image-class ] each
  17 ] when
  18
  19 <PRIVATE
  20
  21 : image-data ( GdkPixbuf -- data )
  22     {
  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 ]
  29     } cleave
  30     [let :> ( pixels w h rowstride channels bps )
  31         bps channels * 7 + 8 /i w * :> bytes-per-row
  32
  33         bytes-per-row rowstride =
  34         [ pixels h rowstride * memory>byte-array ]
  35         [
  36             pixels rowstride h * uchar <c-direct-array>
  37             rowstride <groups>
  38             [ bytes-per-row head-slice ] map concat
  39         ] if
  40     ] ;
  41
  42 CONSTANT: bits>components {
  43     { 8 ubyte-components }
  44     { 16 ushort-components }
  45     { 32 uint-components }
  46 }
  47
  48 : component-type ( GdkPixbuf -- component-type )
  49     gdk_pixbuf_get_bits_per_sample bits>components at ;
  50
  51 : GdkPixbuf>image ( GdkPixbuf -- image )
  52     [ image new ] dip
  53         {
  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 ]
  58         } cleave
  59         f >>premultiplied-alpha?
  60         f >>upside-down? ;
  61
  62 : image>GdkPixbuf ( image -- GdkPixbuf )
  63     {
  64         [ bitmap>> ]
  65         [ drop GDK_COLORSPACE_RGB ]
  66         [ has-alpha? ]
  67         [ component-type>> bytes-per-component 8 * ]
  68         [ dim>> first2 ]
  69         [ rowstride ]
  70     } cleave f f gdk_pixbuf_new_from_data ;
  71
  72 : GdkPixbuf>byte-array ( GdkPixbuf type -- byte-array )
  73     { void* int } [
  74         rot f f
  75         { { pointer: GError initial: f } } [
  76             gdk_pixbuf_save_to_bufferv drop
  77         ] with-out-parameters
  78     ] with-out-parameters rot handle-GError memory>byte-array ;
  79
  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 ;
  84
  85 : write-image ( image extension -- )
  86     [ image>GdkPixbuf &g_object_unref ] [ extension>pixbuf-type ] bi*
  87     GdkPixbuf>byte-array write ;
  88
  89 PRIVATE>
  90
  91 M: gtk-image stream>image*
  92     drop
  93     stream-contents data>GInputStream &g_object_unref
  94     GInputStream>GdkPixbuf &g_object_unref
  95     GdkPixbuf>image ;
  96
  97 M: gtk-image image>stream
  98     drop write-image ;