images.normalization: more unit tests and bug fix

diff --git a/extra/images/normalization/normalization-docs.factor b/extra/images/normalization/normalization-docs.factor
index 34c5d8fb445298a457fb786243070946d08b1de8..8b78d7a51f6238613142b5c7e66e843d461c0ee6 100644 (file)
--- a/extra/images/normalization/normalization-docs.factor
+++ b/extra/images/normalization/normalization-docs.factor
@@ -21,7 +21,7 @@ HELP: reorder-colors
 ARTICLE: "images.normalization" "Image normalization"
 "The " { $vocab-link "images.normalization" } " vocab can be used to convert between " { $link image } " representations."
 $nl
-"You can normalize any image to RGBA with ubyte-components:"
+"You can normalize any image to a RGBA with ubyte-components representation:"
 { $subsections normalize-image }
 "Convert an image's pixel layout to match an arbitrary " { $link component-order } ":"
 { $subsections reorder-colors } ;

diff --git a/extra/images/normalization/normalization-tests.factor b/extra/images/normalization/normalization-tests.factor
index 70bdf4fd3205c9e46a06f378296dc7e8d2b98a10..4fd49c5490bbfe7d324446707455de621d6e5d76 100644 (file)
--- a/extra/images/normalization/normalization-tests.factor
+++ b/extra/images/normalization/normalization-tests.factor
@@ -4,93 +4,73 @@ USING: images images.normalization images.normalization.private
 sequences tools.test ;
 IN: images.normalization.tests
 
-! R
+! 1>x
 
-[ 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 255 } ]
+[ B{ 0 1 } A L permute ] unit-test
 
-[ B{ 255 0 255 255 255 1 255 255 } ]
-[ B{ 0 1 } R ARGB permute ] unit-test
+[ B{ 255 255 255 255 } ]
+[ B{ 0 1 } A RG permute ] unit-test
 
-! RGB
+[ B{ 255 255 255 255 255 255 } ]
+[ B{ 0 1 } A BGR permute ] unit-test
 
-[ 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 3 4 5 } RGB RGBA permute ] unit-test
-
-[ B{ 2 1 0 5 4 3 } ]
-[ B{ 0 1 2 3 4 5 } RGB BGR permute ] unit-test
-
-[ B{ 2 1 0 255 5 4 3 255 } ]
-[ B{ 0 1 2 3 4 5 } RGB BGRA permute ] unit-test
+[ B{ 0 255 255 255 1 255 255 255 } ]
+[ B{ 0 1 } A ABGR permute ] unit-test
 
-[ B{ 255 0 1 2 255 3 4 5 } ]
-[ B{ 0 1 2 3 4 5 } RGB ARGB permute ] unit-test
+! 2>x
 
-! RGBA
+[ B{ 0 2 } ]
+[ B{ 0 1 2 3 } LA L permute ] unit-test
 
-[ B{ 0 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA R permute ] unit-test
+[ B{ 255 255 255 255 } ]
+[ B{ 0 1 2 3 } LA RG permute ] unit-test
 
-[ B{ 0 1 2 4 5 6 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA RGB permute ] unit-test
+[ B{ 255 255 255 255 255 255 } ]
+[ B{ 0 1 2 3 } LA BGR permute ] unit-test
 
-[ B{ 2 1 0 6 5 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA BGR permute ] unit-test
+[ B{ 1 255 255 255 3 255 255 255 } ]
+[ B{ 0 1 2 3 } LA ABGR permute ] unit-test
 
-[ B{ 2 1 0 3 6 5 4 7 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA BGRA permute ] unit-test
+! 3>x
 
-[ B{ 3 0 1 2 7 4 5 6 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA ARGB permute ] unit-test
+[ B{ 255 255 } ]
+[ B{ 0 1 2 3 4 5 } RGB L permute ] unit-test
 
-! BGR
+[ B{ 0 1 3 4 } ]
+[ B{ 0 1 2 3 4 5 } RGB RG permute ] unit-test
 
 [ B{ 2 1 0 5 4 3 } ]
-[ B{ 0 1 2 3 4 5 } BGR RGB permute ] unit-test
-
-[ B{ 2 1 0 255 5 4 3 255 } ]
-[ 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 3 4 5 } BGR BGRA permute ] unit-test
+[ B{ 0 1 2 3 4 5 } RGB BGR permute ] unit-test
 
 [ B{ 255 2 1 0 255 5 4 3 } ]
-[ B{ 0 1 2 3 4 5 } BGR ARGB permute ] unit-test
+[ B{ 0 1 2 3 4 5 } RGB ABGR permute ] unit-test
 
-! BGRA
+! 4>x
 
-[ B{ 2 1 0 6 5 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } BGRA RGB permute ] unit-test
+[ B{ 255 255 } ]
+[ B{ 0 1 2 3 4 5 6 7 } RGBA L permute ] unit-test
 
-[ B{ 0 1 2 4 5 6 } ]
-[ B{ 0 1 2 3 4 5 6 7 } BGRA BGR permute ] unit-test
+[ B{ 0 1 4 5 } ]
+[ B{ 0 1 2 3 4 5 6 7 } RGBA RG permute ] unit-test
 
-[ B{ 2 1 0 3 6 5 4 7 } ]
-[ B{ 0 1 2 3 4 5 6 7 } BGRA RGBA permute ] unit-test
+[ B{ 2 1 0 6 5 4 } ]
+[ B{ 0 1 2 3 4 5 6 7 } RGBA BGR permute ] unit-test
 
 [ B{ 3 2 1 0 7 6 5 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } BGRA ARGB permute ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } RGBA ABGR permute ] unit-test
 
-! ARGB
+! A little ad hoc testing
 
-[ B{ 1 2 3 5 6 7 } ]
-[ B{ 0 1 2 3 4 5 6 7 } ARGB RGB permute ] unit-test
+[ B{ 0 4 } ]
+[ B{ 0 1 2 3 4 5 6 7 } RGBA R permute ] unit-test
 
-[ B{ 3 2 1 7 6 5 } ]
-[ B{ 0 1 2 3 4 5 6 7 } ARGB BGR permute ] unit-test
+[ B{ 255 0 1 2 255 4 5 6 } ]
+[ B{ 0 1 2 3 4 5 6 7 } RGBA XRGB permute ] unit-test
 
-[ B{ 3 2 1 0 7 6 5 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } ARGB BGRA permute ] unit-test
+[ B{ 1 2 3 255 5 6 7 255 } ]
+[ B{ 0 1 2 3 4 5 6 7 } XRGB RGBA permute ] unit-test
 
-[ B{ 1 2 3 0 5 6 7 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } ARGB RGBA permute ] unit-test
+[ B{ 255 255 255 255 255 255 255 255 } ]
+[ B{ 0 1 } L RGBA permute ] unit-test
 

diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor
index b60ed516b90dfe0be6105e6a79a2c2072ed7cd27..aadd4763ac37ff68b12c97f05c66118129806555 100755 (executable)
--- a/extra/images/normalization/normalization.factor
+++ b/extra/images/normalization/normalization.factor
@@ -11,19 +11,25 @@ IN: images.normalization
 
 <PRIVATE
 
-CONSTANT: don't-care 3
+CONSTANT: don't-care 127
+CONSTANT: fill-value 255
 
 : permutation ( src dst -- seq )
     swap '[ _ index [ don't-care ] unless* ] { } map-as
     4 don't-care pad-tail ;
 
-: pad4 ( seq -- newseq ) 4 255 pad-tail ;
+: pad4 ( seq -- newseq ) 4 fill-value pad-tail ;
+
+: shuffle ( seq permutation -- newseq )
+    swap '[
+        dup 4 >= [ drop fill-value ] [ _ nth ] if
+    ] B{ } map-as ;
 
 :: permute ( bytes src-order dst-order -- new-bytes )
     [let | src [ src-order name>> ]
            dst [ dst-order name>> ] |
         bytes src length group
-        [ pad4 src dst permutation vshuffle dst length head ]
+        [ pad4 src dst permutation shuffle dst length head ]
         map concat ] ;
 
 : (reorder-colors) ( image src-order dest-order -- image )