! 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 ;
-IN: compression.lzw
-
+USING: accessors combinators io kernel math namespaces
+prettyprint sequences vectors ;
QUALIFIED-WITH: bitstreams bs
+IN: compression.lzw
-CONSTANT: clear-code 256
-CONSTANT: end-of-information 257
-
-TUPLE: lzw input output table code old-code ;
-
-SYMBOL: table-full
+SYMBOL: clear-code
+4 clear-code set-global
-: 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 ;
+SYMBOL: end-of-information
+5 end-of-information set-global
-: 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 ;
-: <lzw-uncompress> ( input -- obj )
+: <lzw-uncompress> ( input code-size -- obj )
lzw new
+ swap >>initial-code-size
+ dup initial-code-size>> >>code-size
swap >>input
BV{ } clone >>output
reset-lzw-uncompress ;
: 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
: 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
drop
] if* ;
-: lzw-uncompress ( seq -- byte-array )
- bs:<msb0-bit-reader>
+: 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>
[ lzw-uncompress-char ] [ output>> ] bi ;
+
+: lzw-uncompress-msb0 ( seq code-size -- byte-array )
+ [ bs:<msb0-bit-reader> ] dip lzw-uncompress ;
+
+: lzw-uncompress-lsb0 ( seq code-size -- byte-array )
+ [ bs:<lsb0-bit-reader> ] dip lzw-uncompress ;
! 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" ;