Merge remote-tracking branch 'philip-searle/master'

basis/images/png/png-tests.factor

@@ -7,13 +7,68 @@ 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
+    "basi3p01.png" decode-test
+    "basi3p02.png" decode-test
+    "basi3p04.png" decode-test
+    "basi3p08.png" decode-test
+    "basn0g01.png" decode-test
+    "basn0g02.png" decode-test
+    "basn0g04.png" decode-test
+    "basn0g08.png" decode-test
+    "basn0g16.png" decode-test
     "basn2c08.png" decode-test
+    "basn3p01.png" decode-test
+    "basn3p02.png" decode-test
+    "basn3p04.png" decode-test
+    "basn3p08.png" decode-test
     "basn6a08.png" decode-test
     "f00n2c08.png" decode-test
     "f01n2c08.png" decode-test
     "f02n2c08.png" decode-test
     "f03n2c08.png" decode-test
     "f04n2c08.png" decode-test
+    "s01i3p01.png" decode-test
+    "s01n3p01.png" decode-test
+    "s02i3p01.png" decode-test
+    "s02n3p01.png" decode-test
+    "s03i3p01.png" decode-test
+    "s03n3p01.png" decode-test
+    "s04i3p01.png" decode-test
+    "s04n3p01.png" decode-test
+    "s05i3p02.png" decode-test
+    "s05n3p02.png" decode-test
+    "s06i3p02.png" decode-test
+    "s06n3p02.png" decode-test
+    "s07i3p02.png" decode-test
+    "s07n3p02.png" decode-test
+    "s08i3p02.png" decode-test
+    "s08n3p02.png" decode-test
+    "s09i3p02.png" decode-test
+    "s32n3p04.png" decode-test
+    "s32i3p04.png" decode-test
+    "s33n3p04.png" decode-test
+    "s33i3p04.png" decode-test
+    "s34n3p04.png" decode-test
+    "s34i3p04.png" decode-test
+    "s35n3p04.png" decode-test
+    "s35i3p04.png" decode-test
+    "s36n3p04.png" decode-test
+    "s36i3p04.png" decode-test
+    "s37n3p04.png" decode-test
+    "s37i3p04.png" decode-test
+    "s38n3p04.png" decode-test
+    "s38i3p04.png" decode-test
+    "s39n3p04.png" decode-test
+    "s39i3p04.png" decode-test
+    "s40n3p04.png" decode-test
+    "s40i3p04.png" decode-test
+    "s07n3p02.png" decode-test
     "z00n2c08.png" decode-test
     "z03n2c08.png" decode-test
     "z06n2c08.png" decode-test

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,89 @@ 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 )
+    pass starting-row nth png-height >= [
+        0
+    ] [
+        png-height 1 -
+        pass block-height nth +
+        pass row-increment nth /i
+    ] if ;
+
+:: adam7-subimage-width ( png-width pass -- subimage-width )
+    pass starting-col nth png-width >= [
+        0
+    ] [
+        png-width 1 -
+        pass block-width nth +
+        pass col-increment nth /i
+    ] if ;
+
+:: 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
+
+    height width * zero? [
+        B{ } clone
+    ] [
+        bit-reader loading-png width height read-scanlines
+    ] if ;
+
 :: 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
+      bs loading-png pass read-adam7-subimage
 
-                pass block-height nth
-                height row - min
+      #bytes <sliced-groups>
 
-                pass block-width nth
-                width col - min
+      pass starting-row nth row!
+      pass starting-col nth col!
+      [
+          [ row col f f ] dip image visit
 
-                bit-depth bs bs:read
-                image
-                visit
+          col pass col-increment nth + col!
+          col width >= [
+              pass starting-col nth col!
+              row pass row-increment nth + row!
+          ] when
+      ] each
 
-                col pass col-increment nth + col!
-            ] while
-            row pass row-increment nth + row!
-        ] while
-        pass 1 + pass!
+      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 ;
 
@@ -240,7 +261,7 @@ ERROR: unknown-component-type n ;
 : scale-factor ( n -- n' )
     {
         { 1 [ 255 ] }
-        { 2 [ 127 ] }
+        { 2 [ 85 ] }
         { 4 [ 17 ] }
     } case ;