#------------------------------------------------------------------------
#
# 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 DvmMpeg
package require DvmPnm
package require DvmColor
#---------------------------------------------------------------
# This script converts a MPEG Video Sequence to a series of ppm
# file.
#---------------------------------------------------------------
if {$argc != 1} {
puts "enter input mpeg file :"
set inname [gets stdin]
} else {
set inname [lindex $argv 0]
}
#---------------------------------------------------------------
# This procedure encode 3 byte image into a bitstream bs,
# using bitparser bp, and output it to a tcl channel called
# name. Assumes that the header is already encoded in the
# bitstream. (This is an improvement over the routines in pnmlib.tcl
# since it reuse the same header and bitstream)
#---------------------------------------------------------------
proc write_ppm {r g b bs bp name} {
set chan [open $name w]
fconfigure $chan -translation binary -buffersize 65536
set curr [bitparser_tell $bp]
ppm_encode $r $g $b $bp
bitstream_channel_write $bs $chan 0
bitparser_seek $bp $curr
close $chan
}
#---------------------------------------------------------------
# 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
}
#---------------------------------------------------------------
# This proc make sure that there are at least size bytes of
# data in the bitstream bs, which is attached to bitparser bp.
# If there is not enough data, fill up the bitstream by reading
# from tcl channel chan.
#---------------------------------------------------------------
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
}
}
#----------------------------------------------------------------
# open file, create new bitparser, new bitstream, read first
# 65535 bytes from file into bitstream and attached the bitparser
# to the bitstream
#----------------------------------------------------------------
set bp [bitparser_new]
set bs [bitstream_new 65535]
set file [open $inname r]
fconfigure $file -translation binary -buffersize 65535
bitstream_channel_read $bs $file 0
bitparser_wrap $bp $bs
#----------------------------------------------------------------
# parse the mpeg sequence header and find out the dimension and
# size of the frames. Care must be taken if frame dimenion is
# not multiple of 16
#----------------------------------------------------------------
set sh [mpeg_seq_hdr_new]
mpeg_seq_hdr_find $bp
mpeg_seq_hdr_parse $bp $sh
set seqw [mpeg_seq_hdr_get_width $sh]
set seqh [mpeg_seq_hdr_get_height $sh]
set picSize [mpeg_seq_hdr_get_buffer_size $sh]
set remw [expr $seqw % 16]
set remh [expr $seqh % 16]
if {$remw != 0} {
set w [expr $seqw + 16 - $remw]
} else {
set w $seqw
}
if {$remh != 0} {
set h [expr $seqh + 16 - $remh]
} else {
set h $seqh
}
set halfw [expr $w/2]
set halfh [expr $h/2]
#----------------------------------------------------------------
# allocate a bunch of byte buffer, sc buffer, mv buffer,
# mpeg_pic_hdr
#----------------------------------------------------------------
set y [byte_new $w $h]
set prevy [byte_new $w $h]
set futurey [byte_new $w $h]
set r [byte_new $seqw $seqh]
set g [byte_new $seqw $seqh]
set b [byte_new $seqw $seqh]
set u [byte_new $halfw $halfh]
set prevu [byte_new $halfw $halfh]
set futureu [byte_new $halfw $halfh]
set v [byte_new $halfw $halfh]
set prevv [byte_new $halfw $halfh]
set futurev [byte_new $halfw $halfh]
set outy [byte_clip $y 0 0 $seqw $seqh]
set outu [byte_clip $u 0 0 [expr $seqw/2] [expr $seqh/2]]
set outv [byte_clip $v 0 0 [expr $seqw/2] [expr $seqh/2]]
set fwdmv [vector_new [expr $w/16] [expr $h/16]]
set bwdmv [vector_new [expr $w/16] [expr $h/16]]
set scy [sc_new [expr $w/8] [expr $h/8]]
set scu [sc_new [expr $w/16] [expr $h/16]]
set scv [sc_new [expr $w/16] [expr $h/16]]
set fh [mpeg_pic_hdr_new]
#----------------------------------------------------------------
# initialize stuff for ppm file output
# we only need to write the header once.
#----------------------------------------------------------------
set pnmhdr [pnm_hdr_new]
pnm_hdr_set_type $pnmhdr "ppm-bin"
pnm_hdr_set_width $pnmhdr $seqw
pnm_hdr_set_height $pnmhdr $seqh
pnm_hdr_set_maxval $pnmhdr 255
set outbs [bitstream_new [expr 3*$seqw*$seqh + 20]]
set outbp [bitparser_new]
bitparser_wrap $outbp $outbs
pnm_hdr_encode $pnmhdr $outbp
pnm_hdr_free $pnmhdr
#----------------------------------------------------------------
# Now start decoding the video frames. In each loop we make sure
# there are at least picSize bytes available in the bitstream buffer.
#----------------------------------------------------------------
mpeg_pic_hdr_find $bp
set count 0
set gopSize 0
set gopStart 0
while {1} {
check_bitstream_underflow $bs $bp $file $picSize
mpeg_pic_hdr_parse $bp $fh
set type [mpeg_pic_hdr_get_type $fh]
set temporalRef [mpeg_pic_hdr_get_temporal_ref $fh]
set count [expr $gopStart + $temporalRef]
incr gopSize 1
if {$type == "i"} {
swap futurey prevy
swap futureu prevu
swap futurev prevv
mpeg_pic_i_parse $bp $sh $fh $scy $scu $scv
sc_i_to_byte $scy $y
sc_i_to_byte $scu $u
sc_i_to_byte $scv $v
yuv_to_rgb_420 $y $u $v $r $g $b
write_ppm $r $g $b $outbs $outbp [format "%03di.ppm" $count]
swap y futurey
swap u futureu
swap v futurev
} elseif { $type == "p"} {
swap futurey prevy
swap futureu prevu
swap futurev prevv
mpeg_pic_p_parse $bp $sh $fh $scy $scu $scv $fwdmv
sc_p_to_y $scy $fwdmv $prevy $y
sc_p_to_uv $scu $fwdmv $prevu $u
sc_p_to_uv $scv $fwdmv $prevv $v
yuv_to_rgb_420 $y $u $v $r $g $b
write_ppm $r $g $b $outbs $outbp [format "%03dp.ppm" $count]
swap y futurey
swap u futureu
swap v futurev
} else {
mpeg_pic_b_parse $bp $sh $fh $scy $scu $scv $fwdmv $bwdmv
sc_b_to_y $scy $fwdmv $bwdmv $prevy $futurey $y
sc_b_to_uv $scu $fwdmv $bwdmv $prevu $futureu $u
sc_b_to_uv $scv $fwdmv $bwdmv $prevv $futurev $v
yuv_to_rgb_420 $y $u $v $r $g $b
write_ppm $r $g $b $outbs $outbp [format "%03db.ppm" $count]
}
set currCode [mpeg_get_curr_start_code $bp]
if {$currCode == "gop-start-code"} {
incr gopStart $gopSize
set gopSize 0
}
mpeg_pic_hdr_find $bp
if {$currCode == "seq-end-code"} {
break
}
}
#----------------------------------------------------------------
# clean up
#----------------------------------------------------------------
mpeg_pic_hdr_free $fh
mpeg_seq_hdr_free $sh
bitstream_free $bs
bitparser_free $bp
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 $futurey
byte_free $futureu
byte_free $futurev
sc_free $scy
sc_free $scu
sc_free $scv
vector_free $fwdmv
vector_free $bwdmv