From 6ffe298189c5c16d0515b696a8d1d6fa0aec57d9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 12 Feb 2009 17:44:15 -0600
Subject: [PATCH] support lzw uncompression in images.tiff

---
 basis/images/images.factor    |  3 +--
 basis/images/tiff/tiff.factor | 22 ++++++++++++++++++++--
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/basis/images/images.factor b/basis/images/images.factor
index a2d90cc131..46c0936644 100644
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -17,8 +17,7 @@ GENERIC: load-image* ( path tuple -- image )
         { RGBA [ ] }
         { BGRA [
             [
-                [ 4 <sliced-groups> [ [ 0 3 ] dip <slice> reverse-here ] each ]
-                [ RGBA >>component-order ] bi
+                4 <sliced-groups> dup [ [ 0 3 ] dip <slice> reverse-here ] each
             ] change-bitmap
         ] }
         { RGB [
diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index b4daf675f1..0b749d0ade 100755
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -3,7 +3,7 @@
 USING: accessors combinators io io.encodings.binary io.files kernel
 pack endian constructors sequences arrays math.order math.parser
 prettyprint classes io.binary assocs math math.bitwise byte-arrays
-grouping images ;
+grouping images compression.lzw fry ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -256,6 +256,20 @@ ERROR: bad-small-ifd-type n ;
     dup ifd-entries>>
     [ process-ifd-entry swap ] H{ } map>assoc >>processed-tags ;
 
+ERROR: unhandled-compression compression ;
+
+: (uncompress-strips) ( strips compression -- uncompressed-strips )
+    {
+        { compression-none [ ] }
+        { compression-lzw [ [ lzw-uncompress ] map ] }
+        [ unhandled-compression ]
+    } case ;
+
+: uncompress-strips ( ifd -- ifd )
+    dup '[
+        _ compression find-tag (uncompress-strips)
+    ] change-strips ;
+
 : strips>bitmap ( ifd -- ifd )
     dup strips>> concat >>bitmap ;
 
@@ -284,7 +298,11 @@ ERROR: unknown-component-order ifd ;
         <parsed-tiff>
         read-header dup endianness>> [
             read-ifds
-            dup ifds>> [ process-ifd read-strips strips>bitmap drop ] each
+            dup ifds>> [
+                process-ifd read-strips
+                uncompress-strips
+                strips>bitmap drop
+            ] each
         ] with-endianness
     ] with-file-reader ;