images.gif: Decompression now works. Still need to implement transparency and merge with TIFF LZW code
parent
3cbf48cae7
commit
e9c780ba28
|
@ -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 ;
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
@ -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 |
Loading…
Reference in New Issue