images.gif: Decompression now works. Still need to implement transparency and merge with TIFF LZW code

db4
Keith Lazuka 2009-09-24 14:54:35 -04:00
parent 3cbf48cae7
commit e9c780ba28
8 changed files with 169 additions and 13 deletions

View File

@ -0,0 +1,116 @@
! 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 ;
SYMBOL: table-full
: 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 ;
: <lzw-uncompress> ( code-size input -- obj )
lzw new
swap >>input
swap >>initial-code-size
dup initial-code-size>> >>code-size
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 ;
: maybe-increment-code-size ( lzw -- lzw )
dup [ table>> length ] [ code-size>> 2^ ] bi =
[ [ 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 -- )
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 -- )
[
1 - 2^ dup clear-code set
1 + end-of-information set
] keep ;
: lzw-uncompress ( code-size seq -- byte-array )
[ register-special-codes ] dip
bs:<lsb0-bit-reader>
<lzw-uncompress>
[ lzw-uncompress-char ] [ output>> ] bi ;

View File

@ -1,14 +1,16 @@
! Copyright (C) 2009 Keith Lazuka.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors images.gif io io.encodings.binary io.files
math namespaces sequences tools.test math.bitwise ;
USING: accessors bitstreams compression.lzw-gif images.gif io
io.encodings.binary io.files kernel math math.bitwise
math.parser namespaces prettyprint sequences tools.test ;
QUALIFIED-WITH: bitstreams bs
IN: images.gif.tests
: path>gif ( path -- loading-gif )
binary [ input-stream get load-gif ] with-file-reader ;
: gif-example1 ( -- loading-gif )
"resource:extra/images/testing/symbol-word-16-colors.gif" path>gif ;
"resource:extra/images/testing/symbol-word.gif" path>gif ;
: gif-example2 ( -- loading-gif )
"resource:extra/images/testing/check-256-colors.gif" path>gif ;
@ -16,6 +18,9 @@ IN: images.gif.tests
: gif-example3 ( -- loading-gif )
"resource:extra/images/testing/monochrome.gif" path>gif ;
: gif-example4 ( -- loading-gif )
"resource:extra/images/testing/noise.gif" path>gif ;
: declared-num-colors ( gif -- n ) flags>> 3 bits 1 + 2^ ;
: actual-num-colors ( gif -- n ) global-color-table>> length 3 /i ;
@ -27,3 +32,21 @@ IN: images.gif.tests
[ 2 ] [ gif-example3 actual-num-colors ] unit-test
[ 2 ] [ gif-example3 declared-num-colors ] unit-test
: >index-stream ( gif -- seq )
[ image-descriptor>> first-code-size>> ]
[ compressed-bytes>> ] bi
lzw-uncompress ;
[
BV{
0 0 0 0 0 0
1 0 0 0 0 1
1 1 0 0 1 1
1 1 1 1 1 1
1 0 1 1 0 1
1 0 0 0 0 1
}
] [ gif-example3 >index-stream ] unit-test

View File

@ -1,11 +1,11 @@
! Copyrigt (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators constructors destructors
images images.loader io io.binary io.buffers
io.encodings.binary io.encodings.string io.encodings.utf8
io.files io.files.info io.ports io.streams.limited kernel make
math math.bitwise math.functions multiline namespaces
prettyprint sequences ;
USING: accessors arrays assocs combinators compression.lzw-gif
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
io.streams.limited kernel make math math.bitwise math.functions
multiline namespaces prettyprint sequences ;
IN: images.gif
SINGLETON: gif-image
@ -42,7 +42,7 @@ packed delay-time color-index
block-terminator ;
TUPLE: image-descriptor
left top width height flags lzw-min-code-size ;
left top width height flags first-code-size ;
TUPLE: plain-text-extension
introducer label block-size text-grid-left text-grid-top text-grid-width
@ -97,7 +97,7 @@ M: input-port stream-peek1
2 read le> >>width
2 read le> >>height
1 read le> >>flags
1 read le> >>lzw-min-code-size ;
1 read le> 1 + >>first-code-size ;
: read-graphic-control-extension ( -- graphic-control-extension )
\ graphics-control-extension new
@ -152,7 +152,7 @@ ERROR: unimplemented message ;
: read-global-color-table ( loading-gif -- loading-gif )
dup color-table? [
dup color-table-size read >>global-color-table
dup color-table-size read 3 group >>global-color-table
] when ;
: maybe-read-local-color-table ( loading-gif -- loading-gif )
@ -220,8 +220,25 @@ ERROR: unhandled-data byte ;
} case
] with-input-stream ;
: decompress ( loading-gif -- indexes )
[ image-descriptor>> first-code-size>> ]
[ compressed-bytes>> ] bi
lzw-uncompress ;
: apply-palette ( indexes palette -- bitmap )
[ nth 255 suffix ] curry V{ } map-as concat ;
: dimensions ( loading-gif -- dim )
[ image-descriptor>> width>> ] [ image-descriptor>> height>> ] bi 2array ;
: loading-gif>image ( loading-gif -- image )
;
[ <image> ] dip
[ dimensions >>dim ]
[ drop RGBA >>component-order ubyte-components >>component-type ]
[
[ decompress ] [ global-color-table>> ] bi
apply-palette >>bitmap
] tri ;
ERROR: loading-gif-error gif-image ;

Binary file not shown.

Before

Width:  |  Height:  |  Size: 45 B

After

Width:  |  Height:  |  Size: 51 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 48 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 21 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 142 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 129 B