compression.lzw: refactored and simplified

db4
Keith Lazuka 2009-09-26 13:09:12 -04:00
parent 8dec2070e5
commit c1fbca1509
1 changed files with 20 additions and 28 deletions

View File

@ -5,8 +5,6 @@ prettyprint sequences vectors ;
QUALIFIED-WITH: bitstreams bs
IN: compression.lzw
SYMBOL: current-lzw
TUPLE: lzw
input
output
@ -21,12 +19,11 @@ end-of-information-code ;
TUPLE: tiff-lzw < lzw ;
TUPLE: gif-lzw < lzw ;
: initial-uncompress-table ( -- seq )
current-lzw get end-of-information-code>> 1 +
: initial-uncompress-table ( size -- seq )
iota [ 1vector ] V{ } map-as ;
: reset-lzw-uncompress ( lzw -- lzw )
initial-uncompress-table >>table
dup end-of-information-code>> 1 + initial-uncompress-table >>table
dup initial-code-size>> >>code-size ;
: <lzw-uncompress> ( input code-size class -- obj )
@ -36,7 +33,8 @@ TUPLE: gif-lzw < lzw ;
dup code-size>> 1 - 2^ >>clear-code
dup clear-code>> 1 + >>end-of-information-code
swap >>input
BV{ } clone >>output ;
BV{ } clone >>output
reset-lzw-uncompress ;
ERROR: not-in-table value ;
@ -73,17 +71,26 @@ M: gif-lzw code-space-full?
: lzw-read ( lzw -- lzw n )
[ ] [ code-size>> ] [ input>> ] tri bs:read ;
: end-of-information? ( lzw code -- ? ) swap end-of-information-code>> = ;
: clear-code? ( lzw code -- ? ) swap clear-code>> = ;
DEFER: handle-clear-code
: lzw-read* ( lzw quot: ( lzw code -- ) -- )
[ lzw-read ] dip {
{ [ 3dup drop end-of-information? ] [ 3drop ] }
{ [ 3dup drop clear-code? ] [ 2drop handle-clear-code ] }
[ call( lzw code -- ) ]
} cond ; inline
DEFER: lzw-uncompress-char
: handle-clear-code ( lzw -- )
reset-lzw-uncompress
lzw-read dup current-lzw get end-of-information-code>> = [
2drop
] [
[
>>code
[ write-code ]
[ code>old-code ] bi
lzw-uncompress-char
] if ;
] lzw-read* ;
: handle-uncompress-code ( lzw -- lzw )
dup code-in-table? [
@ -102,26 +109,11 @@ DEFER: lzw-uncompress-char
] if ;
: lzw-uncompress-char ( lzw -- )
lzw-read [
>>code
dup code>> current-lzw get end-of-information-code>> = [
drop
] [
dup code>> current-lzw get clear-code>> = [
handle-clear-code
] [
handle-uncompress-code
lzw-uncompress-char
] if
] if
] [
drop
] if* ;
[ >>code handle-uncompress-code lzw-uncompress-char ] lzw-read* ;
: 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>
[ lzw-uncompress-char ] [ output>> ] bi ;
: tiff-lzw-uncompress ( seq -- byte-array )
bs:<msb0-bit-reader> 9 tiff-lzw lzw-uncompress ;