#------------------------------------------------------------------------
#
# 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
source makeindex.tcl
#---------------------------------------------------------------
# Get inputs from user or command line arguments
#---------------------------------------------------------------
if {$argc < 3} {
puts "enter the MPEG file to extract from: "
set infile [gets stdin]
puts "enter start frame: "
set start [gets stdin]
puts "enter end frame: "
set end [gets stdin]
} else {
set infile [lindex $argv 0]
set start [lindex $argv 1]
set end [lindex $argv 2]
}
if {$end < $start} {
error "end cannot be less than start!"
}
#---------------------------------------------------------------
# proc swap
#
# swap the value of two pointers.
#---------------------------------------------------------------
proc swap {a b} {
upvar $a aa
upvar $b bc
set temp $aa
set aa $bc
set bc $temp
}
#---------------------------------------------------------------
# proc write_pgm
#
# This procedure encode a 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_pgm {y bsmpeg bpmpeg name} {
set chan [open $name w]
fconfigure $chan -translation binary -buffersize 65536
set curr [bitparser_tell $bpmpeg]
pgm_encode $y $bpmpeg
bitstream_channel_write $bsmpeg $chan 0
bitparser_seek $bpmpeg $curr
close $chan
}
#----------------------------------------------------------------
# open file, create new bitparser, new bitstream, mmap entire file
# to bitstream and attach the bitparser to the bitstream
#----------------------------------------------------------------
set bpmpeg [bitparser_new]
set bsmpeg [bitstream_mmap_read_new $infile]
set inname [lindex $infile 0]
bitparser_wrap $bpmpeg $bsmpeg
#----------------------------------------------------------------
# Call make_mpeg_video_index (defined in makeindex.tcl)
# to creates an index to the video.
#----------------------------------------------------------------
set in [make_mpeg_video_index $bpmpeg]
#----------------------------------------------------------------
# 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 $bpmpeg
mpeg_seq_hdr_parse $bpmpeg $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 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 pgm file output
# we only need to write the header once.
#----------------------------------------------------------------
set pnmhdr [pnm_hdr_new]
pnm_hdr_set_type $pnmhdr "pgm-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
#----------------------------------------------------------------
# Find out how many frames must we decode in order to decode
# frame $start. We then call mpeg_video_index_findrefs
# to retrives index entries of frames that are needed to be
# decoded in order to decode frame $start. These index
# entries will be stored in a second mpeg_video_index called $out.
#
# Now start decoding the video frames from out index. These are
# not written to disk, but decoded in memory until size = 0.
#----------------------------------------------------------------
set size [mpeg_video_index_numrefs $in $start]
set out [mpeg_video_index_new $size]
mpeg_video_index_findrefs $in $out $start
for {set i [expr $size-1]} {$i >= 0} {incr i -1} {
set offset [mpeg_video_index_get_offset $out $i]
bitparser_seek $bpmpeg $offset
mpeg_pic_hdr_parse $bpmpeg $fh
set type [mpeg_pic_hdr_get_type $fh]
swap futurey prevy
if {$type == "i"} {
mpeg_pic_i_parse $bpmpeg $sh $fh $scy $scu $scv
sc_i_to_byte $scy $y
} elseif { $type == "p"} {
mpeg_pic_p_parse $bpmpeg $sh $fh $scy $scu $scv $fwdmv
sc_p_to_y $scy $fwdmv $prevy $y
}
swap y futurey
}
swap prevy futurey
#----------------------------------------------------------------
# Now start decoding the video frames to write to disk. This
# process is very similar to mpgtopgm.tcl.
#
# These decoding process is in display order.
# - I frame : if this frame hasn't been decoded before, decode it.
# - P frame : if this frame hasn't been decoded before, decode it.
# - B frame : find the future frame, decode the future frame, and
# decode this frame. Mark the future frame as decoded.
# so we don't need to decode it again.
#----------------------------------------------------------------
set futureframe -1
mpeg_pic_hdr_find $bpmpeg
set currFrame $start
while {$currFrame <= $end} {
set offset [mpeg_video_index_get_offset $in $currFrame]
bitparser_seek $bpmpeg $offset
mpeg_pic_hdr_parse $bpmpeg $fh
set type [mpeg_pic_hdr_get_type $fh]
if {$type == "i"} {
if {$currFrame == $futureframe} {
write_pgm $futurey $outbs $outbp [format "%03di.pgm" $currFrame]
swap futurey prevy
} else {
mpeg_pic_i_parse $bpmpeg $sh $fh $scy $scu $scv
sc_i_to_byte $scy $y
write_pgm $y $outbs $outbp [format "%03di.pgm" $currFrame]
swap y prevy
}
} elseif {$type == "p"} {
if {$currFrame == $futureframe} {
write_pgm $futurey $outbs $outbp [format "%03dp.pgm" $currFrame]
swap futurey prevy
} else {
mpeg_pic_p_parse $bpmpeg $sh $fh $scy $scu $scv $fwdmv
sc_p_to_y $scy $fwdmv $prevy $y
write_pgm $y $outbs $outbp [format "%03dp.pgm" $currFrame]
swap y prevy
}
} else {
set frameref [mpeg_video_index_get_next $in $currFrame]
set futureframe [expr $currFrame + $frameref]
set off [mpeg_video_index_get_offset $in $futureframe]
bitparser_seek $bpmpeg $off
mpeg_pic_hdr_parse $bpmpeg $fh
set type [mpeg_pic_hdr_get_type $fh]
# Decode the future frame
if {$type == "i"} {
mpeg_pic_i_parse $bpmpeg $sh $fh $scy $scu $scv
sc_i_to_byte $scy $futurey
} else {
mpeg_pic_p_parse $bpmpeg $sh $fh $scy $scu $scv $fwdmv
sc_p_to_y $scy $fwdmv $prevy $futurey
}
set off [mpeg_video_index_get_offset $in $currFrame]
bitparser_seek $bpmpeg $off
mpeg_pic_hdr_parse $bpmpeg $fh
mpeg_pic_b_parse $bpmpeg $sh $fh $scy $scu $scv $fwdmv $bwdmv
sc_b_to_y $scy $fwdmv $bwdmv $prevy $futurey $y
write_pgm $y $outbs $outbp [format "%03db.pgm" $currFrame]
}
incr currFrame
}
#----------------------------------------------------------------
# clean upmes from out index. These are
# not written to disk, but decoded
#----------------------------------------------------------------
mpeg_pic_hdr_free $fh
mpeg_seq_hdr_free $sh
mpeg_video_index_free $in
mpeg_video_index_free $out
byte_free $y
byte_free $prevy
byte_free $futurey
sc_free $scy
sc_free $scu
sc_free $scv
vector_free $fwdmv
vector_free $bwdmv