#------------------------------------------------------------------------
#
# Copyright (c) 1997-1998 by Cornell University.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------
package require DvmBasic
package require DvmPnm
package require DvmColor
package require DvmJpeg
source ../lib/pnmlib.tcl
if {$argc < 2} {
puts "Enter input PPM file name :"
set inname [gets stdin]
puts "Enter output JPG file name :"
set outname [gets stdin]
} else {
set inname [lindex $argv 0]
set outname [lindex $argv 1]
}
#------------------------------------------------------------------
# Read a jpeg and encode it to a ppm
# Uses standard quantization and huffman tables
#------------------------------------------------------------------
proc check_bitstream_underflow {bs bp chan size} {
set off [bitparser_tell $bp]
set left [bitstream_bytes_left $bs $off]
if {$left < $size} {
bitstream_shift $bs $off
bitstream_channel_read $bs $chan $left
bitparser_seek $bp 0
}
}
#if {$argc < 2} {
# puts "usage : ppmtojpg.vm inppm outjpg"
# exit
#}
#------------------------------------------------------------------
# Allocate pnm header, bitstream, bitparser
#------------------------------------------------------------------
set bsSize 65536
set hdr [pnm_hdr_new]
set inbs [bitstream_new $bsSize]
set inbp [bitparser_new]
set ht [jpeg_huff_table_new 3]
#------------------------------------------------------------------
# Open input file
#------------------------------------------------------------------
set inf [open $inname r]
fconfigure $inf -translation binary -buffersize 65535
#------------------------------------------------------------------
# Fill up the bitstream with data from input file, and attach
# the bitparser to the bitstream
#------------------------------------------------------------------
bitstream_channel_read $inbs $inf 0
bitparser_wrap $inbp $inbs
#------------------------------------------------------------------
# Parse away the header.
#------------------------------------------------------------------
pnm_hdr_parse $inbp $hdr
set w [pnm_hdr_get_width $hdr]
set h [pnm_hdr_get_height $hdr]
#------------------------------------------------------------------
# Calculate the image size. If the bitstream is not big enough,
# we resize the bitstream. Note that the bitparser have to be
# reinitialized once the bitstream is resized.
#------------------------------------------------------------------
set imageSize [expr 3*$w*$h]
if {$imageSize > $bsSize} {
set currOff [bitparser_tell $inbp]
bitstream_resize $inbs $imageSize
bitparser_wrap $inbp $inbs
bitparser_seek $inbp $currOff
}
#------------------------------------------------------------------
# Read in the rest of the data into the bitstream.
#------------------------------------------------------------------
check_bitstream_underflow $inbs $inbp $inf $imageSize
#------------------------------------------------------------------
# Allocates 3 byte image and read the RGB plane into the them
#------------------------------------------------------------------
set r [byte_new $w $h]
set g [byte_new $w $h]
set b [byte_new $w $h]
ppm_parse $inbp $r $g $b
#------------------------------------------------------------------
# Clean up the input stuff
#------------------------------------------------------------------
close $inf
bitstream_free $inbs
bitparser_free $inbp
pnm_hdr_free $hdr
##########################################################################
# Perform colorspace conversions
##########################################################################
set jw $w
set jh $h
set jw2 [expr $jw/2]
set jh2 [expr $jh/2]
set nr [byte_new $jw $jh]
set ng [byte_new $jw $jh]
set nb [byte_new $jw $jh]
byte_copy $r [byte_clip $nr 0 0 $w $h]
byte_copy $g [byte_clip $ng 0 0 $w $h]
byte_copy $b [byte_clip $nb 0 0 $w $h]
byte_free $r
byte_free $g
byte_free $b
set y [byte_new $jw $jh]
set u [byte_new $jw2 $jh]
set v [byte_new $jw2 $jh]
rgb_to_yuv_422 $nr $ng $nb $y $u $v
byte_free $nr
byte_free $ng
byte_free $nb
##########################################################################
# Now initialize the jpeg hdrs, scan hdrs, etc
##########################################################################
set hdr [jpeg_hdr_new]
set nc 3
jpeg_hdr_set_width $hdr $w
jpeg_hdr_set_height $hdr $h
jpeg_hdr_set_num_of_components $hdr $nc
jpeg_hdr_set_precision $hdr 8
jpeg_hdr_set_block_widths $hdr {2 1 1}
jpeg_hdr_set_block_heights $hdr {1 1 1}
jpeg_hdr_set_qt_ids $hdr {0 1 1}
jpeg_hdr_std_ht_init $hdr
jpeg_hdr_std_qt_init $hdr
set bw [expr $jw/8]
set bh [expr $jh/8]
set s [jpeg_scan_hdr_new]
jpeg_scan_hdr_set_num_of_components $s $nc
jpeg_scan_hdr_set_scan_ids $s {0 1 2}
jpeg_scan_hdr_set_dc_ids $s {0 1 1}
jpeg_scan_hdr_set_ac_ids $s {0 1 1}
jpeg_huff_table_init $hdr $s $ht
set scy [sc_new [expr $jw/8] [expr $jh/8]]
set scu [sc_new [expr $jw2/8] [expr $jh/8]]
set scv [sc_new [expr $jw2/8] [expr $jh/8]]
#------------------------------------------------------------------
# Convert to SC
#------------------------------------------------------------------
byte_to_sc $y $scy
byte_to_sc $u $scu
byte_to_sc $v $scv
#------------------------------------------------------------------
# Allocate and initialize the output bitstream and bitparser
#------------------------------------------------------------------
set obs [bitstream_new 300000]
set obp [bitparser_new]
bitparser_wrap $obp $obs
#------------------------------------------------------------------
# and write this out to the bitstream
#------------------------------------------------------------------
jpeg_start_code_encode $obp
jpeg_hdr_qt_encode $hdr $obp
jpeg_hdr_ht_encode $hdr $obp
jpeg_hdr_encode $hdr 1 $obp
jpeg_scan_hdr_encode $hdr $s $obp
jpeg_scan_encode_422 $hdr $s $ht $scy $scu $scv $obp
jpeg_end_code_encode $obp
#------------------------------------------------------------------
# Flush the bitstream to a file.
#------------------------------------------------------------------
set out [open $outname w]
fconfigure $out -translation binary
set size [bitparser_tell $obp]
bitstream_channel_write_segment $obs $out 0 $size