From 155ede5ad7b6f37e6739b7db9e3ddfc904134a78 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 1 May 2010 18:37:59 -0500
Subject: [PATCH] Fix normalization to take stride/padding bytes into account

---
 .../normalization/normalization-tests.factor  | 55 ++++++++++++-------
 .../images/normalization/normalization.factor | 16 ++++--
 2 files changed, 46 insertions(+), 25 deletions(-)

diff --git a/basis/images/normalization/normalization-tests.factor b/basis/images/normalization/normalization-tests.factor
index c85aed413f..3dd270f2c2 100644
--- a/basis/images/normalization/normalization-tests.factor
+++ b/basis/images/normalization/normalization-tests.factor
@@ -7,72 +7,87 @@ IN: images.normalization.tests
 ! 1>x
 
 [ B{ 255 255 } ]
-[ B{ 0 1 } A L permute ] unit-test
+[ B{ 0 1 } 2 2 A L permute ] unit-test
 
 [ B{ 255 255 255 255 } ]
-[ B{ 0 1 } A RG permute ] unit-test
+[ B{ 0 1 } 2 2 A RG permute ] unit-test
 
 [ B{ 255 255 255 255 255 255 } ]
-[ B{ 0 1 } A BGR permute ] unit-test
+[ B{ 0 1 } 2 2 A BGR permute ] unit-test
 
 [ B{ 0 255 255 255 1 255 255 255 } ]
-[ B{ 0 1 } A ABGR permute ] unit-test
+[ B{ 0 1 } 2 2 A ABGR permute ] unit-test
+
+! Difference stride
+! The last byte is padding, so it should not end up in the image
+
+[ B{ 255 255 } ]
+[ B{ 0 1 0 } 2 3 A L permute ] unit-test
+
+[ B{ 255 255 255 255 } ]
+[ B{ 0 1 0 } 2 3 A RG permute ] unit-test
+
+[ B{ 255 255 255 255 255 255 } ]
+[ B{ 0 1 0 } 2 3 A BGR permute ] unit-test
+
+[ B{ 0 255 255 255 1 255 255 255 } ]
+[ B{ 0 1 0 } 2 3 A ABGR permute ] unit-test
 
 ! 2>x
 
 [ B{ 0 2 } ]
-[ B{ 0 1 2 3 } LA L permute ] unit-test
+[ B{ 0 1 2 3 } 2 4 LA L permute ] unit-test
 
 [ B{ 255 255 255 255 } ]
-[ B{ 0 1 2 3 } LA RG permute ] unit-test
+[ B{ 0 1 2 3 } 2 4 LA RG permute ] unit-test
 
 [ B{ 255 255 255 255 255 255 } ]
-[ B{ 0 1 2 3 } LA BGR permute ] unit-test
+[ B{ 0 1 2 3 } 2 4 LA BGR permute ] unit-test
 
 [ B{ 1 255 255 255 3 255 255 255 } ]
-[ B{ 0 1 2 3 } LA ABGR permute ] unit-test
+[ B{ 0 1 2 3 } 2 4 LA ABGR permute ] unit-test
 
 ! 3>x
 
 [ B{ 255 255 } ]
-[ B{ 0 1 2 3 4 5 } RGB L permute ] unit-test
+[ B{ 0 1 2 3 4 5 } 2 6 RGB L permute ] unit-test
 
 [ B{ 0 1 3 4 } ]
-[ B{ 0 1 2 3 4 5 } RGB RG permute ] unit-test
+[ B{ 0 1 2 3 4 5 } 2 6 RGB RG permute ] unit-test
 
 [ B{ 2 1 0 5 4 3 } ]
-[ B{ 0 1 2 3 4 5 } RGB BGR permute ] unit-test
+[ B{ 0 1 2 3 4 5 } 2 6 RGB BGR permute ] unit-test
 
 [ B{ 255 2 1 0 255 5 4 3 } ]
-[ B{ 0 1 2 3 4 5 } RGB ABGR permute ] unit-test
+[ B{ 0 1 2 3 4 5 } 2 6 RGB ABGR permute ] unit-test
 
 ! 4>x
 
 [ B{ 255 255 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA L permute ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } 2 8 RGBA L permute ] unit-test
 
 [ B{ 0 1 4 5 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA RG permute ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } 2 8 RGBA RG 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{ 0 1 2 3 4 5 6 7 } 2 8 RGBA BGR permute ] unit-test
 
 [ B{ 3 2 1 0 7 6 5 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA ABGR permute ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } 2 8 RGBA ABGR permute ] unit-test
 
 ! Edge cases
 
 [ B{ 0 4 } ]
-[ B{ 0 1 2 3 4 5 6 7 } RGBA R permute ] unit-test
+[ B{ 0 1 2 3 4 5 6 7 } 2 8 RGBA R 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{ 0 1 2 3 4 5 6 7 } 2 8 RGBA XRGB 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{ 0 1 2 3 4 5 6 7 } 2 8 XRGB RGBA permute ] unit-test
 
 [ B{ 255 255 255 255 255 255 255 255 } ]
-[ B{ 0 1 } L RGBA permute ] unit-test
+[ B{ 0 1 } 2 2 L RGBA permute ] unit-test
 
 ! Invalid inputs
 
diff --git a/basis/images/normalization/normalization.factor b/basis/images/normalization/normalization.factor
index db68e4bad6..a73de4f7b8 100644
--- a/basis/images/normalization/normalization.factor
+++ b/basis/images/normalization/normalization.factor
@@ -25,15 +25,21 @@ CONSTANT: fill-value 255
         dup 4 >= [ drop fill-value ] [ _ nth ] if
     ] B{ } map-as ;
 
-:: permute ( bytes src-order dst-order -- new-bytes )
+:: permute ( bytes width stride src-order dst-order -- new-bytes )
     src-order name>> :> src
     dst-order name>> :> dst
-    bytes src length group
-    [ pad4 src dst permutation shuffle dst length head ]
-    map concat ;
+    bytes stride group
+    [
+        src length group width head
+        [ pad4 src dst permutation shuffle dst length head ] map concat
+    ] map concat ;
+
+: stride ( image -- n )
+    [ bitmap>> length ] [ dim>> second ] bi / ;
 
 : (reorder-components) ( image src-order dest-order -- image )
-    [ permute ] 2curry change-bitmap ;
+    [ [ ] [ dim>> first ] [ stride ] tri ] 2dip
+    '[ _ _ _ _ permute ] change-bitmap ;
 
 GENERIC: normalize-component-type* ( image component-type -- image )