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 32R32G32B ;
   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 : normalize-component-order ( image -- image )
  17     dup component-order>>
  18     {
  19         { RGBA [ ] }
  20         { 32R32G32B [
  21             [
  22                 ! >byte-array
  23                 ! dup length 4 /i <direct-uint-array> [ 32 2^ /i ] map
  24                 ! >byte-array
  25                 ! 4 <sliced-groups> le> [ 32 2^ /i ] map concat
  26             ] change-bitmap
  27         ] }
  28         { BGRA [
  29             [
  30                 4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
  31             ] change-bitmap
  32         ] }
  33         { RGB [
  34             [ 3 <sliced-groups> [ 255 suffix ] map concat ] change-bitmap
  35         ] }
  36         { BGR [
  37             [
  38                 3 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
  39                 [ 255 suffix ] map concat
  40             ] change-bitmap
  41         ] }
  42     } case
  43     RGBA >>component-order ;
  44
  45 GENERIC: normalize-scan-line-order ( image -- image )
  46
  47 M: image normalize-scan-line-order ;
  48
  49 : normalize-image ( image -- image )
  50     normalize-component-order
  51     normalize-scan-line-order ;