factor: trim using lists

[factor.git] / basis / compression / lzw / lzw.factor

diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor
index e017636009b2f1546ec4f7cf89bba98fc635836e..01ad507ee3851a282386bf7f6e2cd6615bf6051c 100644 (file)
--- a/basis/compression/lzw/lzw.factor
+++ b/basis/compression/lzw/lzw.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators io kernel math namespaces
-prettyprint sequences vectors ;
+USING: accessors combinators kernel math math.order
+sequences vectors ;
 QUALIFIED-WITH: bitstreams bs
 IN: compression.lzw
 
@@ -20,15 +20,17 @@ TUPLE: tiff-lzw < lzw ;
 TUPLE: gif-lzw < lzw ;
 
 : initial-uncompress-table ( size -- seq )
-    iota [ 1vector ] V{ } map-as ;
+    <iota> [ 1vector ] V{ } map-as ;
 
 : reset-lzw-uncompress ( lzw -- lzw )
     dup end-of-information-code>> 1 + initial-uncompress-table >>table
     dup initial-code-size>> >>code-size ;
 
+ERROR: code-size-zero ;
+
 : <lzw-uncompress> ( input code-size class -- obj )
     new
-        swap >>code-size
+        swap [ code-size-zero ] when-zero >>code-size
         dup code-size>> >>initial-code-size
         dup code-size>> 1 - 2^ >>clear-code
         dup clear-code>> 1 + >>end-of-information-code
@@ -36,8 +38,6 @@ TUPLE: gif-lzw < lzw ;
         BV{ } clone >>output
         reset-lzw-uncompress ;
 
-ERROR: not-in-table value ;
-
 : lookup-old-code ( lzw -- vector )
     [ old-code>> ] [ table>> ] bi nth ;
 
@@ -60,8 +60,13 @@ GENERIC: code-space-full? ( lzw -- ? )
 M: tiff-lzw code-space-full? size-and-limit 1 - = ;
 M: gif-lzw code-space-full? size-and-limit = ;
 
+GENERIC: increment-code-size ( lzw -- lzw )
+
+M: lzw increment-code-size [ 1 + ] change-code-size ;
+M: gif-lzw increment-code-size [ 1 + 12 min ] change-code-size ;
+
 : maybe-increment-code-size ( lzw -- lzw )
-    dup code-space-full? [ [ 1 + ] change-code-size ] when ;
+    dup code-space-full? [ increment-code-size ] when ;
 
 : add-to-table ( seq lzw -- )
     [ table>> push ]
@@ -76,8 +81,8 @@ M: gif-lzw code-space-full? size-and-limit = ;
 DEFER: handle-clear-code
 : lzw-process-next-code ( lzw quot: ( lzw code -- ) -- )
     [ lzw-read ] dip {
-        { [ 3dup drop end-of-information? ] [ 3drop ] }
-        { [ 3dup drop clear-code? ] [ 2drop handle-clear-code ] }
+        { [ 2over end-of-information? ] [ 3drop ] }
+        { [ 2over clear-code? ] [ 2drop handle-clear-code ] }
         [ call( lzw code -- ) ]
     } cond ; inline
 
@@ -106,7 +111,7 @@ DEFER: lzw-uncompress-char
             [ output>> push-all ] [ add-to-table ] 2bi
         ] [ code>old-code ] bi
     ] if ;
-    
+
 : lzw-uncompress-char ( lzw -- )
     [ >>code handle-uncompress-code lzw-uncompress-char ]
     lzw-process-next-code ;