basis/images/normalization/normalization.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 fry
   5 specialized-arrays.direct.ushort specialized-arrays.uint
   6 specialized-arrays.ushort specialized-arrays.float images ;
   7 IN: images.normalization
   8
   9 <PRIVATE
  10
  11 : add-dummy-alpha ( seq -- seq' )
  12     3 <groups> [ 255 suffix ] map concat ;
  13
  14 : normalize-floats ( byte-array -- byte-array )
  15     byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
  16
  17 GENERIC: normalize-component-order* ( image component-order -- image )
  18
  19 : normalize-component-order ( image -- image )
  20     dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
  21
  22 M: RGBA normalize-component-order* drop ;
  23
  24 M: R32G32B32A32 normalize-component-order*
  25     drop normalize-floats ;
  26
  27 M: R32G32B32 normalize-component-order*
  28     drop normalize-floats add-dummy-alpha ;
  29
  30 : RGB16>8 ( bitmap -- bitmap' )
  31     byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
  32
  33 M: R16G16B16A16 normalize-component-order*
  34     drop RGB16>8 ;
  35
  36 M: R16G16B16 normalize-component-order*
  37     drop RGB16>8 add-dummy-alpha ;
  38
  39 : BGR>RGB ( bitmap -- pixels )
  40     3 <sliced-groups> [ <reversed> ] map B{ } join ; inline
  41
  42 : BGRA>RGBA ( bitmap -- pixels )
  43     4 <sliced-groups>
  44     [ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
  45
  46 M: BGRA normalize-component-order*
  47     drop BGRA>RGBA ;
  48
  49 M: RGB normalize-component-order*
  50     drop add-dummy-alpha ;
  51
  52 M: BGR normalize-component-order*
  53     drop BGR>RGB add-dummy-alpha ;
  54
  55 : ARGB>RGBA ( bitmap -- bitmap' )
  56     4 <groups> [ unclip suffix ] map B{ } join ; inline
  57
  58 M: ARGB normalize-component-order*
  59     drop ARGB>RGBA ;
  60
  61 M: ABGR normalize-component-order*
  62     drop ARGB>RGBA BGRA>RGBA ;
  63
  64 : normalize-scan-line-order ( image -- image )
  65     dup upside-down?>> [
  66         dup dim>> first 4 * '[
  67             _ <groups> reverse concat
  68         ] change-bitmap
  69         f >>upside-down?
  70     ] when ;
  71
  72 PRIVATE>
  73
  74 : normalize-image ( image -- image )
  75     [ >byte-array ] change-bitmap
  76     normalize-component-order
  77     normalize-scan-line-order
  78     RGBA >>component-order ;