compression.lzw: supports both TIFF and GIF

diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor
index d186ad047cd3d0185bdbcfd99227c0ec40d35170..9fae7f4f40c66cf002bb4895b80cbc26997ddc9e 100644 (file)
--- a/basis/compression/lzw/lzw.factor
+++ b/basis/compression/lzw/lzw.factor
@@ -5,28 +5,38 @@ prettyprint sequences vectors ;
 QUALIFIED-WITH: bitstreams bs
 IN: compression.lzw
 
-SYMBOL: clear-code
-4 clear-code set-global
-
-SYMBOL: end-of-information
-5 end-of-information set-global
-
-TUPLE: lzw input output table code old-code initial-code-size code-size ;
+SYMBOL: current-lzw
+
+TUPLE: lzw
+input
+output
+table
+code
+old-code
+initial-code-size
+code-size
+clear-code
+end-of-information-code ;
+
+TUPLE: tiff-lzw < lzw ;
+TUPLE: gif-lzw < lzw ;
 
 : initial-uncompress-table ( -- seq )
-    end-of-information get 1 + iota [ 1vector ] V{ } map-as ;
+    current-lzw get end-of-information-code>> 1 +
+    iota [ 1vector ] V{ } map-as ;
 
 : reset-lzw-uncompress ( lzw -- lzw )
     initial-uncompress-table >>table
     dup initial-code-size>> >>code-size ;
 
-: <lzw-uncompress> ( input code-size -- obj )
-    lzw new
-        swap >>initial-code-size
-        dup initial-code-size>> >>code-size
+: <lzw-uncompress> ( input code-size class -- obj )
+    new
+        swap >>code-size
+        dup code-size>> >>initial-code-size
+        dup code-size>> 1 - 2^ >>clear-code
+        dup clear-code>> 1 + >>end-of-information-code
         swap >>input
-        BV{ } clone >>output
-        reset-lzw-uncompress ;
+        BV{ } clone >>output ;
 
 ERROR: not-in-table value ;
 
@@ -45,15 +55,16 @@ ERROR: not-in-table value ;
 : write-code ( lzw -- )
     [ lookup-code ] [ output>> ] bi push-all ;
 
-: kdebug ( lzw -- lzw )
-    dup "TIFF: incrementing code size " write
-    [ code-size>> pprint ] 
-    [ " table length " write table>> length pprint ] bi
-    nl ;
+GENERIC: code-space-full? ( lzw -- ? )
+
+M: tiff-lzw code-space-full?
+    [ table>> length ] [ code-size>> 2^ 1 - ] bi = ;
+
+M: gif-lzw code-space-full?
+    [ table>> length ] [ code-size>> 2^ ] bi = ;
 
 : maybe-increment-code-size ( lzw -- lzw )
-    dup [ table>> length ] [ code-size>> 2^ 1 - ] bi =
-    [ kdebug [ 1 + ] change-code-size ] when ;
+    dup code-space-full? [ [ 1 + ] change-code-size ] when ;
 
 : add-to-table ( seq lzw -- )
     [ table>> push ]
@@ -64,9 +75,8 @@ ERROR: not-in-table value ;
 
 DEFER: lzw-uncompress-char
 : handle-clear-code ( lzw -- )
-    "CLEAR CODE" print
     reset-lzw-uncompress
-    lzw-read dup end-of-information get = [
+    lzw-read dup current-lzw get end-of-information-code>> = [
         2drop
     ] [
         >>code
@@ -94,10 +104,10 @@ DEFER: lzw-uncompress-char
 : lzw-uncompress-char ( lzw -- )
     lzw-read [
         >>code
-        dup code>> end-of-information get = [
+        dup code>> current-lzw get end-of-information-code>> = [
             drop
         ] [
-            dup code>> clear-code get = [
+            dup code>> current-lzw get clear-code>> = [
                 handle-clear-code
             ] [
                 handle-uncompress-code
@@ -108,19 +118,13 @@ DEFER: lzw-uncompress-char
         drop
     ] if* ;
 
-: register-special-codes ( first-code-size -- first-code-size )
-    [
-        1 - 2^ dup clear-code set
-        1 + end-of-information set
-    ] keep ;
-
-: lzw-uncompress ( bitstream code-size -- byte-array )
-    register-special-codes
-    <lzw-uncompress>
-    [ lzw-uncompress-char ] [ output>> ] bi ;
+: lzw-uncompress ( bitstream code-size class -- byte-array )
+    <lzw-uncompress> dup current-lzw [
+        [ reset-lzw-uncompress drop ] [ lzw-uncompress-char ] [ output>> ] tri
+    ] with-variable ;
 
-: lzw-uncompress-msb0 ( seq code-size -- byte-array )
-    [ bs:<msb0-bit-reader> ] dip lzw-uncompress ;
+: tiff-lzw-uncompress ( seq -- byte-array )
+    bs:<msb0-bit-reader> 9 tiff-lzw lzw-uncompress ;
 
-: lzw-uncompress-lsb0 ( seq code-size -- byte-array )
-    [ bs:<lsb0-bit-reader> ] dip lzw-uncompress ;
+: gif-lzw-uncompress ( seq code-size -- byte-array )
+    [ bs:<lsb0-bit-reader> ] dip gif-lzw lzw-uncompress ;

diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index da03f455b5823af5a52b75f510c798f91356dff6..d8f7b09ed7d36378ee4038aa2f5622c49ae25119 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -434,13 +434,10 @@ ERROR: bad-small-ifd-type n ;
 
 ERROR: unhandled-compression compression ;
 
-: lzw-tiff-uncompress ( seq -- byte-array )
-    9 lzw-uncompress-msb0 ;
-
 : (uncompress-strips) ( strips compression -- uncompressed-strips )
     {
         { compression-none [ ] }
-        { compression-lzw [ [ lzw-tiff-uncompress ] map ] }
+        { compression-lzw [ [ tiff-lzw-uncompress ] map ] }
         [ unhandled-compression ]
     } case ;
 

diff --git a/extra/compression/lzw-gif/lzw-gif.factor b/extra/compression/lzw-gif/lzw-gif.factor
deleted file mode 100644 (file)
index 8961abb..0000000
--- a/extra/compression/lzw-gif/lzw-gif.factor
+++ /dev/null
@@ -1,126 +0,0 @@
-! Copyright (C) 2009 Doug Coleman, Keith Lazuka
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators io kernel math namespaces
-prettyprint sequences vectors ;
-QUALIFIED-WITH: bitstreams bs
-IN: compression.lzw-gif
-
-SYMBOL: clear-code
-4 clear-code set-global
-
-SYMBOL: end-of-information
-5 end-of-information set-global
-
-TUPLE: lzw input output table code old-code initial-code-size code-size ;
-
-: initial-uncompress-table ( -- seq )
-    end-of-information get 1 + iota [ 1vector ] V{ } map-as ;
-
-: reset-lzw-uncompress ( lzw -- lzw )
-    initial-uncompress-table >>table
-    dup initial-code-size>> >>code-size ;
-
-: <lzw-uncompress> ( input code-size -- obj )
-    lzw new
-        swap >>initial-code-size
-        dup initial-code-size>> >>code-size
-        swap >>input
-        BV{ } clone >>output
-        reset-lzw-uncompress ;
-
-ERROR: not-in-table value ;
-
-: lookup-old-code ( lzw -- vector )
-    [ old-code>> ] [ table>> ] bi nth ;
-
-: lookup-code ( lzw -- vector )
-    [ code>> ] [ table>> ] bi nth ;
-
-: code-in-table? ( lzw -- ? )
-    [ code>> ] [ table>> length ] bi < ;
-
-: code>old-code ( lzw -- lzw )
-    dup code>> >>old-code ;
-
-: write-code ( lzw -- )
-    [ lookup-code ] [ output>> ] bi push-all ;
-
-: kdebug ( lzw -- lzw )
-    dup "GIF: incrementing code size " write
-    [ code-size>> pprint ] 
-    [ " table length " write table>> length pprint ] bi
-    nl ;
-
-: maybe-increment-code-size ( lzw -- lzw )
-    dup [ table>> length ] [ code-size>> 2^ ] bi =
-    [ kdebug [ 1 + ] change-code-size ] when ;
-
-: add-to-table ( seq lzw -- )
-    [ table>> push ]
-    [ maybe-increment-code-size 2drop ] 2bi ;
-
-: lzw-read ( lzw -- lzw n )
-    [ ] [ code-size>> ] [ input>> ] tri bs:read ;
-
-DEFER: lzw-uncompress-char
-: handle-clear-code ( lzw -- )
-    "CLEAR CODE" print
-    reset-lzw-uncompress
-    lzw-read dup end-of-information get = [
-        2drop
-    ] [
-        >>code
-        [ write-code ]
-        [ code>old-code ] bi
-        lzw-uncompress-char
-    ] if ;
-
-: handle-uncompress-code ( lzw -- lzw )
-    dup code-in-table? [
-        [ write-code ]
-        [
-            [
-                [ lookup-old-code ]
-                [ lookup-code first ] bi suffix
-            ] [ add-to-table ] bi
-        ] [ code>old-code ] tri
-    ] [
-        [
-            [ lookup-old-code dup first suffix ] keep
-            [ output>> push-all ] [ add-to-table ] 2bi
-        ] [ code>old-code ] bi
-    ] if ;
-    
-: lzw-uncompress-char ( lzw -- )
-    lzw-read [
-        >>code
-        dup code>> end-of-information get = [
-            drop
-        ] [
-            dup code>> clear-code get = [
-                handle-clear-code
-            ] [
-                handle-uncompress-code
-                lzw-uncompress-char
-            ] if
-        ] if
-    ] [
-        drop
-    ] if* ;
-
-: register-special-codes ( first-code-size -- first-code-size )
-    [
-        1 - 2^ dup clear-code set
-        1 + end-of-information set
-    ] keep ;
-
-: lzw-uncompress ( bitstream code-size -- byte-array )
-    register-special-codes
-    <lzw-uncompress>
-    [ lzw-uncompress-char ] [ output>> ] bi ;
-
-: lzw-uncompress-msb0 ( seq code-size -- byte-array )
-    [ bs:<msb0-bit-reader> ] dip lzw-uncompress ;
-
-: lzw-uncompress-lsb0 ( seq code-size -- byte-array )
-    [ bs:<lsb0-bit-reader> ] dip lzw-uncompress ;

diff --git a/extra/images/gif/gif-tests.factor b/extra/images/gif/gif-tests.factor
index 629ab300d4cd52b6c07ab2079e6c5c1bc026d155..87ce507b2eff2115ef5dc3b4806105c98d5f0514 100644 (file)
--- a/extra/images/gif/gif-tests.factor
+++ b/extra/images/gif/gif-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Keith Lazuka.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors bitstreams compression.lzw-gif images.gif io
+USING: accessors bitstreams compression.lzw images.gif io
 io.encodings.binary io.files kernel math math.bitwise
 math.parser namespaces prettyprint sequences tools.test images.viewer ;
 QUALIFIED-WITH: bitstreams bs
@@ -49,7 +49,7 @@ IN: images.gif.tests
 : >index-stream ( gif -- seq )
     [ compressed-bytes>> ]
     [ image-descriptor>> first-code-size>> ] bi
-    lzw-uncompress-lsb0 ;
+    gif-lzw-uncompress ;
 
 [
     BV{

diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor
index 8652e049e04351610310c0ed0627fc7adb150c61..c6b42a651fb2b3a0b23369999ac9208f3ada8697 100644 (file)
--- a/extra/images/gif/gif.factor
+++ b/extra/images/gif/gif.factor
@@ -1,6 +1,6 @@
 ! Copyrigt (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compression.lzw-gif
+USING: accessors arrays assocs combinators compression.lzw
 constructors destructors grouping images images.loader io
 io.binary io.buffers io.encodings.binary io.encodings.string
 io.encodings.utf8 io.files io.files.info io.ports
@@ -227,7 +227,7 @@ ERROR: unhandled-data byte ;
 : decompress ( loading-gif -- indexes )
     [ compressed-bytes>> ]
     [ image-descriptor>> first-code-size>> ] bi
-    lzw-uncompress-lsb0 ;
+    gif-lzw-uncompress ;
 
 : colorize ( index palette transparent-index/f -- seq )
     pick = [ 2drop B{ 0 0 0 0 } ] [ nth 255 suffix ] if ;