steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

images.png: support for reading iTXt chunks

locals-and-roots
Björn Lindqvist 2016-05-07 15:07:22 +02:00
parent af53fdd3d0
commit 2b91a3e083
2 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/images/png/png-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Doug Coleman, Keith Lazuka ! Copyright (C) 2009 Doug Coleman, Keith Lazuka
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors images.png images.testing io.directories USING: accessors images.png images.testing io.directories
io.encodings.binary io.files sequences tools.test ; io.encodings.binary io.files kernel sequences tools.test ;
IN: images.png.tests IN: images.png.tests
! Test files from PngSuite (http://www.libpng.org/pub/png/pngsuite.html) ! Test files from PngSuite (http://www.libpng.org/pub/png/pngsuite.html)
@ -78,8 +78,18 @@ IN: images.png.tests
} [ png-image decode-test ] each } [ png-image decode-test ] each
{ "ICC Profile" } [ { "ICC Profile" } [
"1529.png" binary <file-reader> load-png icc-profile>> name>> "1529.png" binary <file-reader> load-png
icc-profile>> name>>
] unit-test ] unit-test
{
"XML:com.adobe.xmp"
"<x:xmpmeta xmlns:x=\"adobe:ns:meta/\" x:xmptk=\"XMP Core 5.4.0\">\n <rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\">\n <rdf:Description rdf:about=\"\"\n xmlns:exif=\"http://ns.adobe.com/exif/1.0/\">\n <exif:PixelXDimension>77</exif:PixelXDimension>\n <exif:PixelYDimension>71</exif:PixelYDimension>\n </rdf:Description>\n </rdf:RDF>\n</x:xmpmeta>\n"
} [
"1529.png" binary <file-reader> load-png
itexts>> first [ keyword>> ] [ text>> ] bi
] unit-test
] with-directory ] with-directory
! Test pngsuite ! Test pngsuite

16
extra/images/png/png.factor
View File

@ -13,10 +13,12 @@ SINGLETON: png-image
TUPLE: icc-profile name data ; TUPLE: icc-profile name data ;
TUPLE: itext keyword language translated-keyword text ;
TUPLE: loading-png TUPLE: loading-png
chunks chunks
width height bit-depth color-type compression-method width height bit-depth color-type compression-method
filter-method interlace-method icc-profile ; filter-method interlace-method icc-profile itexts ;
CONSTANT: filter-none 0 CONSTANT: filter-none 0
CONSTANT: filter-sub 1 CONSTANT: filter-sub 1
@ -97,11 +99,22 @@ ERROR: bad-checksum ;
read-png-string read1 drop contents zlib-inflate read-png-string read1 drop contents zlib-inflate
] with-byte-reader icc-profile boa ; ] with-byte-reader icc-profile boa ;
: <itext> ( byte-array -- itext )
binary [
read-png-string
! Skip compression flag and method
read1 read1 2drop
read-png-string read-png-string read-png-string
] with-byte-reader itext boa ;
: parse-iccp-chunk ( loading-png -- loading-png ) : parse-iccp-chunk ( loading-png -- loading-png )
dup "iCCP" find-chunk [ dup "iCCP" find-chunk [
data>> <icc-profile> >>icc-profile data>> <icc-profile> >>icc-profile
] when* ; ] when* ;
: parse-itext-chunks ( loading-png -- loading-png )
dup "iTXt" find-chunks [ data>> <itext> ] map >>itexts ;
: find-compressed-bytes ( loading-png -- bytes ) : find-compressed-bytes ( loading-png -- bytes )
"IDAT" find-chunks [ data>> ] map concat ; "IDAT" find-chunks [ data>> ] map concat ;
@ -368,6 +381,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
read-png-chunks read-png-chunks
parse-ihdr-chunk parse-ihdr-chunk
parse-iccp-chunk parse-iccp-chunk
parse-itext-chunks
] throw-on-eof ] throw-on-eof
] with-input-stream ; ] with-input-stream ;