#!/usr/bin/perl
# script is based on
# Daktari MIDI, a Midi file dumper. Version 1m
# Time-stamp: "1998-06-15 19:20:51 MDT sburke@alf8.speech.cs.cmu.edu"
#
# stripped down by zentara to only calculate midi playtime
# this code and the original is GPL
# the playtime is computed by cycling thru the tracks and
# getting the longest sigma t out of the tracks
# playtime = (sigma_t_max)/(ticks_per_quarternote * 2) in seconds
my $sigma_t_max = 0;
###########################################################################
#Data tables follow
%meta_event_types = (
0x00, "Set sequence number",
0x01, "Text event",
0x02, "Copyright text event",
0x03, "Track name",
0x04, "Instrument name",
0x05, "Lyric",
0x06, "Marker",
0x07, "Cue point",
0x2F, "End-track event",
0x51, "Set tempo",
0x58, "Time signature",
0x59, "Key signature",
0x7F, "Seq-specific information",
);
%event_types = (
0x80, "Note off",
0x90, "Note on",
0xA0, "Key after-touch",
0xB0, "Control change",
0xC0, "Program (patch) change",
0xD0, "Channel after-touch",
0xE0, "Pitch wheel change",
);
die "No arguments\n" unless @ARGV;
die "Can't open $ARGV[0] \: $!\n" unless open(MIDI, "<$ARGV[0]");
binmode(MIDI);
print "File: $ARGV[0]\n";
die "can't read header" unless read(MIDI, $in, 14); # the header length
($id, $length, $format, $tracks, $ticks) = unpack('A4Nnnn', $in);
die "Almost definitely not a MIDI file\n" unless $id eq 'MThd';
print "Unexpected header length ($length)!\n" unless $length == 6;
printf "Format: %d\nTracks: %d\nTicks per quarter note: %d\n",
$format, $tracks, $ticks;
Track_Chunk:
until(eof(MIDI)) {
$sum_t = 0;
read(MIDI, $track_header, 8) || die "Can't read track header\n";
($id, $length) = unpack('A4N', $track_header);
print "\nTrack chunk of $length bytes\n"; #!#
read(MIDI, $track_chunk, $length);
unless($id eq 'MTrk') {
print " Unknown track-chunk type $id of length $length\n";
next Track_Chunk; # leave this track unanalyzed
}
print "Track chunk is short by ", ($length - length($track_chunk)), " bytes\n"
if $length != length($track_chunk);
Event: # analyze the event stream
while(length($track_chunk)){ # while there's anything to analyze
# <MTrk event> = <delta-time> <event>
# <event> = <midi event | sysex event | meta-event>
$event = '';
# Slice off the delta time code, and analyze it
if( $track_chunk =~ s/^([\x80-\xFF]*[\x00-\x7F])// ) {
$time_code = $1; # This is a valid time-code.
$event .= $1;
} else { # didn't get sliced off; must be bad
print " Bad track-chunk data format. No time code found.\n";
next Track_Chunk;
}
$time = &read_variable_length($time_code);
$sum_t += $time;
$formatted_time = sprintf("%06st\: ", $time);
#######################
# Now let's see what we can make of the command
$first_byte = ord(substr($track_chunk,0,1));
if ($first_byte < 0xF0) { # a MIDI event #######################
if($track_chunk =~ s/^([\x80-\xEF])// ) {
$last_event_code = $event_code = $1;
$event .= $1;
} else { # it's a running status mofo.
$event_code = $last_event_code;
}
$command = ord($event_code) & 0xF0;
if ($command == 0xC0 || $command == 0xD0) { # pull off the 1-byte argument
$parameter = substr($track_chunk, 0, 1);
substr($track_chunk, 0, 1) = '';
} else { # pull off the 2-byte argument
$parameter = substr($track_chunk, 0, 2);
substr($track_chunk, 0, 2) = '';
}
next Event;
$channel = ord($event_code) & 0x0F;
$event .= $parameter;
print "$formatted_time $event_types{$command} :: Channel $channel. ";
} elsif($first_byte == 0xFF) { # It's a meta-event! ############
unless($track_chunk =~ /^\xFF(.)([\x80-\xFF]*[\x00-\x7F])/) {
print "$formatted_time Meta-event format error\n";
next Track_Chunk;
}
$command = $1;
$length = $2;
print "$formatted_time Meta-event type \$", unpack("H2", $command),
' (', ($meta_event_types{ord($command)} || '?'),
') of length ', &read_variable_length($length), "\n";
$data = substr($track_chunk,
2 + length($length), # skip the FF, the command, and the length bytes
&read_variable_length($length) ); # the length of the data
# now slice it out
substr($track_chunk, 0,
2 + length($length) + length($data) ) = '';
} elsif($first_byte == 0xF0 # It's a SYSEX ###################
|| $first_byte == 0xF7) {
unless($track_chunk =~ /^([\xF0\xF7])([\x80-\xFF]*[\x00-\x7F])/) {
print "$formatted_time Sysex format error\n";
next Track_Chunk;
}
$command = $1;
$length = $2;
print "$formatted_time Sysex type ", unpack("H2", $command),
' of length ', &read_variable_length($length), "\n";
$data = substr($track_chunk,
1 + length($length), # skip the F7/F0 and the length bytes
&read_variable_length($length) ); # the length of the data
# now slice it out
substr($track_chunk, 0,
1 + length($length) + length($data) ) = '';
} elsif($command == 0xF2) { # It's a Song Position #############
print "$formatted_time Song Position (F2).\n";
substr($track_chunk, 0, 3 ) = ''; # itself, and 2 data bytes
} elsif($command == 0xF3) { # It's a Song Select ###############
print "$formatted_time Song Select (F3).\n";
substr($track_chunk, 0, 2 ) = ''; # itself, and 1 data byte
} elsif($command == 0xF6) { # It's a Tune Request! #############
print "$formatted_time Tune Request (F6) [!!].\n";
# what the sam scratch would a tune request be doing in a MIDI /file/?
substr($track_chunk, 0, 1 ) = ''; # itself
} else { # fall thru
if($track_chunk =~ s/^([\x00-\x7F]+)//) {
if ($1 eq "\x00") {
print "$formatted_time skipping a null\n";
} else {
print "$formatted_time Skipping strange data of length ", length($1), "\n";
}
} else {
print "$formatted_time Unanalyzable data of length ", length($track_chunk), "\n";
last Event;
}
}
}
} continue {
print "Sigma t = ", $sum_t, "\n";
if($sum_t > $sigma_t_max){ $sigma_t_max = $sum_t }
}
print "sigma_t_max = $sigma_t_max\n";
my $play_seconds = ($sigma_t_max)/($ticks * 2);
print "seconds->$play_seconds\n";
my $minutes = int($play_seconds/60);
print "minutes->$minutes\n";
my $secs = $play_seconds - ($minutes * 60);
print "secs->$secs\n";
$secs = sprintf("%.1f", $secs);
print "Playtime MM::SS-> $minutes".'::'."$secs\n";
exit;
#########################################################################
sub read_variable_length {
local($byte, $value, @bytes) = ('',0);
return 0 unless length($_[0]);
# not that we should ever be fed a null string anyway
if($_[0] =~ /^([\x80-\xFF]*[\x00-\x7F])/) {
@bytes = unpack('C*', $1);
} else {
print "bad VL format error\n";
return 0;
}
while(@bytes) {
$byte = shift @bytes;
#!# print "Byte read: $byte\n";
$value = ($value << 7) | ($byte & 0x7f);
if ($value > 0xFFF_FFFF) { # shouldn't ever happen
print "variable-length value goes out of range\n";
return $value >> 7; # some attempt at rectification
}
last unless $byte & 0x80; # a clear 7th bit ends the encoding
}
return $value;
}
###########################################################################
|