steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
basis/compression/lzw/lzw.factor
View File

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