Fix support for interlaced 1/2/4/8/16-bit greyscale and interlaced 8-bit truecolour...

diff --git a/basis/images/png/png-tests.factor b/basis/images/png/png-tests.factor
index 25815c7017666df2c6fc53c70549c4a4138e8238..7edb8d753e5be4c74387c5ece2cbcf4014952d8f 100644 (file)
--- a/basis/images/png/png-tests.factor
+++ b/basis/images/png/png-tests.factor
@@ -7,6 +7,12 @@ IN: images.png.tests
 
 ! The subset of the suite that should work given the current implementation.
 "vocab:images/testing/png" [
+    "basi0g01.png" decode-test
+    "basi0g02.png" decode-test
+    "basi0g04.png" decode-test
+    "basi0g08.png" decode-test
+    "basi0g16.png" decode-test
+    "basi2c08.png" decode-test
     "basn0g01.png" decode-test
     "basn0g02.png" decode-test
     "basn0g04.png" decode-test

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 2135d3fc96df5e6b1a39314c63b314556d148daa..2a77d13068b2340f969643433757bfad2c6b10b1 100644 (file)
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -147,10 +147,7 @@ ERROR: unimplemented-color-type image ;
 
 ERROR: bad-filter n ;
 
-:: reverse-interlace-none ( byte-array loading-png -- array )
-    byte-array bs:<msb0-bit-reader> :> bs
-    loading-png width>> :> width
-    loading-png height>> :> height
+:: read-scanlines ( bit-reader loading-png width height -- array )
     loading-png png-components-per-pixel :> #components
     loading-png bit-depth>> :> bit-depth
     bit-depth :> depth!
@@ -163,65 +160,76 @@ ERROR: bad-filter n ;
     ] when
 
     height [
-        8 bs bs:read dup 0 4 between? [ bad-filter ] unless
-        count [ depth bs bs:read ] replicate swap prefix
-        8 bs bs:align
+        8 bit-reader bs:read dup 0 4 between? [ bad-filter ] unless
+        count [ depth bit-reader bs:read ] replicate swap prefix
+        8 bit-reader bs:align
     ] replicate
     #components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
 
+:: reverse-interlace-none ( byte-array loading-png -- array )
+    byte-array bs:<msb0-bit-reader> :> bs
+    loading-png width>> :> width
+    loading-png height>> :> height
+
+    bs loading-png width height read-scanlines ;
+
+: adam7-subimage-height ( png-height pass -- subimage-height )
+    [ starting-row nth + ] keep
+    row-increment nth /i ;
+
+: adam7-subimage-width ( png-width pass -- subimage-width )
+    [ starting-col nth + ] keep
+    col-increment nth /i ;
+
+:: read-adam7-subimage ( bit-reader loading-png pass -- lines )
+    loading-png height>> pass adam7-subimage-height :> height
+    loading-png width>> pass adam7-subimage-width :> width
+
+    bit-reader loading-png width height read-scanlines ;
+
 :: reverse-interlace-adam7 ( byte-array loading-png -- byte-array )
     byte-array bs:<msb0-bit-reader> :> bs
     loading-png height>> :> height
     loading-png width>> :> width
     loading-png bit-depth>> :> bit-depth
-    loading-png png-components-per-pixel :> #bytes
-    width height #bytes * * <byte-array> width <sliced-groups> :> image
+    loading-png png-components-per-pixel :> #bytes!
+    width height * f <array> width <sliced-groups> :> image
+
+    bit-depth 16 = [
+        #bytes 2 * #bytes!
+    ] when
 
     0 :> row!
     0 :> col!
 
     0 :> pass!
     [ pass 7 < ] [
-        pass starting-row nth row!
-        [
-            row height <
-        ] [
-            pass starting-col nth col!
-            [
-                col width <
-            ] [
-                row
-                col
-
-                pass block-height nth
-                height row - min
-
-                pass block-width nth
-                width col - min
-
-                bit-depth bs bs:read
-                image
-                visit
-
-                col pass col-increment nth + col!
-            ] while
-            row pass row-increment nth + row!
-        ] while
-        pass 1 + pass!
+      bs loading-png pass read-adam7-subimage
+
+      #bytes <sliced-groups>
+
+      pass starting-row nth row!
+      pass starting-col nth col!
+      [
+          [ row col f f ] dip image visit
+
+          col pass col-increment nth + col!
+          col width >= [
+              pass starting-col nth col!
+              row pass row-increment nth + row!
+          ] when
+      ] each
+
+      pass 1 + pass!
     ] while
-    bit-depth 16 = [
-        image { } concat-as
-        [ 2 >be ] map B{ } concat-as
-    ] [
-        image B{ } concat-as
-    ] if ;
+    image concat B{ } concat-as ;
 
 ERROR: unimplemented-interlace ;
 
 : uncompress-bytes ( loading-png -- bitstream )
     [ inflate-data ] [ ] [ interlace-method>> ] tri {
         { interlace-none [ reverse-interlace-none ] }
-        { interlace-adam7 [ "adam7 is broken" throw reverse-interlace-adam7 ] }
+        { interlace-adam7 [ reverse-interlace-adam7 ] }
         [ unimplemented-interlace ]
     } case ;
 

diff --git a/extra/images/testing/png/basi0g01.fig b/extra/images/testing/png/basi0g01.fig
new file mode 100644 (file)
index 0000000..d79f71b
Binary files /dev/null and b/extra/images/testing/png/basi0g01.fig differ

diff --git a/extra/images/testing/png/basi0g01.png b/extra/images/testing/png/basi0g01.png
new file mode 100644 (file)
index 0000000..556fa72
Binary files /dev/null and b/extra/images/testing/png/basi0g01.png differ

diff --git a/extra/images/testing/png/basi0g02.fig b/extra/images/testing/png/basi0g02.fig
new file mode 100644 (file)
index 0000000..3953ef5
Binary files /dev/null and b/extra/images/testing/png/basi0g02.fig differ

diff --git a/extra/images/testing/png/basi0g02.png b/extra/images/testing/png/basi0g02.png
new file mode 100644 (file)
index 0000000..ce09821
Binary files /dev/null and b/extra/images/testing/png/basi0g02.png differ

diff --git a/extra/images/testing/png/basi0g04.fig b/extra/images/testing/png/basi0g04.fig
new file mode 100644 (file)
index 0000000..1e45ed1
Binary files /dev/null and b/extra/images/testing/png/basi0g04.fig differ

diff --git a/extra/images/testing/png/basi0g04.png b/extra/images/testing/png/basi0g04.png
new file mode 100644 (file)
index 0000000..3853273
Binary files /dev/null and b/extra/images/testing/png/basi0g04.png differ

diff --git a/extra/images/testing/png/basi0g08.fig b/extra/images/testing/png/basi0g08.fig
new file mode 100644 (file)
index 0000000..d185701
Binary files /dev/null and b/extra/images/testing/png/basi0g08.fig differ

diff --git a/extra/images/testing/png/basi0g08.png b/extra/images/testing/png/basi0g08.png
new file mode 100644 (file)
index 0000000..faed8be
Binary files /dev/null and b/extra/images/testing/png/basi0g08.png differ

diff --git a/extra/images/testing/png/basi0g16.fig b/extra/images/testing/png/basi0g16.fig
new file mode 100644 (file)
index 0000000..7218acd
Binary files /dev/null and b/extra/images/testing/png/basi0g16.fig differ

diff --git a/extra/images/testing/png/basi0g16.png b/extra/images/testing/png/basi0g16.png
new file mode 100644 (file)
index 0000000..a9f2816
Binary files /dev/null and b/extra/images/testing/png/basi0g16.png differ

diff --git a/extra/images/testing/png/basi2c08.fig b/extra/images/testing/png/basi2c08.fig
new file mode 100644 (file)
index 0000000..84f8c97
Binary files /dev/null and b/extra/images/testing/png/basi2c08.fig differ

diff --git a/extra/images/testing/png/basi2c08.png b/extra/images/testing/png/basi2c08.png
new file mode 100644 (file)
index 0000000..2aab44d
Binary files /dev/null and b/extra/images/testing/png/basi2c08.png differ