diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor index 31975fa3f0..82805fb688 100644 --- a/basis/images/bitmap/loading/loading.factor +++ b/basis/images/bitmap/loading/loading.factor @@ -342,8 +342,8 @@ M: v-header uncompress-bitmap* ( loading-bitmap header -- loading-bitmap' ) ERROR: unsupported-bitmap-file magic ; -: load-bitmap ( path -- loading-bitmap ) - binary stream-throws [ +: load-bitmap ( stream -- loading-bitmap ) + [ \ loading-bitmap new parse-file-header [ >>file-header ] [ ] bi magic>> { { "BM" [ @@ -363,7 +363,7 @@ ERROR: unsupported-bitmap-file magic ; : loading-bitmap>bytes ( loading-bitmap -- byte-array ) uncompress-bitmap bitmap>bytes ; -M: bitmap-image load-image* ( path bitmap-image -- bitmap ) +M: bitmap-image stream>image ( stream bitmap-image -- bitmap ) drop load-bitmap [ image new ] dip { diff --git a/basis/images/http/authors.txt b/basis/images/http/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/images/http/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/images/http/http.factor b/basis/images/http/http.factor new file mode 100644 index 0000000000..51f8b1ce55 --- /dev/null +++ b/basis/images/http/http.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: http.client images.loader images.loader.private kernel ; +IN: images.http + +: load-http-image ( path -- image ) + [ http-get nip ] [ image-class new ] bi load-image* ; diff --git a/basis/images/images.factor b/basis/images/images.factor index 83fabeafeb..625627f337 100755 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -68,8 +68,6 @@ TUPLE: image dim component-order component-type upside-down? bitmap ; : has-alpha? ( image -- ? ) component-order>> alpha-channel? ; -GENERIC: load-image* ( path class -- image ) - : bytes-per-component ( component-type -- n ) { { ubyte-components [ 1 ] } diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index ec7a70b656..776f768036 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files io.streams.byte-array kernel locals math math.bitwise math.constants math.functions math.matrices math.order math.ranges math.vectors memoize multiline namespaces -sequences sequences.deep ; +sequences sequences.deep images.loader ; IN: images.jpeg QUALIFIED-WITH: bitstreams bs @@ -19,6 +19,9 @@ TUPLE: jpeg-image < image { huff-tables initial: { f f f f } } { components } ; +"jpg" jpeg-image register-image-class +"jpeg" jpeg-image register-image-class + ( headers bitstream -- image ) @@ -353,17 +356,13 @@ ERROR: not-a-jpeg-image ; PRIVATE> -: load-jpeg ( path -- image ) - binary [ +M: jpeg-image stream>image ( stream jpeg-image -- bitmap ) + drop [ parse-marker { SOI } = [ not-a-jpeg-image ] unless parse-headers contents - ] with-file-reader + ] with-input-stream dup jpeg-image [ baseline-parse baseline-decompress ] with-variable ; - -M: jpeg-image load-image* ( path jpeg-image -- bitmap ) - drop load-jpeg ; - diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index dc0eec75c2..8c458b0c9f 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel splitting unicode.case combinators accessors images -io.pathnames namespaces assocs ; +USING: accessors assocs byte-arrays combinators images +io.encodings.binary io.pathnames io.streams.byte-array +io.streams.limited kernel namespaces splitting strings +unicode.case ; IN: images.loader ERROR: unknown-image-extension extension ; @@ -15,10 +17,26 @@ types [ H{ } clone ] initialize file-extension >lower types get ?at [ unknown-image-extension ] unless ; +: open-image-file ( path -- stream ) + binary stream-throws ; + PRIVATE> +GENERIC# load-image* 1 ( obj class -- image ) + +GENERIC: stream>image ( stream class -- image ) + : register-image-class ( extension class -- ) swap types get set-at ; : load-image ( path -- image ) - dup image-class load-image* ; + [ open-image-file ] [ image-class ] bi load-image* ; + +M: byte-array load-image* + [ binary ] dip stream>image ; + +M: limited-stream load-image* stream>image ; + +M: string load-image* [ open-image-file ] dip stream>image ; + +M: pathname load-image* [ open-image-file ] dip stream>image ; diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor index 86247351c9..cdb59953f9 100755 --- a/basis/images/png/png.factor +++ b/basis/images/png/png.factor @@ -111,14 +111,11 @@ ERROR: unimplemented-color-type image ; [ unknown-color-type ] } case ; -: load-png ( path -- image ) - binary stream-throws [ +M: png-image stream>image + drop [ read-png-header read-png-chunks parse-ihdr-chunk decode-png ] with-input-stream ; - -M: png-image load-image* - drop load-png ; diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 7e12b03c13..0d16bf75d4 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -517,14 +517,14 @@ ERROR: unknown-component-order ifd ; : with-tiff-endianness ( loading-tiff quot -- ) [ dup endianness>> ] dip with-endianness ; inline -: load-tiff-ifds ( path -- loading-tiff ) - binary [ +: load-tiff-ifds ( stream -- loading-tiff ) + [ read-header [ dup ifd-offset>> read-ifds process-ifds ] with-tiff-endianness - ] with-file-reader ; + ] with-input-stream* ; : process-chunky-ifd ( ifd -- ) read-strips @@ -555,13 +555,18 @@ ERROR: unknown-component-order ifd ; ifds>> [ process-ifd ] each ; : load-tiff ( path -- loading-tiff ) - [ load-tiff-ifds dup ] keep - binary [ - [ process-tif-ifds ] with-tiff-endianness - ] with-file-reader ; + [ load-tiff-ifds dup ] + [ + [ [ 0 seek-absolute ] dip stream-seek ] + [ + [ + [ process-tif-ifds ] with-tiff-endianness + ] with-input-stream + ] bi + ] bi ; ! tiff files can store several images -- we just take the first for now -M: tiff-image load-image* ( path tiff-image -- image ) +M: tiff-image stream>image ( stream tiff-image -- image ) drop load-tiff tiff>image ; { "tif" "tiff" } [ tiff-image register-image-class ] each diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index fd441e4c4d..1b0e155762 100755 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -98,5 +98,8 @@ PRIVATE> M: limited-stream stream-read-until swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ; +M: limited-stream stream-seek + stream>> stream-seek ; + M: limited-stream dispose stream>> dispose ; diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index d206ae5f45..10fcd9c449 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,7 +3,7 @@ USING: assocs html.parser kernel math sequences strings ascii arrays generalizations shuffle namespaces make splitting http accessors io combinators http.client urls -urls.encoding fry prettyprint sets ; +urls.encoding fry prettyprint sets combinators.short-circuit ; IN: html.parser.analyzer TUPLE: link attributes clickable ; @@ -103,6 +103,15 @@ TUPLE: link attributes clickable ; [ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ] find-between-all ; +: find-images ( vector -- vector' ) + [ + { + [ name>> "img" = ] + [ attributes>> "src" swap at ] + } 1&& + ] find-all + values [ attributes>> "src" swap at ] map ; + : ( vector -- link ) [ first attributes>> ] [ [ name>> { text "img" } member? ] filter ] bi