diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index 9fae7f4f40..43752584d3 100644 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -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 ; : ( 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 ) - dup current-lzw [ - [ reset-lzw-uncompress drop ] [ lzw-uncompress-char ] [ output>> ] tri - ] with-variable ; + + [ lzw-uncompress-char ] [ output>> ] bi ; : tiff-lzw-uncompress ( seq -- byte-array ) bs: 9 tiff-lzw lzw-uncompress ;