images.normalization: removed a lot of boilerplate
Keith Lazuka
parent
f60bcc7dc1
commit
bf42c83690
|
|
@ -1,76 +1,95 @@
|
||||||
! BSD License. Copyright 2009 Keith Lazuka
|
! BSD License. Copyright 2009 Keith Lazuka
|
||||||
USING: images.normalization images.normalization.private
|
USING: images images.normalization images.normalization.private
|
||||||
sequences tools.test ;
|
sequences tools.test ;
|
||||||
IN: images.normalization.tests
|
IN: images.normalization.tests
|
||||||
|
|
||||||
|
! R
|
||||||
|
|
||||||
|
[ B{ 0 255 255 255 1 255 255 255 } ]
|
||||||
|
[ B{ 0 1 } R RGBA permute ] unit-test
|
||||||
|
|
||||||
|
[ B{ 255 255 0 255 255 1 } ]
|
||||||
|
[ B{ 0 1 } R BGR permute ] unit-test
|
||||||
|
|
||||||
|
[ B{ 255 255 0 255 255 255 1 255 } ]
|
||||||
|
[ B{ 0 1 } R BGRA permute ] unit-test
|
||||||
|
|
||||||
|
[ B{ 255 0 255 255 255 1 255 255 } ]
|
||||||
|
[ B{ 0 1 } R ARGB permute ] unit-test
|
||||||
|
|
||||||
! RGB
|
! RGB
|
||||||
|
|
||||||
|
[ B{ 0 3 } ]
|
||||||
|
[ B{ 0 1 2 3 4 5 } RGB R permute ] unit-test
|
||||||
|
|
||||||
[ B{ 0 1 2 255 3 4 5 255 } ]
|
[ B{ 0 1 2 255 3 4 5 255 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } RGB>RGBA ] unit-test
|
[ B{ 0 1 2 3 4 5 } RGB RGBA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 5 4 3 } ]
|
[ B{ 2 1 0 5 4 3 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } RGB>BGR ] unit-test
|
[ B{ 0 1 2 3 4 5 } RGB BGR permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 255 5 4 3 255 } ]
|
[ B{ 2 1 0 255 5 4 3 255 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } RGB>BGRA ] unit-test
|
[ B{ 0 1 2 3 4 5 } RGB BGRA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 255 0 1 2 255 3 4 5 } ]
|
[ B{ 255 0 1 2 255 3 4 5 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } RGB>ARGB ] unit-test
|
[ B{ 0 1 2 3 4 5 } RGB ARGB permute ] unit-test
|
||||||
|
|
||||||
! RGBA
|
! RGBA
|
||||||
|
|
||||||
|
[ B{ 0 4 } ]
|
||||||
|
[ B{ 0 1 2 3 4 5 6 7 } RGBA R permute ] unit-test
|
||||||
|
|
||||||
[ B{ 0 1 2 4 5 6 } ]
|
[ B{ 0 1 2 4 5 6 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>RGB ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } RGBA RGB permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 6 5 4 } ]
|
[ B{ 2 1 0 6 5 4 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGR ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } RGBA BGR permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 3 6 5 4 7 } ]
|
[ B{ 2 1 0 3 6 5 4 7 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGRA ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } RGBA BGRA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 3 0 1 2 7 4 5 6 } ]
|
[ B{ 3 0 1 2 7 4 5 6 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } RGBA>ARGB ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } RGBA ARGB permute ] unit-test
|
||||||
|
|
||||||
! BGR
|
! BGR
|
||||||
|
|
||||||
[ B{ 2 1 0 5 4 3 } ]
|
[ B{ 2 1 0 5 4 3 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } BGR>RGB ] unit-test
|
[ B{ 0 1 2 3 4 5 } BGR RGB permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 255 5 4 3 255 } ]
|
[ B{ 2 1 0 255 5 4 3 255 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } BGR>RGBA ] unit-test
|
[ B{ 0 1 2 3 4 5 } BGR RGBA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 0 1 2 255 3 4 5 255 } ]
|
[ B{ 0 1 2 255 3 4 5 255 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } BGR>BGRA ] unit-test
|
[ B{ 0 1 2 3 4 5 } BGR BGRA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 255 2 1 0 255 5 4 3 } ]
|
[ B{ 255 2 1 0 255 5 4 3 } ]
|
||||||
[ B{ 0 1 2 3 4 5 } BGR>ARGB ] unit-test
|
[ B{ 0 1 2 3 4 5 } BGR ARGB permute ] unit-test
|
||||||
|
|
||||||
! BGRA
|
! BGRA
|
||||||
|
|
||||||
[ B{ 2 1 0 6 5 4 } ]
|
[ B{ 2 1 0 6 5 4 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGB ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } BGRA RGB permute ] unit-test
|
||||||
|
|
||||||
[ B{ 0 1 2 4 5 6 } ]
|
[ B{ 0 1 2 4 5 6 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>BGR ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } BGRA BGR permute ] unit-test
|
||||||
|
|
||||||
[ B{ 2 1 0 3 6 5 4 7 } ]
|
[ B{ 2 1 0 3 6 5 4 7 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGBA ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } BGRA RGBA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 3 2 1 0 7 6 5 4 } ]
|
[ B{ 3 2 1 0 7 6 5 4 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } BGRA>ARGB ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } BGRA ARGB permute ] unit-test
|
||||||
|
|
||||||
! ARGB
|
! ARGB
|
||||||
|
|
||||||
[ B{ 1 2 3 5 6 7 } ]
|
[ B{ 1 2 3 5 6 7 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGB ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } ARGB RGB permute ] unit-test
|
||||||
|
|
||||||
[ B{ 3 2 1 7 6 5 } ]
|
[ B{ 3 2 1 7 6 5 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGR ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } ARGB BGR permute ] unit-test
|
||||||
|
|
||||||
[ B{ 3 2 1 0 7 6 5 4 } ]
|
[ B{ 3 2 1 0 7 6 5 4 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGRA ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } ARGB BGRA permute ] unit-test
|
||||||
|
|
||||||
[ B{ 1 2 3 0 5 6 7 4 } ]
|
[ B{ 1 2 3 0 5 6 7 4 } ]
|
||||||
[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGBA ] unit-test
|
[ B{ 0 1 2 3 4 5 6 7 } ARGB RGBA permute ] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,120 +1,37 @@
|
||||||
! Copyright (C) 2009 Doug Coleman, Keith Lazuka
|
! Copyright (C) 2009 Doug Coleman, Keith Lazuka
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types kernel accessors grouping sequences
|
USING: accessors alien.c-types byte-arrays combinators fry
|
||||||
combinators math byte-arrays fry images half-floats
|
grouping half-floats images kernel math math.vectors sequences
|
||||||
specialized-arrays words ;
|
specialized-arrays specialized-arrays.instances.float
|
||||||
|
specialized-arrays.instances.half
|
||||||
|
specialized-arrays.instances.uint
|
||||||
|
specialized-arrays.instances.ushort words ;
|
||||||
FROM: alien.c-types => float ;
|
FROM: alien.c-types => float ;
|
||||||
SPECIALIZED-ARRAY: uint
|
|
||||||
SPECIALIZED-ARRAY: ushort
|
|
||||||
SPECIALIZED-ARRAY: float
|
|
||||||
SPECIALIZED-ARRAY: half
|
|
||||||
IN: images.normalization
|
IN: images.normalization
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
! Helpers
|
CONSTANT: don't-care 3
|
||||||
: add-dummy-alpha ( seq -- seq' )
|
|
||||||
3 <groups> [ 255 suffix ] map concat ;
|
|
||||||
|
|
||||||
: normalize-floats ( float-array -- byte-array )
|
: permutation ( src dst -- seq n )
|
||||||
[ 255.0 * >integer ] B{ } map-as ;
|
|
||||||
|
|
||||||
: fix-XBGR ( bitmap -- bitmap' )
|
|
||||||
dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
|
|
||||||
|
|
||||||
: fix-BGRX ( bitmap -- bitmap' )
|
|
||||||
dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
|
|
||||||
|
|
||||||
! Bitmap Conversions
|
|
||||||
|
|
||||||
! TODO RGBX, XRGB, BGRX, XBGR conversions
|
|
||||||
|
|
||||||
: BGR>BGR ( bitmap -- bitmap' ) ;
|
|
||||||
|
|
||||||
: BGR>RGB ( bitmap -- bitmap' )
|
|
||||||
3 <sliced-groups> [ <reversed> ] map concat ; inline
|
|
||||||
|
|
||||||
: BGR>BGRA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
|
|
||||||
|
|
||||||
: BGR>RGBA ( bitmap -- bitmap' ) BGR>RGB add-dummy-alpha ; inline
|
|
||||||
|
|
||||||
: BGR>ARGB ( bitmap -- bitmap' )
|
|
||||||
3 <sliced-groups> [ 255 suffix <reversed> ] map concat ; inline
|
|
||||||
|
|
||||||
: BGRA>BGRA ( bitmap -- bitmap' ) ;
|
|
||||||
|
|
||||||
: BGRA>BGR ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ but-last-slice ] map concat ; inline
|
|
||||||
|
|
||||||
: BGRA>RGBA ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups>
|
|
||||||
[ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
|
|
||||||
|
|
||||||
: BGRA>RGB ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ but-last-slice <reversed> ] map concat ; inline
|
|
||||||
|
|
||||||
: BGRA>ARGB ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ <reversed> ] map concat ; inline
|
|
||||||
|
|
||||||
: RGB>RGB ( bitmap -- bitmap' ) ;
|
|
||||||
|
|
||||||
: RGB>BGR ( bitmap -- bitmap' ) BGR>RGB ; inline
|
|
||||||
|
|
||||||
: RGB>RGBA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
|
|
||||||
|
|
||||||
: RGB>BGRA ( bitmap -- bitmap' )
|
|
||||||
3 <sliced-groups> [ <reversed> add-dummy-alpha ] map concat ; inline
|
|
||||||
|
|
||||||
: RGB>ARGB ( bitmap -- bitmap' )
|
|
||||||
3 <sliced-groups> [ 255 prefix ] map concat ; inline
|
|
||||||
|
|
||||||
: RGBA>RGBA ( bitmap -- bitmap' ) ;
|
|
||||||
|
|
||||||
: RGBA>BGR ( bitmap -- bitmap' ) BGRA>RGB ; inline
|
|
||||||
|
|
||||||
: RGBA>BGRA ( bitmap -- bitmap' ) BGRA>RGBA ; inline
|
|
||||||
|
|
||||||
: RGBA>RGB ( bitmap -- bitmap' ) BGRA>BGR ; inline
|
|
||||||
|
|
||||||
: RGBA>ARGB ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ unclip-last-slice prefix ] map concat ; inline
|
|
||||||
|
|
||||||
: ARGB>ARGB ( bitmap -- bitmap' ) ;
|
|
||||||
|
|
||||||
: ARGB>RGB ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ rest-slice ] map concat ; inline
|
|
||||||
|
|
||||||
: ARGB>RGBA ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ unclip-slice suffix ] map concat ; inline
|
|
||||||
|
|
||||||
: ARGB>BGR ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups> [ rest-slice <reversed> ] map concat ; inline
|
|
||||||
|
|
||||||
: ARGB>BGRA ( bitmap -- bitmap' )
|
|
||||||
4 <sliced-groups>
|
|
||||||
[ unclip-slice [ <reversed> ] dip suffix ] map concat ; inline
|
|
||||||
|
|
||||||
: (reorder-colors) ( image src-order des-order -- image )
|
|
||||||
[ name>> ] bi@ ">" glue "images.normalization.private" lookup
|
|
||||||
[ '[ _ execute( image -- image' ) ] change-bitmap ]
|
|
||||||
[ "No component-order conversion found." throw ]
|
|
||||||
if* ;
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: reorder-colors ( image component-order -- image )
|
|
||||||
[
|
[
|
||||||
[ component-type>> ubyte-components assert= ]
|
swap '[ _ index [ don't-care ] unless* ] { } map-as
|
||||||
[ dup component-order>> ] bi
|
4 don't-care pad-tail
|
||||||
] dip (reorder-colors) ;
|
] keep length ;
|
||||||
|
|
||||||
<PRIVATE
|
: pad4 ( seq -- newseq ) 4 255 pad-tail ;
|
||||||
|
|
||||||
|
: permute ( byte-array src-order dst-order -- byte-array )
|
||||||
|
[ name>> [ length ] keep ] [ name>> ] bi*
|
||||||
|
permutation [ group ] 2dip '[ pad4 _ vshuffle _ head ] map concat ;
|
||||||
|
|
||||||
|
: (reorder-colors) ( image src-order dest-order -- image )
|
||||||
|
[ permute ] 2curry change-bitmap ;
|
||||||
|
|
||||||
GENERIC: normalize-component-type* ( image component-type -- image )
|
GENERIC: normalize-component-type* ( image component-type -- image )
|
||||||
|
|
||||||
: normalize-component-order ( image -- image )
|
: normalize-floats ( float-array -- byte-array )
|
||||||
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
|
[ 255.0 * >integer ] B{ } map-as ;
|
||||||
RGBA reorder-colors ;
|
|
||||||
|
|
||||||
M: float-components normalize-component-type*
|
M: float-components normalize-component-type*
|
||||||
drop byte-array>float-array normalize-floats ;
|
drop byte-array>float-array normalize-floats ;
|
||||||
|
|
@ -141,9 +58,15 @@ M: ubyte-components normalize-component-type*
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
: reorder-colors ( image component-order -- image )
|
||||||
|
[
|
||||||
|
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
|
||||||
|
dup component-order>>
|
||||||
|
] dip
|
||||||
|
[ (reorder-colors) ] keep >>component-order ;
|
||||||
|
|
||||||
: normalize-image ( image -- image )
|
: normalize-image ( image -- image )
|
||||||
[ >byte-array ] change-bitmap
|
[ >byte-array ] change-bitmap
|
||||||
normalize-component-order
|
RGBA reorder-colors
|
||||||
normalize-scan-line-order
|
normalize-scan-line-order ;
|
||||||
RGBA >>component-order ;
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue