Paste: arbitrary color shuffling
Author: | klazuka |
Mode: | factor |
Date: | Wed, 7 Oct 2009 15:20:42 |
Plain Text |
<PRIVATE
CONSTANT: don't-care 3
: permutation
[
swap '[ _ index [ don't-care ] unless* ] { } map-as
4 don't-care pad-tail
] keep length ;
: pad4 4 255 pad-tail ;
: permute
[ name>> [ length ] keep ] [ name>> ] bi*
permutation [ group ] 2dip '[ pad4 _ vshuffle _ head ] map concat ;
: (reorder-colors)
[ permute ] 2curry change-bitmap ;
PRIVATE>
: reorder-colors
[
[ component-type>> ubyte-components assert= ]
[ dup component-order>> ] bi
] dip (reorder-colors) ;
Author: | klazuka |
Mode: | factor |
Date: | Thu, 8 Oct 2009 00:06:18 |
Plain Text |
USING: accessors alien.c-types byte-arrays combinators fry
grouping half-floats images kernel locals math math.vectors
sequences specialized-arrays specialized-arrays.instances.float
specialized-arrays.instances.half
specialized-arrays.instances.uint
specialized-arrays.instances.ushort words ;
FROM: alien.c-types => float ;
IN: images.normalization
<PRIVATE
CONSTANT: don't-care 3
: permutation
swap '[ _ index [ don't-care ] unless* ] { } map-as
4 don't-care pad-tail ;
: pad4 4 255 pad-tail ;
:: permute
[let | src [ src-order name>> ]
dst [ dst-order name>> ] |
bytes src length group
[ pad4 src dst permutation vshuffle dst length head ]
map concat ] ;
: (reorder-colors)
[ permute ] 2curry change-bitmap ;
GENERIC: normalize-component-type*
: normalize-floats
[ 255.0 * >integer ] B{ } map-as ;
M: float-components normalize-component-type*
drop byte-array>float-array normalize-floats ;
M: half-components normalize-component-type*
drop byte-array>half-array normalize-floats ;
: ushorts>ubytes
byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;
M: ubyte-components normalize-component-type*
drop ;
: normalize-scan-line-order
dup upside-down?>> [
dup dim>> first 4 * '[
_ <groups> reverse concat
] change-bitmap
f >>upside-down?
] when ;
PRIVATE>
: reorder-colors
[
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
dup component-order>>
] dip
[ (reorder-colors) ] keep >>component-order ;
: normalize-image
[ >byte-array ] change-bitmap
RGBA reorder-colors
normalize-scan-line-order ;
New Annotation