diff --git a/extra/compression/lzw-gif/lzw-gif.factor b/extra/compression/lzw-gif/lzw-gif.factor new file mode 100644 index 0000000000..1d98fdd4ee --- /dev/null +++ b/extra/compression/lzw-gif/lzw-gif.factor @@ -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 ; + +: ( 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: + + [ lzw-uncompress-char ] [ output>> ] bi ; diff --git a/extra/images/gif/gif-tests.factor b/extra/images/gif/gif-tests.factor index 1c4a80107e..609f98c693 100644 --- a/extra/images/gif/gif-tests.factor +++ b/extra/images/gif/gif-tests.factor @@ -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 + + diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor index cbe7fa5f3a..4744f55a6b 100644 --- a/extra/images/gif/gif.factor +++ b/extra/images/gif/gif.factor @@ -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 ) - ; + [ ] 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 ; diff --git a/extra/images/testing/monochrome.gif b/extra/images/testing/monochrome.gif index de74e65eb1..b0875faa61 100644 Binary files a/extra/images/testing/monochrome.gif and b/extra/images/testing/monochrome.gif differ diff --git a/extra/images/testing/noise.bmp b/extra/images/testing/noise.bmp new file mode 100644 index 0000000000..8e47f143dd Binary files /dev/null and b/extra/images/testing/noise.bmp differ diff --git a/extra/images/testing/noise.gif b/extra/images/testing/noise.gif new file mode 100644 index 0000000000..31dffae42b Binary files /dev/null and b/extra/images/testing/noise.gif differ diff --git a/extra/images/testing/symbol-word-16-colors.gif b/extra/images/testing/symbol-word-16-colors.gif deleted file mode 100644 index e097fdcc38..0000000000 Binary files a/extra/images/testing/symbol-word-16-colors.gif and /dev/null differ diff --git a/extra/images/testing/symbol-word.gif b/extra/images/testing/symbol-word.gif new file mode 100644 index 0000000000..101a48a880 Binary files /dev/null and b/extra/images/testing/symbol-word.gif differ