images.jpeg: added support for yuv444 and black and white images

db4
Marc Fauconneau 2009-06-05 21:33:04 +09:00
parent f09a2807fa
commit 88f8af4b69
1 changed files with 359 additions and 306 deletions

View File

@ -6,14 +6,12 @@ images.processing io io.binary io.encodings.binary io.files
io.streams.byte-array kernel locals math math.bitwise io.streams.byte-array kernel locals math math.bitwise
math.constants math.functions math.matrices math.order math.constants math.functions math.matrices math.order
math.ranges math.vectors memoize multiline namespaces math.ranges math.vectors memoize multiline namespaces
sequences sequences.deep images.loader ; sequences sequences.deep ;
QUALIFIED-WITH: bitstreams bs
IN: images.jpeg IN: images.jpeg
SINGLETON: jpeg-image QUALIFIED-WITH: bitstreams bs
{ "jpg" "jpeg" } [ jpeg-image register-image-class ] each
TUPLE: loading-jpeg < image TUPLE: jpeg-image < image
{ headers } { headers }
{ bitstream } { bitstream }
{ color-info initial: { f f f f } } { color-info initial: { f f f f } }
@ -23,7 +21,7 @@ TUPLE: loading-jpeg < image
<PRIVATE <PRIVATE
CONSTRUCTOR: loading-jpeg ( headers bitstream -- image ) ; CONSTRUCTOR: jpeg-image ( headers bitstream -- image ) ;
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 ;
@ -65,7 +63,7 @@ TUPLE: jpeg-color-info
CONSTRUCTOR: jpeg-color-info ( h v quant-table -- jpeg-color-info ) ; CONSTRUCTOR: jpeg-color-info ( h v quant-table -- jpeg-color-info ) ;
: jpeg> ( -- jpeg-image ) loading-jpeg get ; : jpeg> ( -- jpeg-image ) jpeg-image get ;
: apply-diff ( dc color -- dc' ) : apply-diff ( dc color -- dc' )
[ diff>> + dup ] [ (>>diff) ] bi ; [ diff>> + dup ] [ (>>diff) ] bi ;
@ -77,7 +75,6 @@ CONSTRUCTOR: jpeg-color-info ( h v quant-table -- jpeg-color-info ) ;
: read4/4 ( -- a b ) read1 16 /mod ; : read4/4 ( -- a b ) read1 16 /mod ;
! headers ! headers
: decode-frame ( header -- ) : decode-frame ( header -- )
@ -188,6 +185,9 @@ MEMO: dct-matrix ( -- m ) 64 [0,b) [ 8 /mod dct-vect flatten ] map ;
: mb-dim ( component -- dim ) [ h>> ] [ v>> ] bi 2array ; : mb-dim ( component -- dim ) [ h>> ] [ v>> ] bi 2array ;
! : blocks ( component -- seq )
! mb-dim ! coord-matrix flip concat [ [ { 2 2 } v* ] [ v+ ] bi* ] with map ;
: all-macroblocks ( quot: ( mb -- ) -- ) : all-macroblocks ( quot: ( mb -- ) -- )
[ [
jpeg> jpeg>
@ -211,12 +211,12 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
: idct ( b -- b' ) idct-blas ; : idct ( b -- b' ) idct-blas ;
:: draw-block ( block x,y color jpeg-image -- ) :: draw-block ( block x,y color-id jpeg-image -- )
block dup length>> sqrt >fixnum group flip block dup length>> sqrt >fixnum group flip
dup matrix-dim coord-matrix flip dup matrix-dim coord-matrix flip
[ [
[ first2 spin nth nth ] [ first2 spin nth nth ]
[ x,y v+ color id>> 1- jpeg-image draw-color ] bi [ x,y v+ color-id jpeg-image draw-color ] bi
] with each^2 ; ] with each^2 ;
: sign-extend ( bits v -- v' ) : sign-extend ( bits v -- v' )
@ -229,7 +229,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
: read1-jpeg-ac ( decoder -- run/ac ) : read1-jpeg-ac ( decoder -- run/ac )
[ read1-huff 16 /mod dup ] [ bs>> bs:read ] bi sign-extend 2array ; [ read1-huff 16 /mod dup ] [ bs>> bs:read ] bi sign-extend 2array ;
:: decode-block ( pos color -- ) :: decode-block ( color -- pixels )
color dc-huff-table>> read1-jpeg-dc color apply-diff color dc-huff-table>> read1-jpeg-dc color apply-diff
64 0 <array> :> coefs 64 0 <array> :> coefs
0 coefs set-nth 0 coefs set-nth
@ -241,19 +241,38 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
k 63 < and k 63 < and
] loop ] loop
coefs color quant-table>> v* coefs color quant-table>> v*
reverse-zigzag idct reverse-zigzag idct ;
! %fixme: color hack
! this eat 50% cpu time
color h>> 2 =
[ 8 group 2 matrix-zoom concat ] unless
pos { 8 8 } v* color jpeg> draw-block ;
: decode-macroblock ( mb -- ) :: draw-macroblock-yuv420 ( mb blocks -- )
mb { 16 16 } v* :> pos
0 blocks nth pos { 0 0 } v+ 0 jpeg> draw-block
1 blocks nth pos { 8 0 } v+ 0 jpeg> draw-block
2 blocks nth pos { 0 8 } v+ 0 jpeg> draw-block
3 blocks nth pos { 8 8 } v+ 0 jpeg> draw-block
4 blocks nth 8 group 2 matrix-zoom concat pos 1 jpeg> draw-block
5 blocks nth 8 group 2 matrix-zoom concat pos 2 jpeg> draw-block ;
:: draw-macroblock-yuv444 ( mb blocks -- )
mb { 8 8 } v* :> pos
3 iota [ [ blocks nth pos ] [ jpeg> draw-block ] bi ] each ;
:: draw-macroblock-y ( mb blocks -- )
mb { 8 8 } v* :> pos
0 blocks nth pos 0 jpeg> draw-block
64 0 <array> pos 1 jpeg> draw-block
64 0 <array> pos 2 jpeg> draw-block ;
! %fixme: color hack
! color h>> 2 =
! [ 8 group 2 matrix-zoom concat ] unless
! pos { 8 8 } v* color jpeg> draw-block ;
: decode-macroblock ( -- blocks )
jpeg> components>> jpeg> components>>
[ [
[ mb-dim coord-matrix flip concat [ [ { 2 2 } v* ] [ v+ ] bi* ] with map ] [ mb-dim first2 * iota ]
[ [ decode-block ] curry each ] bi [ [ decode-block ] curry replicate ] bi
] with each ; ] map concat ;
: cleanup-bitstream ( bytes -- bytes' ) : cleanup-bitstream ( bytes -- bytes' )
binary [ binary [
@ -274,33 +293,67 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
dup dim>> first2 * 3 * 0 <array> >>bitmap dup dim>> first2 * 3 * 0 <array> >>bitmap
drop ; drop ;
: baseline-decompress ( -- ) ERROR: unsupported-colorspace ;
jpeg> bitstream>> cleanup-bitstream { 255 255 255 255 } append SINGLETONS: YUV420 YUV444 Y MAGIC! ;
>byte-array bs:<msb0-bit-reader> jpeg> (>>bitstream)
jpeg> [ bitstream>> ] [ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi :: detect-colorspace ( jpeg-image -- csp )
jpeg> components>> [ fetch-tables ] each jpeg-image color-info>> sift :> colors
jpeg> setup-bitmap MAGIC!
[ decode-macroblock ] all-macroblocks ; colors length 1 = [ drop Y ] when
colors length 3 =
[
colors [ mb-dim { 1 1 } = ] all?
[ drop YUV444 ] when
colors unclip
[ [ mb-dim { 1 1 } = ] all? ]
[ mb-dim { 2 2 } = ] bi* and
[ drop YUV420 ] when
] when ;
! this eats ~50% cpu time
: draw-macroblocks ( mbs -- )
jpeg> detect-colorspace
{
{ YUV420 [ [ first2 draw-macroblock-yuv420 ] each ] }
{ YUV444 [ [ first2 draw-macroblock-yuv444 ] each ] }
{ Y [ [ first2 draw-macroblock-y ] each ] }
[ unsupported-colorspace ]
} case ;
! this eats ~25% cpu time ! this eats ~25% cpu time
: color-transform ( yuv -- rgb ) : color-transform ( yuv -- rgb )
{ 128 0 0 } v+ yuv>bgr-matrix swap m.v { 128 0 0 } v+ yuv>bgr-matrix swap m.v
[ 0 max 255 min >fixnum ] map ; [ 0 max 255 min >fixnum ] map ;
: baseline-decompress ( -- )
jpeg> bitstream>> cleanup-bitstream { 255 255 255 255 } append
>byte-array bs:<msb0-bit-reader> jpeg> (>>bitstream)
jpeg>
[ bitstream>> ]
[ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi
jpeg> components>> [ fetch-tables ] each
[ decode-macroblock 2array ] accumulator
[ all-macroblocks ] dip
jpeg> setup-bitmap draw-macroblocks
jpeg> bitmap>> 3 <groups> [ color-transform ] change-each
jpeg> [ >byte-array ] change-bitmap drop ;
ERROR: not-a-jpeg-image ;
PRIVATE> PRIVATE>
: load-jpeg ( path -- image ) : load-jpeg ( path -- image )
binary [ binary [
parse-marker { SOI } assert= parse-marker { SOI } = [ not-a-jpeg-image ] unless
parse-headers parse-headers
contents <loading-jpeg> contents <jpeg-image>
] with-file-reader ] with-file-reader
dup loading-jpeg [ dup jpeg-image [
baseline-parse baseline-parse
baseline-decompress baseline-decompress
jpeg> bitmap>> 3 <groups> [ color-transform ] change-each
jpeg> [ >byte-array ] change-bitmap drop
] with-variable ; ] with-variable ;
M: jpeg-image load-image* ( path jpeg-image -- bitmap ) M: jpeg-image load-image* ( path jpeg-image -- bitmap )
drop load-jpeg ; drop load-jpeg ;