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 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 TUPLE: image dim component-order bitmap ;
14 : <image> ( -- image ) image new ; inline
16 GENERIC: load-image* ( path tuple -- image )
18 : add-dummy-alpha ( seq -- seq' )
20 [ 255 suffix ] map concat ;
22 : normalize-floats ( byte-array -- byte-array )
23 byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
25 : normalize-component-order ( image -- image )
30 [ normalize-floats ] change-bitmap
33 [ normalize-floats add-dummy-alpha ] change-bitmap
36 [ byte-array>ushort-array [ -8 shift ] B{ } map-as ] change-bitmap
40 byte-array>ushort-array [ -8 shift ] B{ } map-as add-dummy-alpha
45 4 <sliced-groups> dup [ 3 head-slice reverse-here ] each
48 { RGB [ [ add-dummy-alpha ] change-bitmap ] }
52 [ [ 3 head-slice reverse-here ] each ]
53 [ add-dummy-alpha ] bi
57 RGBA >>component-order ;
59 GENERIC: normalize-scan-line-order ( image -- image )
61 M: image normalize-scan-line-order ;
63 : normalize-image ( image -- image )
64 [ >byte-array ] change-bitmap
65 normalize-component-order
66 normalize-scan-line-order ;