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 ;
9 SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
10 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
12 : bytes-per-pixel ( component-order -- n )
26 { R16G16B16A16 [ 8 ] }
27 { R32G32B32A32 [ 16 ] }
30 TUPLE: image dim component-order bitmap ;
32 : <image> ( -- image ) image new ; inline
34 GENERIC: load-image* ( path tuple -- image )
36 : add-dummy-alpha ( seq -- seq' )
37 3 <groups> [ 255 suffix ] map concat ;
39 : normalize-floats ( byte-array -- byte-array )
40 byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
42 GENERIC: normalize-component-order* ( image component-order -- image )
44 : normalize-component-order ( image -- image )
45 dup component-order>> '[ _ normalize-component-order* ] change-bitmap
46 RGBA >>component-order ;
48 M: RGBA normalize-component-order* drop ;
50 M: R32G32B32A32 normalize-component-order*
51 drop normalize-floats ;
53 M: R32G32B32 normalize-component-order*
54 drop normalize-floats add-dummy-alpha ;
56 : RGB16>8 ( bitmap -- bitmap' )
57 byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
59 M: R16G16B16A16 normalize-component-order*
62 M: R16G16B16 normalize-component-order*
63 drop RGB16>8 add-dummy-alpha ;
65 : BGR>RGB ( bitmap bytes-per-pixel -- pixels )
66 <groups> [ 3 cut [ reverse ] dip append ] map B{ } join ; inline
68 M: BGRA normalize-component-order*
71 M: RGB normalize-component-order*
72 drop add-dummy-alpha ;
74 M: BGR normalize-component-order*
75 drop 3 BGR>RGB add-dummy-alpha ;
77 : ARGB>RGBA ( bitmap -- bitmap' )
78 4 <groups> [ unclip suffix ] map B{ } join ;
80 M: ARGB normalize-component-order*
83 M: ABGR normalize-component-order*
84 drop ARGB>RGBA 4 BGR>RGB ;
86 GENERIC: normalize-scan-line-order ( image -- image )
88 M: image normalize-scan-line-order ;
90 : normalize-image ( image -- image )
91 [ >byte-array ] change-bitmap
92 normalize-component-order
93 normalize-scan-line-order ;