lzw: integrating with gif and tiff
parent
e006b62962
commit
64c93d873f
|
@ -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 ;
|
||||
|
||||
: <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 ;
|
||||
|
@ -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:<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 ;
|
||||
|
|
|
@ -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" ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Loading…
Reference in New Issue