images.*: fix all image>stream words in extra so that they work with the added parameter

diff --git a/extra/images/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor
index fd5df488c8d97ea82ac9bbc67cfcc7ce29a445c3..80a975d887a38d29215f011cd3495df165c59fd2 100644 (file)
--- a/extra/images/bitmap/bitmap.factor
+++ b/extra/images/bitmap/bitmap.factor
@@ -428,5 +428,4 @@ M: bmp-image stream>image* ( stream bmp-image -- bitmap )
     ] bi ;
 
 M: bmp-image image>stream
-    drop BGR reorder-components output-bmp ;
-
+    2drop BGR reorder-components output-bmp ;

diff --git a/extra/images/pbm/pbm.factor b/extra/images/pbm/pbm.factor
index 35e14cc9a6790cea9232b9227dd35fc4491c4a89..efba26c7b2ffd9950b29aaa1b85414656d5e9b5b 100644 (file)
--- a/extra/images/pbm/pbm.factor
+++ b/extra/images/pbm/pbm.factor
@@ -76,7 +76,7 @@ M: pbm-image stream>image*
     drop [ [ read-pbm ] throw-on-eof ] with-input-stream ;
 
 M: pbm-image image>stream
-    drop {
+    2drop {
         [ drop "P4\n" ascii encode write ]
         [ dim>> first number>string " " append ascii encode write ]
         [ dim>> second number>string "\n" append ascii encode write ]

diff --git a/extra/images/ppm/ppm.factor b/extra/images/ppm/ppm.factor
index 865f377fbce87586e0d1a980f0b49042287ecf1f..326edc8f1102d73177bbd3520afed6a381376458 100755 (executable)
--- a/extra/images/ppm/ppm.factor
+++ b/extra/images/ppm/ppm.factor
@@ -38,7 +38,7 @@ SINGLETON: ppm-image
         { "P3" [ [ 0 npixels read-numbers ] B{ } make ] }
         { "P6" [ npixels read ] }
     } case :> data
-    
+
     image new
     RGB              >>component-order
     { width height } >>dim
@@ -50,7 +50,7 @@ M: ppm-image stream>image*
     drop [ [ read-ppm ] throw-on-eof ] with-input-stream ;
 
 M: ppm-image image>stream
-    drop {
+    2drop {
         [ drop "P6\n" ascii encode write ]
         [ dim>> first number>string " " append ascii encode write ]
         [ dim>> second number>string "\n" append ascii encode write ]

diff --git a/extra/images/testing/testing.factor b/extra/images/testing/testing.factor
index a23a548c256f76ae1a678d167e69967cd9199379..c56c60fbf8d5281eca7d913fe88dc5d62ff64901 100644 (file)
--- a/extra/images/testing/testing.factor
+++ b/extra/images/testing/testing.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Keith Lazuka.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors fry images images.loader images.normalization
-images.viewer io io.backend io.directories io.encodings.binary
-io.files io.pathnames io.streams.byte-array kernel locals
+USING: accessors assocs fry images images.loader images.normalization
+images.loader.private images.viewer io io.backend io.directories
+io.encodings.binary io.files io.pathnames io.streams.byte-array kernel locals
 namespaces quotations random sequences serialize tools.test ;
 IN: images.testing
 
@@ -42,8 +42,9 @@ PRIVATE>
     f verbose-tests? [
         path load-image dup clone normalize-image 1quotation swap
         '[
-            binary [ _ image-class image>stream ] with-byte-writer
-            image-class load-image* normalize-image
+            binary [
+                _ image-class [ types get value-at ] keep image>stream
+            ] with-byte-writer image-class load-image* normalize-image
         ] unit-test
     ] with-variable ;
 
@@ -53,7 +54,7 @@ PRIVATE>
         [ '[ _ load-reference-image ] ] bi
         unit-test
     ] with-variable ;
-    
+
 : <rgb-image> ( -- image )
     <image>
         RGB >>component-order

diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor
index f2fd8e86606fd80d2b6c5ea0033d1fa28b3d3772..70ab3e1df9737e4ee3809395289917e3ecbe7ff9 100644 (file)
--- a/extra/images/tga/tga.factor
+++ b/extra/images/tga/tga.factor
@@ -21,7 +21,7 @@ ERROR: bad-tga-unsupported ;
 : read-color-map-type ( -- byte )
     1 read le> dup
     { 0 1 } member? [ bad-tga-header ] unless ;
-      
+
 : read-image-type ( -- byte )
     1 read le> dup
     { 0 1 2 3 9 10 11 } member? [ bad-tga-header ] unless ; inline
@@ -167,7 +167,7 @@ ERROR: bad-tga-unsupported ;
         [ first ]
         [ dup third second seek-absolute seek-input read ] bi 2array
     ] map >hashtable ; inline
-    
+
 :: read-tga ( -- image )
     #! Read header
     read-id-length                                       :> id-length
@@ -185,7 +185,7 @@ ERROR: bad-tga-unsupported ;
     id-length read-image-id                              :> image-id
     map-type map-length map-entry-size read-color-map    :> color-map-data
     image-width image-height pixel-depth read-image-data :> image-data
-    
+
     [
         #! Read optional footer
         26 seek-end seek-input
@@ -208,11 +208,11 @@ ERROR: bad-tga-unsupported ;
             read-key-color               :> key-color
             read-pixel-aspect-ratio      :> aspect-ratio
             read-gamma-value             :> gamma-value
-            read-color-correction-offset :> color-correction-offset 
+            read-color-correction-offset :> color-correction-offset
             read-postage-stamp-offset    :> postage-stamp-offset
             read-scan-line-offset        :> scan-line-offset
             read-premultiplied-alpha     :> premultiplied-alpha
-            
+
             color-correction-offset 0 =
             [
                 color-correction-offset seek-absolute seek-input
@@ -224,10 +224,10 @@ ERROR: bad-tga-unsupported ;
                 postage-stamp-offset seek-absolute seek-input
                 pixel-depth read-postage-stamp-image :> postage-data
             ] unless
-            
+
             scan-line-offset seek-absolute seek-input
             image-height read-scan-line-table :> scan-offsets
-            
+
             #! Read optional developer section
             directory-offset 0 =
             [ f ]
@@ -240,11 +240,11 @@ ERROR: bad-tga-unsupported ;
 
     #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported.
     #! Other formats would need to be converted to work within the image class.
-    map-type 0 = [ bad-tga-unsupported ] unless 
+    map-type 0 = [ bad-tga-unsupported ] unless
     image-type 2 = [ bad-tga-unsupported ] unless
     pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless
     pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless
-    
+
     #! Create image instance
     image new
     alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order
@@ -252,12 +252,12 @@ ERROR: bad-tga-unsupported ;
     pixel-order 0 =                    >>upside-down?
     image-data                         >>bitmap
     ubyte-components                   >>component-type ;
-    
+
 M: tga-image stream>image*
     drop [ [ read-tga ] throw-on-eof ] with-input-stream ;
 
 M: tga-image image>stream
-    drop
+    2drop
     [
         component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless
     ] keep
@@ -287,4 +287,3 @@ M: tga-image image>stream
         ]
         [ bitmap>> write ]
     } cleave ;
-