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 ; 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/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 ; 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 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. ;