Merge branch 'master' of git://github.com/mrjbq7/factor

db4
Slava Pestov 2011-01-28 21:56:18 -05:00
commit d2b20ddb35
5 changed files with 29 additions and 11 deletions

View File

@ -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 ;

View File

@ -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 <limited-file-reader> ;

View File

@ -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 ;

View File

@ -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

View File

@ -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
<PRIVATE
: content-type ( response -- type/f )
content-type>> 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. ;