] bi ;
M: bmp-image image>stream
- drop BGR reorder-colors output-bmp ;
+ drop BGR reorder-components output-bmp ;
}
{ $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."
"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"
[ 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
[ 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
+
[ 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 )
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 ;