images.bitmap: now conforms to image encode protocol. images.normalization: added...

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 8580a766b3d661e3361aa2b2aae204e0080bf1ab..b1ce62f4438203a44b071b434980d96f99a3c7a5 100755 (executable)
--- 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 ]
+
+            ! bit-count
+            [ drop 24 write2 ]
 
-                ! planes
-                [ drop 1 write2 ]
+            ! compression
+            [ drop 0 write4 ]
 
-                ! bit-count
-                [ drop 24 write2 ]
+            ! image-size
+            [ bitmap>> length write4 ]
 
-                ! compression
-                [ drop 0 write4 ]
+            ! x-pels
+            [ drop 0 write4 ]
 
-                ! image-size
-                [ bitmap>> length write4 ]
+            ! y-pels
+            [ drop 0 write4 ]
 
-                ! x-pels
-                [ drop 0 write4 ]
+            ! color-used
+            [ drop 0 write4 ]
 
-                ! y-pels
-                [ drop 0 write4 ]
+            ! color-important
+            [ drop 0 write4 ]
 
-                ! color-used
-                [ drop 0 write4 ]
+            ! color-palette
+            [ bitmap>> write ]
+        } cleave
+    ] bi ;
 
-                ! color-important
-                [ drop 0 write4 ]
+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 91e0cb882db1b3e5ac92535616793dd5314dd5f0..50926666f6239205473b2018e05e4e3a7520aa71 100644 (file)
--- 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 700b95eb41719aa63166ab1ceca31aaef52ed408..8617a8d4429778257303498f8572a64f68b2ca91 100644 (file)
--- 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 (file)
index 0000000..cdf5603
--- /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 f557e979dd372eebde4003b1613b90e57e9d3515..3fb3a7d276e48198873ef9e5f283c8228e7fe14d 100755 (executable)
--- 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,71 +12,169 @@ IN: images.normalization
 
 <PRIVATE
 
+! Helpers
 : add-dummy-alpha ( seq -- seq' )
     3 <groups> [ 255 suffix ] map concat ;
 
 : normalize-floats ( float-array -- byte-array )
     [ 255.0 * >integer ] B{ } map-as ;
 
-GENERIC: normalize-component-type* ( image component-type -- image )
-GENERIC: normalize-component-order* ( image component-order -- image )
+: fix-XBGR ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
 
-: normalize-component-order ( image -- image )
-    dup component-type>> '[ _ normalize-component-type* ] change-bitmap
-    dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
+: fix-BGRX ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
 
-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 ;
+! Bitmap Conversions
 
-: ushorts>ubytes ( bitmap -- bitmap' )
-    byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
+! TODO RGBX, XRGB, BGRX, XBGR conversions
 
-M: ushort-components normalize-component-type*
-    drop ushorts>ubytes ;
+! BGR>
+: BGR>RGB ( bitmap -- bitmap' )
+    3 <sliced-groups> [ <reversed> ] map concat ; inline
 
-M: ubyte-components normalize-component-type*
-    drop ;
+: BGR>BGRA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
+
+: BGR>RGBA ( bitmap -- bitmap' ) BGR>RGB add-dummy-alpha ; inline
 
-M: RGBA normalize-component-order* drop ;
+: BGR>ARGB ( bitmap -- bitmap' )
+    3 <sliced-groups> [ 255 suffix <reversed> ] map concat ; inline
 
-: BGR>RGB ( bitmap -- pixels )
-    3 <sliced-groups> [ <reversed> ] map B{ } join ; inline
+! BGRA>
+: BGRA>BGR ( bitmap -- bitmap' )
+    4 <sliced-groups> [ but-last-slice ] map concat ; inline
 
-: BGRA>RGBA ( bitmap -- pixels )
+: BGRA>RGBA ( bitmap -- bitmap' )
     4 <sliced-groups>
     [ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
 
-M: BGRA normalize-component-order*
-    drop BGRA>RGBA ;
+: BGRA>RGB ( bitmap -- bitmap' )
+    4 <sliced-groups> [ but-last-slice <reversed> ] map concat ; inline
+
+: BGRA>ARGB ( bitmap -- bitmap' )
+    4 <sliced-groups> [ <reversed> ] map concat ; inline
+
+! RGB>
+: RGB>BGR ( bitmap -- bitmap' ) BGR>RGB ; inline
+
+: RGB>RGBA ( bitmap -- bitmap' ) add-dummy-alpha ; inline
+
+: RGB>BGRA ( bitmap -- bitmap' )
+    3 <sliced-groups> [ <reversed> add-dummy-alpha ] map concat ; inline
+
+: RGB>ARGB ( bitmap -- bitmap' )
+    3 <sliced-groups> [ 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 <sliced-groups> [ unclip-last-slice prefix ] map concat ; inline
 
-M: RGB normalize-component-order*
-    drop add-dummy-alpha ;
+! ARGB>
 
-M: BGR normalize-component-order*
-    drop BGR>RGB add-dummy-alpha ;
+: ARGB>RGB ( bitmap -- bitmap' )
+    4 <sliced-groups> [ rest-slice ] map concat ; inline
 
 : ARGB>RGBA ( bitmap -- bitmap' )
-    4 <groups> [ unclip suffix ] map B{ } join ; inline
+    4 <sliced-groups> [ unclip-slice suffix ] map concat ; inline
 
-M: ARGB normalize-component-order*
-    drop ARGB>RGBA ;
+: ARGB>BGR ( bitmap -- bitmap' )
+    4 <sliced-groups> [ rest-slice <reversed> ] map concat ; inline
 
-M: ABGR normalize-component-order*
-    drop ARGB>RGBA BGRA>RGBA ;
+: ARGB>BGRA ( bitmap -- bitmap' )
+    4 <sliced-groups>
+    [ unclip-slice [ <reversed> ] 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 ;
 
-: fix-XBGR ( bitmap -- bitmap' )
-    dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
+PRIVATE>
 
-M: XBGR normalize-component-order*
-    drop fix-XBGR ABGR normalize-component-order* ;
+! 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 ;
 
-: fix-BGRX ( bitmap -- bitmap' )
-    dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
+<PRIVATE
 
-M: BGRX normalize-component-order*
-    drop fix-BGRX BGRA normalize-component-order* ;
+GENERIC: normalize-component-type* ( image component-type -- image )
+
+: normalize-component-order ( image -- image )
+    dup component-type>> '[ _ normalize-component-type* ] 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 ;
+
+: ushorts>ubytes ( bitmap -- bitmap' )
+    byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
+
+M: ushort-components normalize-component-type*
+    drop ushorts>ubytes ;
+
+M: ubyte-components normalize-component-type*
+    drop ;
 
 : normalize-scan-line-order ( image -- image )
     dup upside-down?>> [
@@ -93,3 +191,4 @@ PRIVATE>
     normalize-component-order
     normalize-scan-line-order
     RGBA >>component-order ;
+