diff --git a/basis/images/images.factor b/basis/images/images.factor index a426c33ddc..08fbdd4e7e 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,16 +1,14 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors grouping sequences combinators -math specialized-arrays.direct.uint byte-arrays fry -specialized-arrays.direct.ushort specialized-arrays.uint -specialized-arrays.ushort specialized-arrays.float ; +USING: combinators kernel ; IN: images -SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR +SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ; : bytes-per-pixel ( component-order -- n ) { + { L [ 1 ] } { BGR [ 3 ] } { RGB [ 3 ] } { BGRA [ 4 ] } @@ -31,71 +29,4 @@ TUPLE: image dim component-order upside-down? bitmap ; : ( -- image ) image new ; inline -GENERIC: load-image* ( path tuple -- image ) - -: add-dummy-alpha ( seq -- seq' ) - 3 [ 255 suffix ] map concat ; - -: normalize-floats ( byte-array -- byte-array ) - byte-array>float-array [ 255.0 * >integer ] B{ } map-as ; - -GENERIC: normalize-component-order* ( image component-order -- image ) - -: normalize-component-order ( image -- image ) - dup component-order>> '[ _ normalize-component-order* ] change-bitmap ; - -M: RGBA normalize-component-order* drop ; - -M: R32G32B32A32 normalize-component-order* - drop normalize-floats ; - -M: R32G32B32 normalize-component-order* - drop normalize-floats add-dummy-alpha ; - -: RGB16>8 ( bitmap -- bitmap' ) - byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline - -M: R16G16B16A16 normalize-component-order* - drop RGB16>8 ; - -M: R16G16B16 normalize-component-order* - drop RGB16>8 add-dummy-alpha ; - -: BGR>RGB ( bitmap -- pixels ) - 3 [ ] map B{ } join ; inline - -: BGRA>RGBA ( bitmap -- pixels ) - 4 - [ unclip-last-slice [ ] dip suffix ] map concat ; inline - -M: BGRA normalize-component-order* - drop BGRA>RGBA ; - -M: RGB normalize-component-order* - drop add-dummy-alpha ; - -M: BGR normalize-component-order* - drop BGR>RGB add-dummy-alpha ; - -: ARGB>RGBA ( bitmap -- bitmap' ) - 4 [ unclip suffix ] map B{ } join ; inline - -M: ARGB normalize-component-order* - drop ARGB>RGBA ; - -M: ABGR normalize-component-order* - drop ARGB>RGBA BGRA>RGBA ; - -: normalize-scan-line-order ( image -- image ) - dup upside-down?>> [ - dup dim>> first 4 * '[ - _ reverse concat - ] change-bitmap - f >>upside-down? - ] when ; - -: normalize-image ( image -- image ) - [ >byte-array ] change-bitmap - normalize-component-order - normalize-scan-line-order - RGBA >>component-order ; +GENERIC: load-image* ( path tuple -- image ) \ No newline at end of file diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 6f2ae47c61..b8bafc021f 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: constructors kernel splitting unicode.case combinators -accessors images.bitmap images.tiff images io.backend +accessors images.bitmap images.tiff images images.normalization io.pathnames ; IN: images.loader diff --git a/basis/images/normalization/authors.txt b/basis/images/normalization/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/images/normalization/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/images/normalization/normalization.factor b/basis/images/normalization/normalization.factor new file mode 100644 index 0000000000..bcdf841b42 --- /dev/null +++ b/basis/images/normalization/normalization.factor @@ -0,0 +1,78 @@ +! Copyright (C) 2009 Doug Coleman +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors grouping sequences combinators +math specialized-arrays.direct.uint byte-arrays fry +specialized-arrays.direct.ushort specialized-arrays.uint +specialized-arrays.ushort specialized-arrays.float images ; +IN: images.normalization + + [ 255 suffix ] map concat ; + +: normalize-floats ( byte-array -- byte-array ) + byte-array>float-array [ 255.0 * >integer ] B{ } map-as ; + +GENERIC: normalize-component-order* ( image component-order -- image ) + +: normalize-component-order ( image -- image ) + dup component-order>> '[ _ normalize-component-order* ] change-bitmap ; + +M: RGBA normalize-component-order* drop ; + +M: R32G32B32A32 normalize-component-order* + drop normalize-floats ; + +M: R32G32B32 normalize-component-order* + drop normalize-floats add-dummy-alpha ; + +: RGB16>8 ( bitmap -- bitmap' ) + byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline + +M: R16G16B16A16 normalize-component-order* + drop RGB16>8 ; + +M: R16G16B16 normalize-component-order* + drop RGB16>8 add-dummy-alpha ; + +: BGR>RGB ( bitmap -- pixels ) + 3 [ ] map B{ } join ; inline + +: BGRA>RGBA ( bitmap -- pixels ) + 4 + [ unclip-last-slice [ ] dip suffix ] map concat ; inline + +M: BGRA normalize-component-order* + drop BGRA>RGBA ; + +M: RGB normalize-component-order* + drop add-dummy-alpha ; + +M: BGR normalize-component-order* + drop BGR>RGB add-dummy-alpha ; + +: ARGB>RGBA ( bitmap -- bitmap' ) + 4 [ unclip suffix ] map B{ } join ; inline + +M: ARGB normalize-component-order* + drop ARGB>RGBA ; + +M: ABGR normalize-component-order* + drop ARGB>RGBA BGRA>RGBA ; + +: normalize-scan-line-order ( image -- image ) + dup upside-down?>> [ + dup dim>> first 4 * '[ + _ reverse concat + ] change-bitmap + f >>upside-down? + ] when ; + +PRIVATE> + +: normalize-image ( image -- image ) + [ >byte-array ] change-bitmap + normalize-component-order + normalize-scan-line-order + RGBA >>component-order ;