support loading images from streams, add load-http-image

diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor
index 31975fa3f0aa962d4adac7858e12991452296d76..82805fb6887d3b64a598cb04b281d73d6ba64b28 100644 (file)
--- 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 <limited-file-reader> [
+: 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 (file)
index 0000000..b4bd0e7
--- /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 (file)
index 0000000..51f8b1c
--- /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 83fabeafebe024f42c983cbd06988aad9539402b..625627f337027307c47089b27866a04c863dd960 100755 (executable)
--- 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 ec7a70b656eac61db3567a8e1d06a65126780b64..776f7680361c28deddffd8ef56ff7e2294aaf106 100644 (file)
--- 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
+
 <PRIVATE
 
 : <jpeg-image> ( 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 <jpeg-image>
-    ] 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 dc0eec75c29d3b3b51993f62b522f266c10129af..60580d959a78658f12fc29ae1494c01b196ef577 100644 (file)
--- 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 <limited-file-reader> ;
+
 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 new ] bi load-image* ;
+
+M: byte-array load-image*
+    [ binary <byte-reader> ] 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 86247351c92fab7b1fb033a0dc8dc55566e7914c..cdb59953f95c220b99dc7d78d31f6d2b8ed6d44c 100755 (executable)
--- 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 <limited-file-reader> [
+M: png-image stream>image
+    drop [
         <loading-png>
         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 7e12b03c132476b2c49c663be676994f54cecd32..624641ae51e9c761b3cc2747615a5f0b678be352 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -449,6 +449,7 @@ ERROR: unhandled-compression compression ;
     dup strips>> concat >>bitmap ;
 
 : (strips-predictor) ( ifd -- ifd )
+B
     [ ]
     [ image-width find-tag ]
     [ samples-per-pixel find-tag ] tri
@@ -517,14 +518,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 )
+    [
         <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 +556,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