Merge branch 'master' into png2

db4
Doug Coleman 2009-09-28 15:59:48 -05:00
commit f51dd8fe2f
5 changed files with 33 additions and 16 deletions

View File

@ -11,7 +11,9 @@ IN: images.jpeg
QUALIFIED-WITH: bitstreams bs
TUPLE: jpeg-image < image
SINGLETON: jpeg-image
TUPLE: loading-jpeg < image
{ headers }
{ bitstream }
{ color-info initial: { f f f f } }
@ -24,8 +26,8 @@ TUPLE: jpeg-image < image
<PRIVATE
: <jpeg-image> ( headers bitstream -- image )
jpeg-image new swap >>bitstream swap >>headers ;
: <loading-jpeg> ( headers bitstream -- image )
loading-jpeg new swap >>bitstream swap >>headers ;
SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP
APP JPG COM TEM RES ;
@ -357,15 +359,20 @@ SINGLETONS: YUV420 YUV444 Y MAGIC! ;
ERROR: not-a-jpeg-image ;
PRIVATE>
M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
drop [
parse-marker { SOI } = [ not-a-jpeg-image ] unless
parse-headers
contents <jpeg-image>
] with-input-stream
: loading-jpeg>image ( loading-jpeg -- image )
dup jpeg-image [
baseline-parse
baseline-decompress
] with-variable ;
: load-jpeg ( stream -- loading-jpeg )
[
parse-marker { SOI } = [ not-a-jpeg-image ] unless
parse-headers
unlimited-input contents <loading-jpeg>
] with-input-stream ;
PRIVATE>
M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
drop load-jpeg loading-jpeg>image ;

View File

@ -6,7 +6,7 @@ io.binary io.encodings.ascii io.encodings.string kernel locals
math math.bitwise math.ranges sequences sorting ;
IN: images.png
TUPLE: png-image < image ;
SINGLETON: png-image
"png" png-image register-image-class
TUPLE: loading-png
@ -128,7 +128,7 @@ ERROR: unimplemented-color-type image ;
[ png-group-width ] tri group reverse-png-filter ;
: loading-png>image ( loading-png -- image )
[ png-image new ] dip {
[ image new ] dip {
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
[ drop ubyte-components >>component-type ]

View File

@ -556,7 +556,7 @@ ERROR: unknown-component-order ifd ;
: process-tif-ifds ( loading-tiff -- )
ifds>> [ process-ifd ] each ;
: load-tiff ( path -- loading-tiff )
: load-tiff ( stream -- loading-tiff )
[ load-tiff-ifds dup ]
[
[ [ 0 seek-absolute ] dip stream-seek ]

View File

@ -81,4 +81,11 @@ IN: io.streams.limited.tests
"HELLO"
[ f stream-throws limit-input 4 read ]
with-string-reader
] unit-test
] unit-test
[ "asdf" ] [
"asdf" <string-reader> 2 stream-eofs <limited-stream> [
unlimited-input contents
] with-input-stream
] unit-test

View File

@ -37,7 +37,7 @@ M: decoder unlimited ( stream -- stream' )
[ stream>> ] change-stream ;
M: object unlimited ( stream -- stream' )
stream>> stream>> ;
stream>> ;
: limit-input ( limit mode -- )
[ input-stream ] 2dip '[ _ _ limit ] change ;
@ -103,3 +103,6 @@ M: limited-stream stream-seek
M: limited-stream dispose
stream>> dispose ;
M: limited-stream stream-element-type
stream>> stream-element-type ;