images.png: Support for reading iCCP chunks with color profiles

To fix #1529 you need to read the color profile from the image and then
do something with it.

diff --git a/extra/images/png/png-tests.factor b/extra/images/png/png-tests.factor
index 7379f8a2bc33444135d79383cec8d1864ba25d9a..3c0511d742f571140ba73c57ded28a1fd6c63bca 100644 (file)
--- a/extra/images/png/png-tests.factor
+++ b/extra/images/png/png-tests.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman, Keith Lazuka
 ! See http://factorcode.org/license.txt for BSD license.
-USING: images.testing io.directories images.png sequences ;
+USING: accessors images.png images.testing io.directories
+io.encodings.binary io.files sequences tools.test ;
 IN: images.png.tests
 
 ! Test files from PngSuite (http://www.libpng.org/pub/png/pngsuite.html)
@@ -75,6 +76,10 @@ IN: images.png.tests
         "z06n2c08.png"
         "z09n2c08.png"
     } [ png-image decode-test ] each
+
+    { "ICC Profile" } [
+        "1529.png" binary <file-reader> load-png icc-profile>> name>>
+    ] unit-test
 ] with-directory
 
 ! Test pngsuite
@@ -245,7 +250,6 @@ IN: images.png.tests
         "z06n2c08.png"
         "z09n2c08.png"
     } [ png-image decode-test ] each
-
 ] with-directory
 
 "vocab:images/testing/png/suite/bads" [

diff --git a/extra/images/png/png.factor b/extra/images/png/png.factor
index 89c63ab4d60056c28d7e15154a10217544dc5eb2..bb45c09cfcf4946be4a097cf67b17d35a9e3c477 100644 (file)
--- a/extra/images/png/png.factor
+++ b/extra/images/png/png.factor
@@ -1,21 +1,22 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays checksums
-checksums.crc32 combinators compression.inflate fry grouping
-images images.loader io io.binary io.encodings.ascii
-io.encodings.binary io.encodings.string io.streams.byte-array
-io.streams.throwing kernel locals math math.bitwise
-math.functions math.order math.ranges sequences sorting ;
+USING: accessors arrays assocs checksums checksums.crc32 combinators
+compression.inflate fry grouping images images.loader io io.binary
+io.encodings.8-bit.latin1 io.encodings.ascii io.encodings.binary
+io.encodings.string io.streams.byte-array io.streams.throwing kernel
+locals math math.bitwise math.functions sequences sorting splitting ;
 QUALIFIED: bitstreams
 IN: images.png
 
 SINGLETON: png-image
 "png" png-image ?register-image-class
 
+TUPLE: icc-profile name data ;
+
 TUPLE: loading-png
     chunks
     width height bit-depth color-type compression-method
-    filter-method interlace-method uncompressed ;
+    filter-method interlace-method icc-profile ;
 
 CONSTANT: filter-none 0
 CONSTANT: filter-sub 1
@@ -77,6 +78,9 @@ ERROR: bad-checksum ;
 : find-chunks ( loading-png string -- chunk )
     [ chunks>> ] dip '[ type>> _ = ] filter ;
 
+: read-png-string ( -- str )
+    { 0 } read-until drop latin1 decode ;
+
 : parse-ihdr-chunk ( loading-png -- loading-png )
     dup "IHDR" find-chunk data>> {
         [ [ 0 4 ] dip subseq be> >>width ]
@@ -88,6 +92,16 @@ ERROR: bad-checksum ;
         [ [ 12 ] dip nth >>interlace-method ]
     } cleave ;
 
+: <icc-profile> ( byte-array -- icc-profile )
+    binary [
+        read-png-string read1 drop contents zlib-inflate
+    ] with-byte-reader icc-profile boa ;
+
+: parse-iccp-chunk ( loading-png -- loading-png )
+    dup "iCCP" find-chunk [
+        data>> <icc-profile> >>icc-profile
+    ] when* ;
+
 : find-compressed-bytes ( loading-png -- bytes )
     "IDAT" find-chunks [ data>> ] map concat ;
 
@@ -353,6 +367,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
             read-png-header
             read-png-chunks
             parse-ihdr-chunk
+            parse-iccp-chunk
         ] throw-on-eof
     ] with-input-stream ;