diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index 46a319662e..d186ad047c 100644 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -1,39 +1,29 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.accessors assocs byte-arrays combinators -io.encodings.binary io.streams.byte-array kernel math sequences -vectors ; +USING: accessors combinators io kernel math namespaces +prettyprint sequences vectors ; +QUALIFIED-WITH: bitstreams bs IN: compression.lzw -QUALIFIED-WITH: bitstreams bs +SYMBOL: clear-code +4 clear-code set-global -CONSTANT: clear-code 256 -CONSTANT: end-of-information 257 +SYMBOL: end-of-information +5 end-of-information set-global -TUPLE: lzw input output table code old-code ; - -SYMBOL: table-full - -: lzw-bit-width ( n -- n' ) - { - { [ dup 510 <= ] [ drop 9 ] } - { [ dup 1022 <= ] [ drop 10 ] } - { [ dup 2046 <= ] [ drop 11 ] } - { [ dup 4094 <= ] [ drop 12 ] } - [ drop table-full ] - } cond ; - -: lzw-bit-width-uncompress ( lzw -- n ) - table>> length lzw-bit-width ; +TUPLE: lzw input output table code old-code initial-code-size code-size ; : initial-uncompress-table ( -- seq ) - 258 iota [ 1vector ] V{ } map-as ; + end-of-information get 1 + iota [ 1vector ] V{ } map-as ; : reset-lzw-uncompress ( lzw -- lzw ) - initial-uncompress-table >>table ; + initial-uncompress-table >>table + dup initial-code-size>> >>code-size ; -: ( input -- obj ) +: ( input code-size -- obj ) lzw new + swap >>initial-code-size + dup initial-code-size>> >>code-size swap >>input BV{ } clone >>output reset-lzw-uncompress ; @@ -55,15 +45,28 @@ ERROR: not-in-table value ; : write-code ( lzw -- ) [ lookup-code ] [ output>> ] bi push-all ; -: add-to-table ( seq lzw -- ) table>> push ; +: kdebug ( lzw -- lzw ) + dup "TIFF: 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^ 1 - ] 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 ) - [ ] [ lzw-bit-width-uncompress ] [ input>> ] tri bs:read ; + [ ] [ 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 = [ + lzw-read dup end-of-information get = [ 2drop ] [ >>code @@ -91,10 +94,10 @@ DEFER: lzw-uncompress-char : lzw-uncompress-char ( lzw -- ) lzw-read [ >>code - dup code>> end-of-information = [ + dup code>> end-of-information get = [ drop ] [ - dup code>> clear-code = [ + dup code>> clear-code get = [ handle-clear-code ] [ handle-uncompress-code @@ -105,7 +108,19 @@ DEFER: lzw-uncompress-char drop ] if* ; -: lzw-uncompress ( seq -- byte-array ) - bs: +: 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/basis/images/tiff/tiff-tests.factor b/basis/images/tiff/tiff-tests.factor index 9905e7ad79..7a27a98251 100755 --- a/basis/images/tiff/tiff-tests.factor +++ b/basis/images/tiff/tiff-tests.factor @@ -1,10 +1,44 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test images.tiff ; +USING: accessors images.tiff images.viewer io +io.encodings.binary io.files namespaces sequences tools.test ; IN: images.tiff.tests -: tiff-test-path ( -- path ) - "resource:extra/images/test-images/rgb.tiff" ; +: path>tiff ( path -- tiff ) + binary [ input-stream get load-tiff ] with-file-reader ; + +: tiff-example1 ( -- tiff ) + "resource:extra/images/testing/square.tiff" path>tiff ; + +: tiff-example2 ( -- tiff ) + "resource:extra/images/testing/cube.tiff" path>tiff ; + +: tiff-example3 ( -- tiff ) + "resource:extra/images/testing/bi.tiff" path>tiff ; + +: tiff-example4 ( -- tiff ) + "resource:extra/images/testing/noise.tiff" path>tiff ; + +: tiff-example5 ( -- tiff ) + "resource:extra/images/testing/alpha.tiff" path>tiff ; + +: tiff-example6 ( -- tiff ) + "resource:extra/images/testing/color_spectrum.tiff" path>tiff ; + +: tiff-example7 ( -- tiff ) + "resource:extra/images/testing/small.tiff" path>tiff ; + +: tiff-all. ( -- ) + { + tiff-example1 tiff-example2 tiff-example3 tiff-example4 tiff-example5 + tiff-example6 + } + [ execute( -- gif ) tiff>image image. ] each ; + +[ 1024 ] [ tiff-example1 ifds>> first bitmap>> length ] unit-test +[ 1024 ] [ tiff-example2 ifds>> first bitmap>> length ] unit-test +[ 131744 ] [ tiff-example3 ifds>> first bitmap>> length ] unit-test +[ 49152 ] [ tiff-example4 ifds>> first bitmap>> length ] unit-test +[ 16 ] [ tiff-example5 ifds>> first bitmap>> length ] unit-test +[ 117504 ] [ tiff-example6 ifds>> first bitmap>> length ] unit-test -: tiff-test-path2 ( -- path ) - "resource:extra/images/test-images/octagon.tiff" ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index c589349dff..da03f455b5 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -434,10 +434,13 @@ 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-uncompress ] map ] } + { compression-lzw [ [ lzw-tiff-uncompress ] map ] } [ unhandled-compression ] } case ; diff --git a/extra/compression/lzw-gif/lzw-gif.factor b/extra/compression/lzw-gif/lzw-gif.factor index 01e94d5114..8961abbf44 100644 --- a/extra/compression/lzw-gif/lzw-gif.factor +++ b/extra/compression/lzw-gif/lzw-gif.factor @@ -45,9 +45,15 @@ ERROR: not-in-table value ; : 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 = - [ [ 1 + ] change-code-size ] when ; + [ kdebug [ 1 + ] change-code-size ] when ; : add-to-table ( seq lzw -- ) [ table>> push ] @@ -58,6 +64,7 @@ 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 = [ 2drop diff --git a/extra/images/testing/alpha.tiff b/extra/images/testing/alpha.tiff new file mode 100644 index 0000000000..27215d6f0f Binary files /dev/null and b/extra/images/testing/alpha.tiff differ diff --git a/extra/images/testing/bi.tiff b/extra/images/testing/bi.tiff new file mode 100644 index 0000000000..ad0ce97cc0 Binary files /dev/null and b/extra/images/testing/bi.tiff differ diff --git a/extra/images/testing/color_spectrum.tiff b/extra/images/testing/color_spectrum.tiff new file mode 100644 index 0000000000..f596deb0f2 Binary files /dev/null and b/extra/images/testing/color_spectrum.tiff differ diff --git a/extra/images/testing/cube.tiff b/extra/images/testing/cube.tiff new file mode 100644 index 0000000000..eef52e32d8 Binary files /dev/null and b/extra/images/testing/cube.tiff differ diff --git a/extra/images/testing/noise.tiff b/extra/images/testing/noise.tiff new file mode 100644 index 0000000000..2958b0b838 Binary files /dev/null and b/extra/images/testing/noise.tiff differ diff --git a/extra/images/testing/small.tiff b/extra/images/testing/small.tiff new file mode 100644 index 0000000000..7051d58218 Binary files /dev/null and b/extra/images/testing/small.tiff differ diff --git a/extra/images/testing/square.tiff b/extra/images/testing/square.tiff new file mode 100644 index 0000000000..16e94f70b8 Binary files /dev/null and b/extra/images/testing/square.tiff differ