steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

images.normalization: refactored to use locals

db4
Keith Lazuka 2009-10-07 15:11:33 -04:00
parent 3763ea29d0
commit 392531b179
1 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/images/normalization/normalization.factor
View File

@ -1,8 +1,8 @@
! 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: accessors alien.c-types byte-arrays combinators fry USING: accessors alien.c-types byte-arrays combinators fry
grouping half-floats images kernel math math.vectors sequences grouping half-floats images kernel locals math math.vectors
specialized-arrays specialized-arrays.instances.float sequences specialized-arrays specialized-arrays.instances.float
specialized-arrays.instances.half specialized-arrays.instances.half
specialized-arrays.instances.uint specialized-arrays.instances.uint
specialized-arrays.instances.ushort words ; specialized-arrays.instances.ushort words ;
@ -13,17 +13,18 @@ IN: images.normalization
CONSTANT: don't-care 3 CONSTANT: don't-care 3
: permutation ( src dst -- seq n ) : permutation ( src dst -- seq )
[
swap '[ _ index [ don't-care ] unless* ] { } map-as swap '[ _ index [ don't-care ] unless* ] { } map-as
4 don't-care pad-tail 4 don't-care pad-tail ;
] keep length ;
: pad4 ( seq -- newseq ) 4 255 pad-tail ; : pad4 ( seq -- newseq ) 4 255 pad-tail ;
: permute ( byte-array src-order dst-order -- byte-array ) :: permute ( bytes src-order dst-order -- new-bytes )
[ name>> [ length ] keep ] [ name>> ] bi* [let | src [ src-order name>> ]
permutation [ group ] 2dip '[ pad4 _ vshuffle _ head ] map concat ; dst [ dst-order name>> ] |
bytes src length group
[ pad4 src dst permutation vshuffle dst length head ]
map concat ] ;
: (reorder-colors) ( image src-order dest-order -- image ) : (reorder-colors) ( image src-order dest-order -- image )
[ permute ] 2curry change-bitmap ; [ permute ] 2curry change-bitmap ;