images.normalization: reorder-components should fail if component-order is not a representation of its layout

basis/images/bitmap/bitmap.factor

@@ -64,5 +64,5 @@ SINGLETON: bmp-image
     ] bi ;
 
 M: bmp-image image>stream
-    drop BGR reorder-colors output-bmp ;
+    drop BGR reorder-components output-bmp ;
 

extra/images/normalization/normalization-docs.factor

@@ -10,13 +10,15 @@ HELP: normalize-image
 }
 { $description "Converts the image to RGBA with ubyte-components. If the image is upside-down, it will be flipped right side up such that the 1st byte in the bitmap slot's byte array corresponds to the first color component of the pixel in the upper-left corner of the image." } ;
 
-HELP: reorder-colors
+HELP: reorder-components
 { $values
     { "image" image } { "component-order" component-order }
     { "image" image }
 }
 { $description "Convert the bitmap in " { $snippet "image" } " such that the pixel sample layout corresponds to " { $snippet "component-order" } ". If the destination layout cannot find a corresponding value from the source layout, the value " { $snippet "255" } " will be substituted for that byte." }
-{ $warning "The image's " { $snippet "component-type" } " will be changed to " { $snippet "ubyte-components" } " if it is not already in that format." } ;
+{ $warning "The image's " { $snippet "component-type" } " will be changed to " { $snippet "ubyte-components" } " if it is not already in that format."
+$nl
+"You cannot use this word to reorder " { $link DEPTH } ", " { $link DEPTH-STENCIL } " or " { $link INTENSITY } " component orders." } ;
 
 ARTICLE: "images.normalization" "Image normalization"
 "The " { $vocab-link "images.normalization" } " vocab can be used to convert between " { $link image } " representations."
@@ -24,6 +26,6 @@ $nl
 "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 } ;
+{ $subsections reorder-components } ;
 
 ABOUT: "images.normalization"

extra/images/normalization/normalization-tests.factor

@@ -60,7 +60,7 @@ IN: images.normalization.tests
 [ B{ 3 2 1 0 7 6 5 4 } ]
 [ B{ 0 1 2 3 4 5 6 7 } RGBA ABGR permute ] unit-test
 
-! A little ad hoc testing
+! Edge cases
 
 [ B{ 0 4 } ]
 [ B{ 0 1 2 3 4 5 6 7 } RGBA R permute ] unit-test
@@ -74,3 +74,35 @@ IN: images.normalization.tests
 [ B{ 255 255 255 255 255 255 255 255 } ]
 [ B{ 0 1 } L RGBA permute ] unit-test
 
+! Invalid inputs
+
+[
+    T{ image f { 1 1 } DEPTH ubyte-components f B{ 0 } }
+    RGB reorder-components
+] must-fail
+
+[
+    T{ image f { 1 1 } DEPTH-STENCIL ubyte-components f B{ 0 } }
+    RGB reorder-components
+] must-fail
+
+[
+    T{ image f { 1 1 } INTENSITY ubyte-components f B{ 0 } }
+    RGB reorder-components
+] must-fail
+
+[
+    T{ image f { 1 1 } RGB ubyte-components f B{ 0 0 0 } }
+    DEPTH reorder-components
+] must-fail
+
+[
+    T{ image f { 1 1 } RGB ubyte-components f B{ 0 0 0 } }
+    DEPTH-STENCIL reorder-components
+] must-fail
+
+[
+    T{ image f { 1 1 } RGB ubyte-components f B{ 0 0 0 } }
+    INTENSITY reorder-components
+] must-fail
+

extra/images/normalization/normalization.factor

@@ -32,7 +32,7 @@ CONSTANT: fill-value 255
         [ pad4 src dst permutation shuffle dst length head ]
         map concat ] ;
 
-: (reorder-colors) ( image src-order dest-order -- image )
+: (reorder-components) ( image src-order dest-order -- image )
     [ permute ] 2curry change-bitmap ;
 
 GENERIC: normalize-component-type* ( image component-type -- image )
@@ -63,17 +63,23 @@ M: ubyte-components normalize-component-type*
         f >>upside-down?
     ] when ;
 
+: validate-request ( src-order dst-order -- src-order dst-order )
+    [
+        [ { DEPTH DEPTH-STENCIL INTENSITY } member? ] bi@
+        or [ "Invalid component-order" throw ] when
+    ] 2keep ;
+
 PRIVATE>
 
-: reorder-colors ( image component-order -- image )
+: reorder-components ( image component-order -- image )
     [
         dup component-type>> '[ _ normalize-component-type* ] change-bitmap
         dup component-order>>
     ] dip
-    [ (reorder-colors) ] keep >>component-order ;
+    validate-request [ (reorder-components) ] keep >>component-order ;
 
 : normalize-image ( image -- image )
     [ >byte-array ] change-bitmap
-    RGBA reorder-colors
+    RGBA reorder-components
     normalize-scan-line-order ;