images.gif: unit tests now use a PAM reference image to verify decoding

basis/images/testing/testing.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Keith Lazuka.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.encodings.binary io.files
+USING: fry images.loader io io.encodings.binary io.files
-io.streams.byte-array kernel quotations sequences tools.test ;
+io.pathnames io.streams.byte-array kernel locals quotations
+sequences tools.test ;
 IN: images.testing
 
 :: encode-test ( path image-class -- )
@@ -11,3 +12,19 @@ IN: images.testing
             path load-image image-class image>stream
         ] with-output-stream B{ } like
     ] unit-test ;
+
+<PRIVATE
+
+: pam-name ( path -- newpath )
+    [ parent-directory canonicalize-path ]
+    [ file-stem ".pam" append ] bi
+    append-path ;
+
+: save-as-reference-image ( path -- )
+    [ load-image ] [ pam-name ] bi save-graphic-image ;
+
+PRIVATE>
+
+: decode-test ( path -- )
+    [ load-image 1quotation ] [ '[ _ pam-name load-image ] ] bi
+    unit-test ;

extra/images/gif/gif-tests.factor

@@ -1,50 +1,45 @@
 ! Copyright (C) 2009 Keith Lazuka.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors bitstreams compression.lzw images.gif io
+USING: accessors bitstreams compression.lzw fry images.gif
-io.encodings.binary io.files kernel math math.bitwise
+images.loader images.viewer images.testing io io.encodings.binary io.files
-math.parser namespaces prettyprint sequences tools.test images.viewer ;
+io.pathnames kernel math math.bitwise math.parser namespaces
+prettyprint quotations sequences tools.test ;
 QUALIFIED-WITH: bitstreams bs
 IN: images.gif.tests
 
-: path>gif ( path -- loading-gif )
+"vocab:images/testing/gif/circle.gif" decode-test
+"vocab:images/testing/gif/checkmark.gif" decode-test
+"vocab:images/testing/gif/monochrome.gif" decode-test
+"vocab:images/testing/gif/alpha.gif" decode-test
+! "vocab:images/testing/gif/noise.gif" decode-test
+"vocab:images/testing/gif/astronaut_animation.gif" decode-test
+
+: path>gif ( path -- gif )
     binary [ input-stream get load-gif ] with-file-reader ;
 
-: gif-example1 ( -- loading-gif )
+: circle.gif ( -- gif )
-    "resource:extra/images/testing/circle.gif" path>gif ;
+    "vocab:images/testing/gif/circle.gif" path>gif ;
 
-: gif-example2 ( -- loading-gif )
+: checkmark.gif ( -- gif )
-    "resource:extra/images/testing/checkmark.gif" path>gif ;
+    "vocab:images/testing/gif/checkmark.gif" path>gif ;
 
-: gif-example3 ( -- loading-gif )
+: monochrome.gif ( -- gif )
-    "resource:extra/images/testing/monochrome.gif" path>gif ;
+    "vocab:images/testing/gif/monochrome.gif" path>gif ;
 
-: gif-example4 ( -- loading-gif )
+: alpha.gif ( -- gif )
-    "resource:extra/images/testing/noise.gif" path>gif ;
+    "vocab:images/testing/gif/alpha.gif" path>gif ;
-
-: gif-example5 ( -- loading-gif )
-    "resource:extra/images/testing/alpha.gif" path>gif ;
-
-: gif-example6 ( -- loading-gif )
-    "resource:extra/images/testing/astronaut_animation.gif" path>gif ;
-
-: gif-all. ( -- )
-    {
-        gif-example1 gif-example2 gif-example3 gif-example4 gif-example5
-        gif-example6
-    }
-    [ execute( -- gif ) gif>image image. ] each ;
 
 : declared-num-colors ( gif -- n ) flags>> 3 bits 1 + 2^ ;
 : actual-num-colors ( gif -- n ) global-color-table>> length ;
 
-[ 16 ] [ gif-example1 actual-num-colors ] unit-test
+[ 2 ] [ monochrome.gif actual-num-colors ] unit-test
-[ 16 ] [ gif-example1 declared-num-colors ] unit-test
+[ 2 ] [ monochrome.gif declared-num-colors ] unit-test
 
-[ 256 ] [ gif-example2 actual-num-colors ] unit-test
+[ 16 ] [ circle.gif actual-num-colors ] unit-test
-[ 256 ] [ gif-example2 declared-num-colors ] unit-test
+[ 16 ] [ circle.gif declared-num-colors ] unit-test
 
-[ 2 ] [ gif-example3 actual-num-colors ] unit-test
+[ 256 ] [ checkmark.gif actual-num-colors ] unit-test
-[ 2 ] [ gif-example3 declared-num-colors ] unit-test
+[ 256 ] [ checkmark.gif declared-num-colors ] unit-test
 
 : >index-stream ( gif -- seq )
     [ compressed-bytes>> ]
@@ -60,36 +55,11 @@ IN: images.gif.tests
         1 0 1 1 0 1
         1 0 0 0 0 1
     }
-] [ gif-example3 >index-stream ] unit-test
+] [ monochrome.gif >index-stream ] unit-test
-
-[
-    B{
-        255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255
-        0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 255
-        0 0 0 255 0 0 0 255 255 255 255 255 255 255 255 255 0 0 0 255 0 0 0 255
-        0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255 0 0 0 255
-        0 0 0 255 255 255 255 255 0 0 0 255 0 0 0 255 255 255 255 255 0 0 0 255
-        0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 255
-    }
-] [ gif-example3 gif>image bitmap>> ] unit-test
 
 [
     BV{
         0 1
         1 0
     }
-] [ gif-example5 >index-stream ] unit-test
+] [ alpha.gif >index-stream ] unit-test
-
-[
-    B{
-        255 000 000 255     000 000 000 000
-        000 000 000 000     255 000 000 255
-    }
-] [ gif-example5 gif>image bitmap>> ] unit-test
-
-[ 100 ] [ gif-example1 >index-stream length ] unit-test
-[ 870 ] [ gif-example2 >index-stream length ] unit-test
-[ 16384 ] [ gif-example4 >index-stream length ] unit-test
-
-! example6 is a GIF animation and the first frame contains 1768 pixels
-[ 1768 ] [ gif-example6 >index-stream length ] unit-test