#!/usr/bin/perl -w # # dumpmidi # John Simpson 2003-06-11 # # dump a MIDI file - show header and events # meant for single-track files (at least for now) # # "-p" option automatically skips headers for palm ".ring" files # # "-h" option automatically skips headers for HoHo-exported files # (see http://www.ranosoft.com/hoho/ for information about HoHo) # # 2003-06-14 jms1 - added support for MThd headers which specify SMPTE timing # values instead of a PPQN value. # # 2005-04-09 jms1 - changed copyright notice to indicate my intention # that this code is licensed under GPL version 2 only, rather than # GPL version 2 "or later". # ############################################################################### # # Copyright (C) 2003-2005 John Simpson. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License, version 2, as # published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # or visit http://www.gnu.org/licenses/gpl.txt # ############################################################################### require 5.003 ; use strict ; use Getopt::Std ; our ( $opt_p , $opt_h ) ; my ( $mch , $mlsb , $mmsb , $mloc ) ; ############################################################################### # # names for the notes my @nname = ( "C0","C#0","D0","D#0","E0","F0","F#0","G0","G#0","A0","A#0","B0", "C1","C#1","D1","D#1","E1","F1","F#1","G1","G#1","A1","A#1","B1", "C2","C#2","D2","D#2","E2","F2","F#2","G2","G#2","A2","A#2","B2", "C3","C#3","D3","D#3","E3","F3","F#3","G3","G#3","A3","A#3","B3", "C4","C#4","D4","D#4","E4","F4","F#4","G4","G#4","A4","A#4","B4", "C5","C#5","D5","D#5","E5","F5","F#5","G5","G#5","A5","A#5","B5", "C6","C#6","D6","D#6","E6","F6","F#6","G6","G#6","A6","A#6","B6", "C7","C#7","D7","D#7","E7","F7","F#7","G7","G#7","A7","A#7","B7", "C8","C#8","D8","D#8","E8","F8","F#8","G8","G#8","A8","A#8","B8", "C9","C#9","D9","D#9","E9","F9","F#9","G9","G#9","A9","A#9","B9", "C10","C#10","D10","D#10","E10","F10","F#10","G10" ) ; ############################################################################## # # read a number of bytes sub rb($;$) { my $fh = shift ; my $count = ( shift || 1 ) ; my $rv = "" ; while ( $count ) { $count -- ; my $ch = getc($fh) ; if ( defined $ch ) { $rv .= $ch ; } else { return $rv ; } } return $rv ; } ############################################################################### # # get a chunk sub getchunk($) { my $fh = shift ; my $type = rb ( $fh , 4 ) ; if ( 0 == length ( $type ) ) { return ( "" , 0 , "" ) ; } my $size = unpack ( "N" , rb ( $fh , 4 ) ) ; my $data = rb ( $fh , $size ) ; my $ld = length ( $data ) ; if ( $ld != $size ) { warn "WARNING: found $ld of $size bytes\n" ; } return ( $type , $size , $data ) ; } ############################################################################### # # show MThd chunk sub show_MThd($$) { my $size = shift ; my $data = shift ; my ( $format , $tracks , $ppqn ) = unpack ( "nnn" , $data ) ; print "MThd: format=[$format] tracks=[$tracks] " ; if ( $ppqn & 0x8000 ) { my $fps = 256 - ( $ppqn >> 8 ) ; my $tpf = $ppqn & 0xFF ; print "fps=[$fps] tpf=[$tpf] (tps=" , $fps * $tpf , ")\n" ; } else { print "ppqn=[$ppqn]\n" ; } } ############################################################################### # # get the first byte from a string # note: needs a REFERENCE to the string # # if count is not specified, assume 1. # however, we need to return an empty string if count=0, rather than # getting one byte anyway. sub rbyte($;$) { my $rdata = shift ; my $count = ( shift || undef ) ; if ( ! defined ( $count ) ) { $count = 1 ; } my $rv = "" ; while ( $count > 0 ) { $count -- ; $$rdata =~ s/^(.)//s ; my $ch = ( $1 || "" ) ; $rv .= $ch ; } return $rv ; } ############################################################################### # # read variable-length quantity sub rvq($) { my $rdata = shift ; my $value = 0 ; my $byte = ord ( rbyte ( $rdata ) ) ; while ( $byte & 0x80 ) { $byte &= 0x7F ; $value += $byte ; $value <<= 7 ; $byte = ord ( rbyte ( $rdata ) ) ; } $value += $byte ; return $value ; } ############################################################################### # # show MTrk chunk sub show_MTrk($$) { my $size = shift ; my $data = shift ; my ( $delay , $event , $dl , $dr , $ch , $kk , $vv , $pp , $cc , $lsb , $msb , $mtype , $esize , $edata , $e1 , $e2 , $e3 , $ee , $nn , $dd , $bb , $tsig , $hev , $lev ) ; print "MTrk: track data follows\n" ; $lev = 0 ; while ( length ( $data ) ) { $delay = rvq ( \$data ) ; $event = ord ( rbyte ( \$data ) ) ; $hev = sprintf ( "%02X" , $event ) ; $dl = "" ; $dr = "" ; if ( $event < 0x80 ) { if ( ( $lev >= 0x80 ) && ( $lev <= 0xAF ) ) { $hev = "--" ; $kk = $event ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $kk , $vv ) ; if ( $lev >= 0x90 && $lev <= 0x9F && 0 == $vv ) { $dr = sprintf ( "KEY UP : chan %d key %s" , $ch , $nname[$kk] ) ; } else { $dr = sprintf ( "%s: chan %d key %s vel %d" , ( $lev < 0x90 ? "KEY UP " : ( $lev < 0xA0 ? "KEY DOWN" : "KEY CHG " ) ) , $ch , $nname[$kk] , $vv ) ; } $event = $lev ; } else { $dl = "" ; $dr = "(unknown)" ; } } elsif ( $event < 0x90 ) { $ch = $event & 0x0F ; $kk = ord ( rbyte ( \$data ) ) ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $kk , $vv ) ; $dr = sprintf ( "KEY UP : chan %d key %s vel %d" , $ch , $nname[$kk] , $vv ) ; } elsif ( $event < 0xA0 ) { $ch = $event & 0x0F ; $kk = ord ( rbyte ( \$data ) ) ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $kk , $vv ) ; $dr = sprintf ( "KEY DOWN: chan %d key %s vel %d" , $ch , $nname[$kk] , $vv ) ; } elsif ( $event < 0xB0 ) { $ch = $event & 0x0F ; $kk = ord ( rbyte ( \$data ) ) ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $kk , $vv ) ; $dr = sprintf ( "KEY CHG : chan %d key %s vel %d" , $ch , $nname[$kk] , $vv ) ; } elsif ( $event < 0xC0 ) { $ch = $event & 0x0F ; $cc = ord ( rbyte ( \$data ) ) ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $cc , $vv ) ; $dr = sprintf ( "CONTROLLER: chan %d ctrl %d value %d" , $ch , $cc , $vv ) ; } elsif ( $event < 0xD0 ) { $ch = $event & 0x0F ; $pp = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X" , $pp ) ; $dr = sprintf ( "PROGRAM: chan %d prog %d" , $ch , $pp ) ; } elsif ( $event < 0xE0 ) { $ch = $event & 0x0F ; $vv = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X" , $vv ) ; $dr = sprintf ( "CHAN PRES: chan %d pres %d" , $ch , $vv ) ; } elsif ( $event < 0xF0 ) { $ch = $event & 0x0F ; $lsb = ord ( rbyte ( \$data ) ) ; $msb = ord ( rbyte ( \$data ) ) ; $dl = sprintf ( "%02X %02X" , $lsb , $msb ) ; $dr = sprintf ( "PITCH BEND: chan %d value %d" , $ch , ( $msb << 7 | $lsb ) ) ; } elsif ( $event == 0xF0 ) { $esize = rvq ( \$data ) ; $edata = rbyte ( \$data , $esize ) ; $dl = "..." ; $dr = "SYSEX message [F0 ...]" ; } elsif ( $event < 0xF7 ) { $dl = "" ; $dr = "(should not be in MIDI file)" ; } elsif ( $event == 0xF7 ) { $esize = rvq ( \$data ) ; $edata = rbyte ( \$data , $esize ) ; $dl = "..." ; $dr = "SYSEX message [...]" ; } elsif ( $event < 0xFF ) { $dl = "" ; $dr = "(should not be in MIDI file)" ; } else # event=0xFF: META event { $mtype = ord ( rbyte ( \$data ) ) ; $esize = rvq ( \$data ) ; $edata = rbyte ( \$data , $esize ) ; if ( $mtype eq 0x2F ) { $dl = "2F 00" ; $dr = "META: End of track" ; } elsif ( $mtype eq 0x51 ) { $e1 = ord ( substr ( $edata , 0 , 1 ) ) ; $e2 = ord ( substr ( $edata , 1 , 1 ) ) ; $e3 = ord ( substr ( $edata , 2 , 1 ) ) ; $ee = ( ( ( $e1 << 8 ) + $e2 ) << 8 ) + $e3 ; $dl = sprintf ( "%02X %02X %02X %02X %02X" , $mtype , $esize , $e1 , $e2 , $e3 ) ; $dr = "META: Set tempo to $ee microseconds" . " per quarter note" ; } elsif ( $mtype eq 0x58 ) { $nn = ord ( substr ( $edata , 0 , 1 ) ) ; $dd = ord ( substr ( $edata , 1 , 1 ) ) ; $cc = ord ( substr ( $edata , 2 , 1 ) ) ; $bb = ord ( substr ( $edata , 3 , 1 ) ) ; $tsig = "$nn/" . (1<<$dd) ; $dl = sprintf ( "%02X %02X %02X %02X %02X %02X" , $mtype , $esize , $nn , $dd , $cc , $bb ) ; $dr = "META: Time signature $tsig, $cc clocks" . " per metronome, $bb/32 notes per" . " 24 MIDI clocks" ; } else { $dl = sprintf ( "%02X %d ..." , $mtype , $esize ) ; $dr = "META event" ; } } printf "%8d %s %-20s %s\n" , $delay , $hev , $dl , $dr ; $lev = $event ; } } ############################################################################### ############################################################################### ############################################################################### getopts ( "ph" ) ; my $file = ( shift || die "No filename specified.\n" ) ; open ( I , "<$file" ) or die "Can\'t read $file: $!\n" ; binmode I ; if ( $opt_p ) # palm ".ring" file: skip to first 00 byte { die "Cannot use -p and -h together\n" if ( $opt_h ) ; $mch = ord ( rb ( \*I ) ) ; while ( $mch ) { $mch = ord ( rb ( \*I ) ) ; } } if ( $opt_h ) # HoHo file: bytes 5-6 have lsb/msb of beginning of MIDI { $mch = rb ( \*I , 4 ) ; $mlsb = ord ( rb ( \*I ) ) ; $mmsb = ord ( rb ( \*I ) ) ; $mloc = ( $mmsb << 8 ) | $mlsb ; print "MIDI starts at offset $mloc\n" ; $mch = rb ( \*I , $mloc - 6 ) ; } ######################################## # get MThd chunk my ( $type , $size , $data ) = getchunk ( \*I ) ; while ( $type ) { if ( "MThd" eq $type ) { show_MThd ( $size , $data ) ; } elsif ( "MTrk" eq $type ) { show_MTrk ( $size , $data ) ; } else { print "$type: unknown type\n" ; } ( $type , $size , $data ) = getchunk ( \*I ) ; } close I ;