#------------------------------------------------------------------------
#
# 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 DvmMpeg
source ../lib/pnmlib.tcl
#------------------------------------------------------------------------
# This is a simple example demonstrating how to encode a short sequence
# of PPM files into I and P frames with: 1 Sequence, 2 GOPs, 4 Picture
# frames per GOP, 1 Slice per frame, 1 quantization scale. The P frames
# are encoded using the original I frames. The motion vector search is
# done with full pel units. The frame pattern is IPIPIP...
#
# Note: the input files should be named <prefix>000.ppm, <prefix>001.ppm ...
#------------------------------------------------------------------------
# check arguments
if {$argc != 2} {
puts "enter the prefix of input file names: "
set namePrefix [gets stdin]
puts "enter the output file name: "
set outFileName [gets stdin]
} else {
set namePrefix [lindex $argv 0]
set outFileName [lindex $argv 1]
}
# buffer large enough to hold 2 frames and some headers
set buffer_size 50000
set frames_per_second 30
set forward_f_code 3
# width and height of each frame in pixels
set width 176
set height 120
set pictures 0
set seconds 0
set minutes 0
set hours 0
#------------------------------------------------------------------------
# Use this to keep track of how many picture frames, seconds, minutes,
# hours. This information is encoded in the GOP headers.
#------------------------------------------------------------------------
proc increment_time {} {
global pictures seconds minutes hours
incr pictures 1
if { $pictures == 30 } {
set pictures 0
incr seconds 1
if { $seconds == 60 } {
set seconds 0
incr minutes 1
if { $minutes == 60 } {
set minutes 0
incr hours 1
}
}
}
}
#------------------------------------------------------------------------
# swap the value of two pointers.
#------------------------------------------------------------------------
proc swap {a b} {
upvar $a aa
upvar $b bb
set temp $aa
set aa $bb
set bb $temp
}
#------------------------------------------------------------------------
# Read in a PPM file into r, g, b ByteImages, then convert it to y, u, v
# with 4:2:0 sampling.
#------------------------------------------------------------------------
proc read_to_yuv {} {
uplevel #0 {
set fileName [format "%s%03d.ppm" $namePrefix $pictures]
set inFile [open $fileName r]
puts [format "Processing %s" $fileName]
fconfigure $inFile -translation binary -buffersize $buffer_size
bitparser_wrap $bp $bs
bitstream_channel_read $bs $inFile 0
pnm_hdr_parse $bp $pnmHdr
ppm_parse $bp $r $g $b
close $inFile
rgb_to_yuv_420 $r $g $b $y $u $v
}}
#------------------------------------------------------------------------
# initialization
#------------------------------------------------------------------------
set seqHdr [mpeg_seq_hdr_new]
set gopHdr [mpeg_gop_hdr_new]
set picHdr [mpeg_pic_hdr_new]
set pnmHdr [pnm_hdr_new]
set w $width
set h $height
set halfw [expr $w/2]
set halfh [expr $h/2]
set mbw [expr int(($w+15)/16)]
set mbh [expr int(($h+15)/16)]
# this should be enough for one frame
set sliceInfo {1000}
set r [byte_new $w $h]
set g [byte_new $w $h]
set b [byte_new $w $h]
set y [byte_new $w $h]
set prevY [byte_new $w $h]
set u [byte_new $halfw $halfh]
set v [byte_new $halfw $halfh]
set prevU [byte_new $halfw $halfh]
set prevV [byte_new $halfw $halfh]
set qScale [byte_new $mbw $mbh]
set scY [sc_new [expr $mbw*2] [expr $mbh*2]]
set scU [sc_new $mbw $mbh]
set scV [sc_new $mbw $mbh]
set fmv [vector_new $mbw $mbh]
set fileSize [file size ${namePrefix}000.ppm]
set bp [bitparser_new]
set bs [bitstream_new $fileSize]
set obp [bitparser_new]
set obs [bitstream_new $buffer_size]
bitparser_wrap $obp $obs
set outFile [open $outFileName w]
fconfigure $outFile -translation binary
byte_set $qScale 4
#------------------------------------------------------------------------
# encode
#------------------------------------------------------------------------
mpeg_seq_hdr_set_width $seqHdr $w
mpeg_seq_hdr_set_height $seqHdr $h
mpeg_seq_hdr_set_aspect_ratio $seqHdr 1.000
mpeg_seq_hdr_set_pic_rate $seqHdr $frames_per_second
mpeg_seq_hdr_set_bit_rate $seqHdr -1
mpeg_seq_hdr_set_buffer_size $seqHdr 16
mpeg_seq_hdr_set_constrained $seqHdr 0
mpeg_seq_hdr_set_default_iqt $seqHdr
mpeg_seq_hdr_set_default_niqt $seqHdr
mpeg_seq_hdr_encode $seqHdr $obp
# we are not going to change these
mpeg_gop_hdr_set_drop_frame_flag $gopHdr 0
mpeg_gop_hdr_set_closed_gop $gopHdr 1
mpeg_gop_hdr_set_broken_link $gopHdr 0
mpeg_pic_hdr_set_vbv_delay $picHdr 0
mpeg_pic_hdr_set_full_pel_backward $picHdr 0
mpeg_pic_hdr_set_backward_f_code $picHdr 0
for {set gop 0} {$gop < 2} {incr gop 1} {
mpeg_gop_hdr_set_hours $gopHdr $hours
mpeg_gop_hdr_set_minutes $gopHdr $minutes
mpeg_gop_hdr_set_seconds $gopHdr $seconds
mpeg_gop_hdr_set_pictures $gopHdr $pictures
mpeg_gop_hdr_encode $gopHdr $obp
set temporalRef 0
for {set p 0} {$p < 2} {incr p 1} {
# I FRAME #
read_to_yuv
mpeg_pic_hdr_set_temporal_ref $picHdr $temporalRef
mpeg_pic_hdr_set_type $picHdr i-frame
mpeg_pic_hdr_set_full_pel_forward $picHdr 0
mpeg_pic_hdr_encode $picHdr $obp
mpeg_pic_hdr_set_forward_f_code $picHdr 0
byte_to_sc_i $y $qScale mpeg-intra $scY
byte_to_sc_i $u $qScale mpeg-intra $scU
byte_to_sc_i $v $qScale mpeg-intra $scV
mpeg_pic_i_encode $picHdr $scY $scU $scV $qScale $sliceInfo $obp
increment_time
incr temporalRef 1
swap y prevY
swap u prevU
swap v prevV
# P FRAME #
read_to_yuv
mpeg_pic_hdr_set_temporal_ref $picHdr $temporalRef
mpeg_pic_hdr_set_type $picHdr p-frame
mpeg_pic_hdr_set_full_pel_forward $picHdr 1
mpeg_pic_hdr_set_forward_f_code $picHdr $forward_f_code
mpeg_pic_hdr_encode $picHdr $obp
byte_p_motion_vec_search $picHdr $y $prevY {} $fmv
byte_y_to_sc_p $y $prevY $fmv $qScale mpeg-intra mpeg-non-intra $scY
byte_uv_to_sc_p $u $prevU $fmv $qScale mpeg-intra mpeg-non-intra $scU
byte_uv_to_sc_p $v $prevV $fmv $qScale mpeg-intra mpeg-non-intra $scV
mpeg_pic_p_encode $picHdr $scY $scU $scV $fmv $qScale $sliceInfo $obp
increment_time
incr temporalRef 1
puts "Writing to file..."
set size [bitparser_tell $obp]
bitstream_channel_write_segment $obs $outFile 0 $size
bitparser_wrap $obp $obs
}
}
# don't forget this
mpeg_seq_end_code_encode $obp
set size [bitparser_tell $obp]
bitstream_channel_write_segment $obs $outFile 0 $size
close $outFile
#----------------------------------------------------------------
# clean up
#----------------------------------------------------------------
bitstream_free $bs
bitparser_free $bp
bitstream_free $obs
bitparser_free $obp
mpeg_pic_hdr_free $picHdr
mpeg_gop_hdr_free $gopHdr
mpeg_seq_hdr_free $seqHdr
pnm_hdr_free $pnmHdr
byte_free $r
byte_free $g
byte_free $b
byte_free $y
byte_free $u
byte_free $v
byte_free $prevY
byte_free $prevU
byte_free $prevV
byte_free $qScale
sc_free $scY
sc_free $scU
sc_free $scV
vector_free $fmv