From b4ca9daf27113eba1e92656280232ae168d27d14 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 26 Jan 2011 17:23:30 -0800 Subject: [PATCH 1/4] images.gif: the Graphics Control Block is OPTIONAL in the GIF spec. --- extra/images/gif/gif.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor index b06210fc00..8d4b118d16 100644 --- a/extra/images/gif/gif.factor +++ b/extra/images/gif/gif.factor @@ -140,7 +140,8 @@ ERROR: unimplemented message ; : sort? ( image -- ? ) flags>> 5 bit? ; inline : color-table-size ( image -- ? ) flags>> 3 bits 1 + 2^ 3 * ; inline : transparency? ( image -- ? ) - graphic-control-extensions>> first flags>> 0 bit? ; inline + graphic-control-extensions>> + [ f ] [ first flags>> 0 bit? ] if-empty ; inline : color-resolution ( image -- ? ) flags>> -4 shift 3 bits ; inline From ac950d8bd790a4e5d5581006e6ead20d03068c91 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 26 Jan 2011 17:24:55 -0800 Subject: [PATCH 2/4] sets: improve stack effect for "combine". --- core/sets/sets.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 06f6e04655..5dcee675f9 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -109,7 +109,7 @@ M: sequence null? M: sequence cardinality length ; -: combine ( sets -- set ) +: combine ( sets -- set/f ) [ f ] [ [ [ members ] map concat ] [ first ] bi set-like ] if-empty ; From 1defecf27998a3f87b2ca1b5d08324130e334265 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 26 Jan 2011 18:05:02 -0800 Subject: [PATCH 3/4] images.http: use the content type from the http response if provided. --- basis/images/loader/loader.factor | 6 ++++-- extra/images/http/http.factor | 16 +++++++++++++--- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index 7e1dc9ca31..52a80459d9 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -13,9 +13,11 @@ ERROR: unknown-image-extension extension ; SYMBOL: types types [ H{ } clone ] initialize +: (image-class) ( type -- class ) + >lower types get ?at [ unknown-image-extension ] unless ; + : image-class ( path -- class ) - file-extension >lower types get ?at - [ unknown-image-extension ] unless ; + file-extension (image-class) ; : open-image-file ( path -- stream ) binary ; diff --git a/extra/images/http/http.factor b/extra/images/http/http.factor index 620ab6f73b..217c8408d1 100644 --- a/extra/images/http/http.factor +++ b/extra/images/http/http.factor @@ -1,11 +1,21 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: http.client images.loader images.loader.private kernel -images.viewer ; +USING: accessors assocs http.client images.loader +images.loader.private images.viewer io.pathnames kernel +namespaces sequences ; IN: images.http +> dup "image/" head? + [ 6 tail ] [ drop f ] if ; + +PRIVATE> + : load-http-image ( path -- image ) - [ http-get nip ] [ image-class ] bi load-image* ; + [ http-get swap content-type ] [ file-extension ] bi or + (image-class) load-image* ; : http-image. ( path -- ) load-http-image image. ; From 0b6dae0a93296505755853bb653b67bf3335e98d Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 26 Jan 2011 21:06:43 -0800 Subject: [PATCH 4/4] compression.lzw: fix for gif89a decoding - maximum code size is 12 bits. --- basis/compression/lzw/lzw.factor | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index f61a02c01b..248700b08c 100755 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators io kernel math namespaces -sequences vectors ; +USING: accessors combinators io kernel math math.order +namespaces sequences vectors ; QUALIFIED-WITH: bitstreams bs IN: compression.lzw @@ -62,8 +62,13 @@ GENERIC: code-space-full? ( lzw -- ? ) M: tiff-lzw code-space-full? size-and-limit 1 - = ; M: gif-lzw code-space-full? size-and-limit = ; +GENERIC: increment-code-size ( lzw -- lzw ) + +M: lzw increment-code-size [ 1 + ] change-code-size ; +M: gif-lzw increment-code-size [ 1 + 12 min ] change-code-size ; + : maybe-increment-code-size ( lzw -- lzw ) - dup code-space-full? [ [ 1 + ] change-code-size ] when ; + dup code-space-full? [ increment-code-size ] when ; : add-to-table ( seq lzw -- ) [ table>> push ] @@ -108,7 +113,7 @@ DEFER: lzw-uncompress-char [ output>> push-all ] [ add-to-table ] 2bi ] [ code>old-code ] bi ] if ; - + : lzw-uncompress-char ( lzw -- ) [ >>code handle-uncompress-code lzw-uncompress-char ] lzw-process-next-code ;