From 8dec2070e5a8aa497fbb7a0817f22d1ef4fc5d1f Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Fri, 25 Sep 2009 16:51:47 -0400 Subject: [PATCH] compression.lzw: supports both TIFF and GIF --- basis/compression/lzw/lzw.factor | 78 +++++++------- basis/images/tiff/tiff.factor | 5 +- extra/compression/lzw-gif/lzw-gif.factor | 126 ----------------------- extra/images/gif/gif-tests.factor | 4 +- extra/images/gif/gif.factor | 4 +- 5 files changed, 46 insertions(+), 171 deletions(-) delete mode 100644 extra/compression/lzw-gif/lzw-gif.factor diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index d186ad047c..9fae7f4f40 100644 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -5,28 +5,38 @@ prettyprint sequences vectors ; QUALIFIED-WITH: bitstreams bs IN: compression.lzw -SYMBOL: clear-code -4 clear-code set-global +SYMBOL: current-lzw -SYMBOL: end-of-information -5 end-of-information set-global +TUPLE: lzw +input +output +table +code +old-code +initial-code-size +code-size +clear-code +end-of-information-code ; -TUPLE: lzw input output table code old-code initial-code-size code-size ; +TUPLE: tiff-lzw < lzw ; +TUPLE: gif-lzw < lzw ; : initial-uncompress-table ( -- seq ) - end-of-information get 1 + iota [ 1vector ] V{ } map-as ; + current-lzw get end-of-information-code>> 1 + + iota [ 1vector ] V{ } map-as ; : reset-lzw-uncompress ( lzw -- lzw ) initial-uncompress-table >>table dup initial-code-size>> >>code-size ; -: ( input code-size -- obj ) - lzw new - swap >>initial-code-size - dup initial-code-size>> >>code-size +: ( input code-size class -- obj ) + new + swap >>code-size + dup code-size>> >>initial-code-size + dup code-size>> 1 - 2^ >>clear-code + dup clear-code>> 1 + >>end-of-information-code swap >>input - BV{ } clone >>output - reset-lzw-uncompress ; + BV{ } clone >>output ; ERROR: not-in-table value ; @@ -45,15 +55,16 @@ ERROR: not-in-table value ; : write-code ( lzw -- ) [ lookup-code ] [ output>> ] bi push-all ; -: kdebug ( lzw -- lzw ) - dup "TIFF: incrementing code size " write - [ code-size>> pprint ] - [ " table length " write table>> length pprint ] bi - nl ; +GENERIC: code-space-full? ( lzw -- ? ) + +M: tiff-lzw code-space-full? + [ table>> length ] [ code-size>> 2^ 1 - ] bi = ; + +M: gif-lzw code-space-full? + [ table>> length ] [ code-size>> 2^ ] bi = ; : maybe-increment-code-size ( lzw -- lzw ) - dup [ table>> length ] [ code-size>> 2^ 1 - ] bi = - [ kdebug [ 1 + ] change-code-size ] when ; + dup code-space-full? [ [ 1 + ] change-code-size ] when ; : add-to-table ( seq lzw -- ) [ table>> push ] @@ -64,9 +75,8 @@ ERROR: not-in-table value ; DEFER: lzw-uncompress-char : handle-clear-code ( lzw -- ) - "CLEAR CODE" print reset-lzw-uncompress - lzw-read dup end-of-information get = [ + lzw-read dup current-lzw get end-of-information-code>> = [ 2drop ] [ >>code @@ -94,10 +104,10 @@ DEFER: lzw-uncompress-char : lzw-uncompress-char ( lzw -- ) lzw-read [ >>code - dup code>> end-of-information get = [ + dup code>> current-lzw get end-of-information-code>> = [ drop ] [ - dup code>> clear-code get = [ + dup code>> current-lzw get clear-code>> = [ handle-clear-code ] [ handle-uncompress-code @@ -108,19 +118,13 @@ DEFER: lzw-uncompress-char drop ] if* ; -: register-special-codes ( first-code-size -- first-code-size ) - [ - 1 - 2^ dup clear-code set - 1 + end-of-information set - ] keep ; +: lzw-uncompress ( bitstream code-size class -- byte-array ) + dup current-lzw [ + [ reset-lzw-uncompress drop ] [ lzw-uncompress-char ] [ output>> ] tri + ] with-variable ; -: lzw-uncompress ( bitstream code-size -- byte-array ) - register-special-codes - - [ lzw-uncompress-char ] [ output>> ] bi ; +: tiff-lzw-uncompress ( seq -- byte-array ) + bs: 9 tiff-lzw lzw-uncompress ; -: lzw-uncompress-msb0 ( seq code-size -- byte-array ) - [ bs: ] dip lzw-uncompress ; - -: lzw-uncompress-lsb0 ( seq code-size -- byte-array ) - [ bs: ] dip lzw-uncompress ; +: gif-lzw-uncompress ( seq code-size -- byte-array ) + [ bs: ] dip gif-lzw lzw-uncompress ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index da03f455b5..d8f7b09ed7 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -434,13 +434,10 @@ ERROR: bad-small-ifd-type n ; ERROR: unhandled-compression compression ; -: lzw-tiff-uncompress ( seq -- byte-array ) - 9 lzw-uncompress-msb0 ; - : (uncompress-strips) ( strips compression -- uncompressed-strips ) { { compression-none [ ] } - { compression-lzw [ [ lzw-tiff-uncompress ] map ] } + { compression-lzw [ [ tiff-lzw-uncompress ] map ] } [ unhandled-compression ] } case ; diff --git a/extra/compression/lzw-gif/lzw-gif.factor b/extra/compression/lzw-gif/lzw-gif.factor deleted file mode 100644 index 8961abbf44..0000000000 --- a/extra/compression/lzw-gif/lzw-gif.factor +++ /dev/null @@ -1,126 +0,0 @@ -! Copyright (C) 2009 Doug Coleman, Keith Lazuka -! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io kernel math namespaces -prettyprint sequences vectors ; -QUALIFIED-WITH: bitstreams bs -IN: compression.lzw-gif - -SYMBOL: clear-code -4 clear-code set-global - -SYMBOL: end-of-information -5 end-of-information set-global - -TUPLE: lzw input output table code old-code initial-code-size code-size ; - -: initial-uncompress-table ( -- seq ) - end-of-information get 1 + iota [ 1vector ] V{ } map-as ; - -: reset-lzw-uncompress ( lzw -- lzw ) - initial-uncompress-table >>table - dup initial-code-size>> >>code-size ; - -: ( input code-size -- obj ) - lzw new - swap >>initial-code-size - dup initial-code-size>> >>code-size - swap >>input - BV{ } clone >>output - reset-lzw-uncompress ; - -ERROR: not-in-table value ; - -: lookup-old-code ( lzw -- vector ) - [ old-code>> ] [ table>> ] bi nth ; - -: lookup-code ( lzw -- vector ) - [ code>> ] [ table>> ] bi nth ; - -: code-in-table? ( lzw -- ? ) - [ code>> ] [ table>> length ] bi < ; - -: code>old-code ( lzw -- lzw ) - dup code>> >>old-code ; - -: write-code ( lzw -- ) - [ lookup-code ] [ output>> ] bi push-all ; - -: kdebug ( lzw -- lzw ) - dup "GIF: incrementing code size " write - [ code-size>> pprint ] - [ " table length " write table>> length pprint ] bi - nl ; - -: maybe-increment-code-size ( lzw -- lzw ) - dup [ table>> length ] [ code-size>> 2^ ] bi = - [ kdebug [ 1 + ] change-code-size ] when ; - -: add-to-table ( seq lzw -- ) - [ table>> push ] - [ maybe-increment-code-size 2drop ] 2bi ; - -: lzw-read ( lzw -- lzw n ) - [ ] [ code-size>> ] [ input>> ] tri bs:read ; - -DEFER: lzw-uncompress-char -: handle-clear-code ( lzw -- ) - "CLEAR CODE" print - reset-lzw-uncompress - lzw-read dup end-of-information get = [ - 2drop - ] [ - >>code - [ write-code ] - [ code>old-code ] bi - lzw-uncompress-char - ] if ; - -: handle-uncompress-code ( lzw -- lzw ) - dup code-in-table? [ - [ write-code ] - [ - [ - [ lookup-old-code ] - [ lookup-code first ] bi suffix - ] [ add-to-table ] bi - ] [ code>old-code ] tri - ] [ - [ - [ lookup-old-code dup first suffix ] keep - [ output>> push-all ] [ add-to-table ] 2bi - ] [ code>old-code ] bi - ] if ; - -: lzw-uncompress-char ( lzw -- ) - lzw-read [ - >>code - dup code>> end-of-information get = [ - drop - ] [ - dup code>> clear-code get = [ - handle-clear-code - ] [ - handle-uncompress-code - lzw-uncompress-char - ] if - ] if - ] [ - drop - ] if* ; - -: register-special-codes ( first-code-size -- first-code-size ) - [ - 1 - 2^ dup clear-code set - 1 + end-of-information set - ] keep ; - -: lzw-uncompress ( bitstream code-size -- byte-array ) - register-special-codes - - [ lzw-uncompress-char ] [ output>> ] bi ; - -: lzw-uncompress-msb0 ( seq code-size -- byte-array ) - [ bs: ] dip lzw-uncompress ; - -: lzw-uncompress-lsb0 ( seq code-size -- byte-array ) - [ bs: ] dip lzw-uncompress ; diff --git a/extra/images/gif/gif-tests.factor b/extra/images/gif/gif-tests.factor index 629ab300d4..87ce507b2e 100644 --- a/extra/images/gif/gif-tests.factor +++ b/extra/images/gif/gif-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Keith Lazuka. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors bitstreams compression.lzw-gif images.gif io +USING: accessors bitstreams compression.lzw images.gif io io.encodings.binary io.files kernel math math.bitwise math.parser namespaces prettyprint sequences tools.test images.viewer ; QUALIFIED-WITH: bitstreams bs @@ -49,7 +49,7 @@ IN: images.gif.tests : >index-stream ( gif -- seq ) [ compressed-bytes>> ] [ image-descriptor>> first-code-size>> ] bi - lzw-uncompress-lsb0 ; + gif-lzw-uncompress ; [ BV{ diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor index 8652e049e0..c6b42a651f 100644 --- a/extra/images/gif/gif.factor +++ b/extra/images/gif/gif.factor @@ -1,6 +1,6 @@ ! Copyrigt (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs combinators compression.lzw-gif +USING: accessors arrays assocs combinators compression.lzw constructors destructors grouping images images.loader io io.binary io.buffers io.encodings.binary io.encodings.string io.encodings.utf8 io.files io.files.info io.ports @@ -227,7 +227,7 @@ ERROR: unhandled-data byte ; : decompress ( loading-gif -- indexes ) [ compressed-bytes>> ] [ image-descriptor>> first-code-size>> ] bi - lzw-uncompress-lsb0 ; + gif-lzw-uncompress ; : colorize ( index palette transparent-index/f -- seq ) pick = [ 2drop B{ 0 0 0 0 } ] [ nth 255 suffix ] if ;