steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
basis/images/jpeg/jpeg.factor
View File

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