From 2b91a3e083998925f9d8843b3ede6d2fb3d41148 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sat, 7 May 2016 15:07:22 +0200
Subject: [PATCH] images.png: support for reading iTXt chunks

---
 extra/images/png/png-tests.factor | 14 ++++++++++++--
 extra/images/png/png.factor       | 16 +++++++++++++++-
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/extra/images/png/png-tests.factor b/extra/images/png/png-tests.factor
index 3c0511d742..df156c8f78 100644
--- a/extra/images/png/png-tests.factor
+++ b/extra/images/png/png-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman, Keith Lazuka
 ! See http://factorcode.org/license.txt for BSD license.
 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
 
 ! 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
 
     { "ICC Profile" } [
-        "1529.png" binary <file-reader> load-png icc-profile>> name>>
+        "1529.png" binary <file-reader> load-png
+        icc-profile>> name>>
     ] 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
 
 ! Test pngsuite
diff --git a/extra/images/png/png.factor b/extra/images/png/png.factor
index bb45c09cfc..d08d0eeeb1 100644
--- a/extra/images/png/png.factor
+++ b/extra/images/png/png.factor
@@ -13,10 +13,12 @@ SINGLETON: png-image
 
 TUPLE: icc-profile name data ;
 
+TUPLE: itext keyword language translated-keyword text ;
+
 TUPLE: loading-png
     chunks
     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-sub 1
@@ -97,11 +99,22 @@ ERROR: bad-checksum ;
         read-png-string read1 drop contents zlib-inflate
     ] 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 )
     dup "iCCP" find-chunk [
         data>> <icc-profile> >>icc-profile
     ] when* ;
 
+: parse-itext-chunks ( loading-png -- loading-png )
+    dup "iTXt" find-chunks [ data>> <itext> ] map >>itexts ;
+
 : find-compressed-bytes ( loading-png -- bytes )
     "IDAT" find-chunks [ data>> ] map concat ;
 
@@ -368,6 +381,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
             read-png-chunks
             parse-ihdr-chunk
             parse-iccp-chunk
+            parse-itext-chunks
         ] throw-on-eof
     ] with-input-stream ;