fix jpeg loading

db4
Doug Coleman 2009-09-28 15:59:32 -05:00
parent d7626b177a
commit 4fbdcc72aa
1 changed files with 18 additions and 11 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 ;