basis/images/images.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors grouping sequences combinators
   4 math specialized-arrays.direct.uint byte-arrays ;
   5 IN: images
   6
   7 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
   8 R16G16B16 R32G32B32 ;
   9
  10 TUPLE: image dim component-order byte-order bitmap ;
  11
  12 : <image> ( -- image ) image new ; inline
  13
  14 GENERIC: load-image* ( path tuple -- image )
  15
  16 : add-dummy-alpha ( seq -- seq' )
  17     3 <sliced-groups>
  18     [ 255 suffix ] map concat ;
  19
  20 : normalize-component-order ( image -- image )
  21     dup component-order>>
  22     {
  23         { RGBA [ ] }
  24         { R32G32B32 [
  25             [
  26                 dup length 4 / <direct-uint-array>
  27                 [ bits>float 255.0 * >integer ] map
  28                 >byte-array add-dummy-alpha
  29             ] change-bitmap
  30         ] }
  31         { BGRA [
  32             [
  33                 4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
  34             ] change-bitmap
  35         ] }
  36         { RGB [ [ add-dummy-alpha ] change-bitmap ] }
  37         { BGR [
  38             [
  39                 3 <sliced-groups>
  40                 [ [ [ 0 3 ] dip <slice> reverse-here ] each ]
  41                 [ add-dummy-alpha ] bi
  42             ] change-bitmap
  43         ] }
  44     } case
  45     RGBA >>component-order ;
  46
  47 GENERIC: normalize-scan-line-order ( image -- image )
  48
  49 M: image normalize-scan-line-order ;
  50
  51 : normalize-image ( image -- image )
  52     [ >byte-array ] change-bitmap
  53     normalize-component-order
  54     normalize-scan-line-order ;