! 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
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!
] 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
-
- 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 ;
: scale-factor ( n -- n' )
{
{ 1 [ 255 ] }
- { 2 [ 127 ] }
+ { 2 [ 85 ] }
{ 4 [ 17 ] }
} case ;