fix jpeg loading
parent
d7626b177a
commit
4fbdcc72aa
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue