QUALIFIED-WITH: bitstreams bs
IN: compression.lzw
-SYMBOL: current-lzw
-
TUPLE: lzw
input
output
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 )
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 ;
: 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? [
] 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 ;