From 6ce12ed3423cca9481db376c12185f964a18d728 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Tue, 6 Oct 2009 15:36:58 -0400 Subject: [PATCH] images.bitmap: now conforms to image encode protocol. images.normalization: added several component-order shuffle words --- basis/images/bitmap/bitmap.factor | 78 ++++---- basis/images/bitmap/loading/loading.factor | 7 +- basis/images/loader/loader.factor | 1 + .../normalization/normalization-tests.factor | 76 ++++++++ .../images/normalization/normalization.factor | 183 ++++++++++++++---- 5 files changed, 261 insertions(+), 84 deletions(-) create mode 100644 extra/images/normalization/normalization-tests.factor diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor index 8580a766b3..b1ce62f443 100755 --- a/basis/images/bitmap/bitmap.factor +++ b/basis/images/bitmap/bitmap.factor @@ -2,57 +2,61 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types arrays byte-arrays columns combinators compression.run-length endian fry grouping images -images.bitmap.loading images.loader io io.binary +images.loader images.normalization io io.binary io.encodings.binary io.encodings.string io.files io.streams.limited kernel locals macros math math.bitwise math.functions namespaces sequences specialized-arrays -strings summary ; -SPECIALIZED-ARRAY: uint -SPECIALIZED-ARRAY: ushort +specialized-arrays.instances.uint +specialized-arrays.instances.ushort strings summary ; IN: images.bitmap +SINGLETON: bmp-image +"bmp" bmp-image register-image-class + : write2 ( n -- ) 2 >le write ; : write4 ( n -- ) 4 >le write ; -: save-bitmap ( image path -- ) - binary [ - B{ CHAR: B CHAR: M } write - [ - bitmap>> length 14 + 40 + write4 - 0 write4 - 54 write4 - 40 write4 - ] [ - { - ! width height - [ dim>> first2 [ write4 ] bi@ ] +: output-bmp ( image -- ) + B{ CHAR: B CHAR: M } write + [ + bitmap>> length 14 + 40 + write4 + 0 write4 + 54 write4 + 40 write4 + ] [ + { + ! width height + [ dim>> first2 [ write4 ] bi@ ] - ! planes - [ drop 1 write2 ] + ! planes + [ drop 1 write2 ] - ! bit-count - [ drop 24 write2 ] + ! bit-count + [ drop 24 write2 ] - ! compression - [ drop 0 write4 ] + ! compression + [ drop 0 write4 ] - ! image-size - [ bitmap>> length write4 ] + ! image-size + [ bitmap>> length write4 ] - ! x-pels - [ drop 0 write4 ] + ! x-pels + [ drop 0 write4 ] - ! y-pels - [ drop 0 write4 ] + ! y-pels + [ drop 0 write4 ] - ! color-used - [ drop 0 write4 ] + ! color-used + [ drop 0 write4 ] - ! color-important - [ drop 0 write4 ] + ! color-important + [ drop 0 write4 ] + + ! color-palette + [ bitmap>> write ] + } cleave + ] bi ; + +M: bmp-image image>stream + drop BGR reorder-colors output-bmp ; - ! color-palette - [ bitmap>> write ] - } cleave - ] bi - ] with-file-writer ; diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor index 91e0cb882d..50926666f6 100644 --- a/basis/images/bitmap/loading/loading.factor +++ b/basis/images/bitmap/loading/loading.factor @@ -4,14 +4,11 @@ USING: accessors alien.c-types arrays byte-arrays combinators compression.run-length fry grouping images images.loader io io.binary io.encodings.8-bit io.encodings.binary io.encodings.string io.streams.limited kernel math math.bitwise -sequences specialized-arrays summary ; +sequences specialized-arrays summary images.bitmap ; QUALIFIED-WITH: bitstreams b SPECIALIZED-ARRAY: ushort IN: images.bitmap.loading -SINGLETON: bitmap-image -"bmp" bitmap-image register-image-class - ! http://www.fileformat.info/format/bmp/egff.htm ! http://www.digicamsoft.com/bmp/bmp.html @@ -364,7 +361,7 @@ ERROR: unsupported-bitmap-file magic ; : loading-bitmap>bytes ( loading-bitmap -- byte-array ) uncompress-bitmap bitmap>bytes ; -M: bitmap-image stream>image ( stream bitmap-image -- bitmap ) +M: bmp-image stream>image ( stream bmp-image -- bitmap ) drop load-bitmap [ image new ] dip { diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 700b95eb41..8617a8d442 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -53,3 +53,4 @@ GENERIC: image>stream ( image class -- ) : save-graphic-image ( image path -- ) [ image-class ] [ ] bi binary [ image>stream ] with-file-writer ; + diff --git a/extra/images/normalization/normalization-tests.factor b/extra/images/normalization/normalization-tests.factor new file mode 100644 index 0000000000..cdf5603d8c --- /dev/null +++ b/extra/images/normalization/normalization-tests.factor @@ -0,0 +1,76 @@ +! BSD License. Copyright 2009 Keith Lazuka +USING: images.normalization images.normalization.private +sequences tools.test ; +IN: images.normalization.tests + +! RGB + +[ B{ 0 1 2 255 3 4 5 255 } ] +[ B{ 0 1 2 3 4 5 } RGB>RGBA ] unit-test + +[ B{ 2 1 0 5 4 3 } ] +[ B{ 0 1 2 3 4 5 } RGB>BGR ] unit-test + +[ B{ 2 1 0 255 5 4 3 255 } ] +[ B{ 0 1 2 3 4 5 } RGB>BGRA ] unit-test + +[ B{ 255 0 1 2 255 3 4 5 } ] +[ B{ 0 1 2 3 4 5 } RGB>ARGB ] unit-test + +! RGBA + +[ B{ 0 1 2 4 5 6 } ] +[ B{ 0 1 2 3 4 5 6 7 } RGBA>RGB ] unit-test + +[ B{ 2 1 0 6 5 4 } ] +[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGR ] unit-test + +[ B{ 2 1 0 3 6 5 4 7 } ] +[ B{ 0 1 2 3 4 5 6 7 } RGBA>BGRA ] unit-test + +[ B{ 3 0 1 2 7 4 5 6 } ] +[ B{ 0 1 2 3 4 5 6 7 } RGBA>ARGB ] unit-test + +! BGR + +[ B{ 2 1 0 5 4 3 } ] +[ B{ 0 1 2 3 4 5 } BGR>RGB ] unit-test + +[ B{ 2 1 0 255 5 4 3 255 } ] +[ B{ 0 1 2 3 4 5 } BGR>RGBA ] unit-test + +[ B{ 0 1 2 255 3 4 5 255 } ] +[ B{ 0 1 2 3 4 5 } BGR>BGRA ] unit-test + +[ B{ 255 2 1 0 255 5 4 3 } ] +[ B{ 0 1 2 3 4 5 } BGR>ARGB ] unit-test + +! BGRA + +[ B{ 2 1 0 6 5 4 } ] +[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGB ] unit-test + +[ B{ 0 1 2 4 5 6 } ] +[ B{ 0 1 2 3 4 5 6 7 } BGRA>BGR ] unit-test + +[ B{ 2 1 0 3 6 5 4 7 } ] +[ B{ 0 1 2 3 4 5 6 7 } BGRA>RGBA ] unit-test + +[ B{ 3 2 1 0 7 6 5 4 } ] +[ B{ 0 1 2 3 4 5 6 7 } BGRA>ARGB ] unit-test + +! ARGB + +[ B{ 1 2 3 5 6 7 } ] +[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGB ] unit-test + +[ B{ 3 2 1 7 6 5 } ] +[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGR ] unit-test + +[ B{ 3 2 1 0 7 6 5 4 } ] +[ B{ 0 1 2 3 4 5 6 7 } ARGB>BGRA ] unit-test + +[ B{ 1 2 3 0 5 6 7 4 } ] +[ B{ 0 1 2 3 4 5 6 7 } ARGB>RGBA ] unit-test + + diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor index f557e979dd..3fb3a7d276 100755 --- a/extra/images/normalization/normalization.factor +++ b/extra/images/normalization/normalization.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Doug Coleman +! Copyright (C) 2009 Doug Coleman, Keith Lazuka ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel accessors grouping sequences combinators math byte-arrays fry images half-floats @@ -12,21 +12,158 @@ IN: images.normalization [ 255 suffix ] map concat ; : normalize-floats ( float-array -- byte-array ) [ 255.0 * >integer ] B{ } map-as ; +: fix-XBGR ( bitmap -- bitmap' ) + dup 4 [ [ 255 0 ] dip set-nth ] each ; + +: fix-BGRX ( bitmap -- bitmap' ) + dup 4 [ [ 255 3 ] dip set-nth ] each ; + +! Bitmap Conversions + +! TODO RGBX, XRGB, BGRX, XBGR conversions + +! BGR> +: BGR>RGB ( bitmap -- bitmap' ) + 3 [ ] map concat ; inline + +: BGR>BGRA ( bitmap -- bitmap' ) add-dummy-alpha ; inline + +: BGR>RGBA ( bitmap -- bitmap' ) BGR>RGB add-dummy-alpha ; inline + +: BGR>ARGB ( bitmap -- bitmap' ) + 3 [ 255 suffix ] map concat ; inline + +! BGRA> +: BGRA>BGR ( bitmap -- bitmap' ) + 4 [ but-last-slice ] map concat ; inline + +: BGRA>RGBA ( bitmap -- bitmap' ) + 4 + [ unclip-last-slice [ ] dip suffix ] map concat ; inline + +: BGRA>RGB ( bitmap -- bitmap' ) + 4 [ but-last-slice ] map concat ; inline + +: BGRA>ARGB ( bitmap -- bitmap' ) + 4 [ ] map concat ; inline + +! RGB> +: RGB>BGR ( bitmap -- bitmap' ) BGR>RGB ; inline + +: RGB>RGBA ( bitmap -- bitmap' ) add-dummy-alpha ; inline + +: RGB>BGRA ( bitmap -- bitmap' ) + 3 [ add-dummy-alpha ] map concat ; inline + +: RGB>ARGB ( bitmap -- bitmap' ) + 3 [ 255 prefix ] map concat ; inline + +! RGBA> + +: RGBA>BGR ( bitmap -- bitmap' ) BGRA>RGB ; inline + +: RGBA>BGRA ( bitmap -- bitmap' ) BGRA>RGBA ; inline + +: RGBA>RGB ( bitmap -- bitmap' ) BGRA>BGR ; inline + +: RGBA>ARGB ( bitmap -- bitmap' ) + 4 [ unclip-last-slice prefix ] map concat ; inline + +! ARGB> + +: ARGB>RGB ( bitmap -- bitmap' ) + 4 [ rest-slice ] map concat ; inline + +: ARGB>RGBA ( bitmap -- bitmap' ) + 4 [ unclip-slice suffix ] map concat ; inline + +: ARGB>BGR ( bitmap -- bitmap' ) + 4 [ rest-slice ] map concat ; inline + +: ARGB>BGRA ( bitmap -- bitmap' ) + 4 + [ unclip-slice [ ] dip suffix ] map concat ; inline + +! Dispatch +GENERIC# convert-component-order 1 ( image src-order dest-order -- image ) + +M: RGB convert-component-order + nip [ >>component-order ] keep { + { RGB [ ] } + { RGBA [ [ RGB>RGBA ] change-bitmap ] } + { BGRA [ [ BGR>BGRA ] change-bitmap ] } + { ARGB [ [ RGB>RGBA RGBA>ARGB ] change-bitmap ] } + { BGR [ [ RGB>BGR ] change-bitmap ] } + [ "Cannot convert from RGB to desired component order!" throw ] + } case ; + +M: RGBA convert-component-order + nip [ >>component-order ] keep { + { RGBA [ ] } + { BGRA [ [ RGBA>BGRA ] change-bitmap ] } + { BGR [ [ RGBA>BGR ] change-bitmap ] } + { RGB [ [ RGBA>RGB ] change-bitmap ] } + { ARGB [ [ RGBA>ARGB ] change-bitmap ] } + [ "Cannot convert from RGBA to desired component order!" throw ] + } case ; + +M: BGR convert-component-order + nip [ >>component-order ] keep { + { BGR [ ] } + { BGRA [ [ BGR>BGRA ] change-bitmap ] } + { RGB [ [ BGR>RGB ] change-bitmap ] } + { RGBA [ [ BGR>RGBA ] change-bitmap ] } + { ARGB [ [ BGR>ARGB ] change-bitmap ] } + [ "Cannot convert from BGR to desired component order!" throw ] + } case ; + +M: BGRA convert-component-order + nip [ >>component-order ] keep { + { BGRA [ ] } + { BGR [ [ BGRA>BGR ] change-bitmap ] } + { RGB [ [ BGRA>RGB ] change-bitmap ] } + { RGBA [ [ BGRA>RGBA ] change-bitmap ] } + { ARGB [ [ BGRA>ARGB ] change-bitmap ] } + [ "Cannot convert from BGRA to desired component order!" throw ] + } case ; + +M: ARGB convert-component-order + nip [ >>component-order ] keep { + { ARGB [ ] } + { BGR [ [ ARGB>BGR ] change-bitmap ] } + { RGB [ [ ARGB>RGB ] change-bitmap ] } + { RGBA [ [ ARGB>RGBA ] change-bitmap ] } + { BGRA [ [ ARGB>BGRA ] change-bitmap ] } + [ "Cannot convert from ARGB to desired component order!" throw ] + } case ; + +PRIVATE> + +! asserts that component-type must be ubyte-components +: reorder-colors ( image component-order -- image ) + [ + [ component-type>> ubyte-components assert= ] + [ dup component-order>> ] bi + ] dip convert-component-order ; + +> '[ _ normalize-component-type* ] change-bitmap - dup component-order>> '[ _ normalize-component-order* ] change-bitmap ; + RGBA reorder-colors ; M: float-components normalize-component-type* drop byte-array>float-array normalize-floats ; + M: half-components normalize-component-type* drop byte-array>half-array normalize-floats ; @@ -39,45 +176,6 @@ M: ushort-components normalize-component-type* M: ubyte-components normalize-component-type* drop ; -M: RGBA normalize-component-order* drop ; - -: BGR>RGB ( bitmap -- pixels ) - 3 [ ] map B{ } join ; inline - -: BGRA>RGBA ( bitmap -- pixels ) - 4 - [ unclip-last-slice [ ] dip suffix ] map concat ; inline - -M: BGRA normalize-component-order* - drop BGRA>RGBA ; - -M: RGB normalize-component-order* - drop add-dummy-alpha ; - -M: BGR normalize-component-order* - drop BGR>RGB add-dummy-alpha ; - -: ARGB>RGBA ( bitmap -- bitmap' ) - 4 [ unclip suffix ] map B{ } join ; inline - -M: ARGB normalize-component-order* - drop ARGB>RGBA ; - -M: ABGR normalize-component-order* - drop ARGB>RGBA BGRA>RGBA ; - -: fix-XBGR ( bitmap -- bitmap' ) - dup 4 [ [ 255 0 ] dip set-nth ] each ; - -M: XBGR normalize-component-order* - drop fix-XBGR ABGR normalize-component-order* ; - -: fix-BGRX ( bitmap -- bitmap' ) - dup 4 [ [ 255 3 ] dip set-nth ] each ; - -M: BGRX normalize-component-order* - drop fix-BGRX BGRA normalize-component-order* ; - : normalize-scan-line-order ( image -- image ) dup upside-down?>> [ dup dim>> first 4 * '[ @@ -93,3 +191,4 @@ PRIVATE> normalize-component-order normalize-scan-line-order RGBA >>component-order ; +