Perl-MIDI patch to deal with .RMI files
[email protected] (Roger Crew) Thu, 15 Mar 2001 05:14:11 -0800 (PST)
| Newsgroups | perl.midi |
|---|---|
| Message-ID | <[email protected]> |
The following is a patch to version 0.79 to make it possible to read MIDI
data out of RMID format (.RMI) files.
Background: an RMID file is a RIFF file (RIFF being a general
container format that Microsoft and IBM published about 10 years ago,
that they use for just about everything having to do with multimedia)
consisting of one chunk in Standard MIDI File format and whatever
random extra crap you want in other chunks (usually it's copyright
notices, icons and such; evidently text meta-events weren't enough,
or something).
Anyway, RMID is a format that seems to be overly popular in Windows Land.
So, with this patch, perhaps the most useful thing you can do is
$opus = MIDI::Opus->new({ from_file => 'TUNE.RMI', no_parse => 1 });
$opus->write_to_file('TUNE.MID');
to rip the MIDI data out of TUNE.RMI and write it back out as a
straight MIDI file. For the slightly perverse, we have the
other direction as well:
$opus = MIDI::Opus->new({ from_file => 'TUNE.MID', no_parse => 1 });
$opus->write_to_file('TUNE.RMI');
to throw a bare-bones RMID structure around TUNE.MID.
By default, write_to_file() uses the file extension to decide what to
write, but you can override this
$opus->write_to_file('TUNE.RMI', { filetype => 'MIDI' });
to force the writing of a standard MIDI file in spite of the extension.
(...that a file named something.RMI would henceforth be written out in
RMID format would be the one [silent] change from what the current
version does. I'd argue this is the Right Thing for Windows where a
wrong extension can be very confusing, but it's not clear whether Unix
folks should need to put up with this. On the other hand, it's not
like this sort of thing is without precedent in Unixland, either
(e.g., "cc foo.c" and "cc foo.obj" don't do the same thing)...)
Meanwhile, the truly perverse can specify their own structure
(e.g., to add/replace the copyright notice), if you really care:
$riff = ['RIFF','RMID',
['data'],
['DISP',"\x01\x00\x00\x00Wombat Concerto in D\x00"],
['LIST','INFO',
['IART',"Royal Wombat Orchestra\x00"],
['ICOP',"2001 Yours Truly. All Rights Reserved.\x00"],
['ISBJ',
"Our lawyers will eat your lawyers for breakfast.\x00"]]];
$opus->write_to_file('TUNE.RMI', { riff => $riff });
Anyway, here it is. All changes are in Opus.pm. Modify to taste:
*** c:/prgfiles/perl/site/lib/MIDI/Opus-0-.pm Sat May 13 22:53:00 2000
--- c:/prgfiles/perl/site/lib/MIDI/Opus.pm Thu Mar 15 04:46:33 2001
***************
*** 311,318 ****
=item the method $opus->write_to_file('filespec', { ...options...} )
! Writes $opus as a MIDI file named by the given filespec.
! The options hash is optional, and whatever you specify as options
! percolates down to the calls to MIDI::Event::encode -- which see.
! Currently this just opens the file, calls $opus->write_to_handle
on the resulting filehandle, and closes the file.
--- 311,362 ----
=item the method $opus->write_to_file('filespec', { ...options...} )
! Writes $opus to a file named by the given filespec.
! File is written as either a Standard MIDI File
! or as an RMID file (a standard MIDI file inside a RIFF wrapper).
!
! The options hash is, oddly enough, optional. Available options:
!
! =over
!
! =item filetype => C<MIDI> or C<RMID>
!
! generate a Standard MIDI or RMID file, respectively
!
! =item riff => I<RIFF structure>
!
! a RIFF structure to use for generating the RMID file. The default is
! to either reuse the structure C<$opus-E<gt>{riff}> inherited from
! when C<$opus> was created from an RMID file, or, if there is none, to
! use the canonical MIDI-data-and-nothing-else structure. You can read
! the comments in the source about RIFF format if you care about this.
!
! =back
!
! plus other options that percolate down to
! L<MIDI::Event::encode()|MIDI::Event/item_encode> -- which see.
!
! The type of file generated is chosen according to the following (in order):
!
! =over
!
! =item 1
!
! the 'filetype' option, if given.
!
! =item 2
!
! the extension on 'filespec', if recognized. An extension of F<.mid> or F<.midi>
! implies standard MIDI filetype; an extension of F<.rmi> or F<.rmid> implies RMID
! filetype.
!
! =item 3
!
! If C<$opus-E<gt>{'riff'}> is set to something (as happens when C<$opus> is read
! from an RMID file) or a 'riff' option is explicitly given,
! this implies an RMID file should be generated
!
! =back
!
! Currently L<write_to_file> just opens the file, calls L<write_to_handle>
on the resulting filehandle, and closes the file.
***************
*** 321,327 ****
sub write_to_file { # method
# call as $opus->write_to_file("../../midis/stuff1.mid", { ..options..} );
! my $opus = $_[0];
! my $destination = $_[1];
! my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
croak "No output file specified" unless length($destination);
--- 365,369 ----
sub write_to_file { # method
# call as $opus->write_to_file("../../midis/stuff1.mid", { ..options..} );
! my ($opus, $destination, $options_r) = @_;
croak "No output file specified" unless length($destination);
***************
*** 329,332 ****
--- 371,377 ----
croak "Can't open $destination for writing\: \"$!\"\n";
}
+ # infer filetype from file extension unless already specified
+ $options_r->{'filetype'} ||= $1 if ($destination =~ m/\.(midi?|rmid?)$/i);
+
$opus->write_to_handle( *OUT_MIDI{IO}, $options_r);
close(OUT_MIDI)
***************
*** 364,371 ****
=item the method $opus->write_to_handle(IOREF, { ...options...} )
! Writes $opus as a MIDI file to the IO handle you pass a reference to
! (example: C<*STDOUT{IO}>).
! The options hash is optional, and whatever you specify as options
! percolates down to the calls to MIDI::Event::encode -- which see.
Note that this is probably not what you'd want for sending music
to C</dev/sequencer>, since MIDI files are not MIDI-on-the-wire.
--- 409,419 ----
=item the method $opus->write_to_handle(IOREF, { ...options...} )
! Writes $opus as a Standard MIDI or RMID file to given IO handle
! (passed by reference; example: C<*STDOUT{IO}>). The available options
! and means of choosing the filetype are as for L<write_to_file>
! except that there will be no filename extension to refer to.
! And likewise, other options percolate down to the calls to
! L<MIDI::Event::encode()|MIDI::Event/item_encode> -- which see.
!
Note that this is probably not what you'd want for sending music
to C</dev/sequencer>, since MIDI files are not MIDI-on-the-wire.
***************
*** 374,383 ****
###########################################################################
sub write_to_handle { # method
# Call as $opus->write_to_handle( *FH{IO}, { ...options... });
! my $opus = $_[0];
! my $fh = $_[1];
! my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
binmode($fh);
--- 422,450 ----
###########################################################################
+ our $riff_default_structure = ['RIFF','RMID',['data']];
+
sub write_to_handle { # method
# Call as $opus->write_to_handle( *FH{IO}, { ...options... });
! my ($opus, $fh, $options_r) = @_;
! my $riff_structure = $options_r->{'riff'} || $opus->{'riff'};
! my $filetype = $options_r->{'filetype'};
! my $use_riff = $riff_structure;
! if ($filetype =~ /^rmid?$/i) { $use_riff = 1 }
! elsif ($filetype =~ /^midi?$/i) { $use_riff = 0 }
! elsif ($filetype) { croak "unknown filetype: $filetype" }
! if ($use_riff) {
! write_with_riff_wrapper($fh, $riff_structure || $riff_default_structure,
! { data => sub { $opus->write_midi_data_to_handle($_[0], $options_r) }});
! }
! else {
! $opus->write_midi_data_to_handle($fh, $options_r);
! }
! }
+ sub write_midi_data_to_handle { # method
+ # does the actual work of writing midi data to $fh
+ # in Standard MIDI File format according to $options_r
+ my ($opus, $fh, $options_r) = @_;
+
binmode($fh);
***************
*** 428,461 ****
# MIDI::Opus->new() constructor.
! my $opus = $_[0];
! my $fh = $_[1];
! my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
! my $file_size_left;
! $file_size_left = $_[3] if defined $_[3];
!
binmode($fh);
! my $in = '';
!
! my $track_size_limit;
! $track_size_limit = $options_r->{'track_size'}
! if exists $options_r->{'track_size'};
! croak "Can't even read the first 14 bytes from filehandle $fh"
! unless read($fh, $in, 14);
! # 14 = The expected header length.
! if(defined $file_size_left) {
! $file_size_left -= 14;
}
! my($id, $length, $format, $tracks_expected, $ticks) = unpack('A4Nnnn', $in);
!
! croak "data from handle $fh doesn't start with a MIDI file header"
unless $id eq 'MThd';
! croak "Unexpected MTHd chunk length in data from handle $fh"
! unless $length == 6;
$opus->{'format'} = $format;
! $opus->{'ticks'} = $ticks; # ...which may be a munged 'negative' number
$opus->{'tracks'} = [];
--- 495,524 ----
# MIDI::Opus->new() constructor.
! my ($opus, $fh, $options_r, $file_size_left) = @_;
! my $track_size_limit = $options_r->{'track_size'};
binmode($fh);
! my($id, $length_be, $length_le)
! = readn($fh,8,'A4NX4V',\$file_size_left,"start of file");
! if ($id eq 'RIFF') {
! ($file_size_left, $opus->{'riff'}) = read_as_rmid($fh,$id,$length_le);
! croak "handle $fh: non-RMID RIFF file" unless defined $file_size_left;
! # file cursor is now positioned at the beginning of MIDI data riffchunk
! ($id, $length_be)
! = readn($fh,8,'A4N',\$file_size_left,"midi data RIFFchunk");
}
! croak "handle $fh: MIDI header starts with tag '$id' ('MThd' expected)"
unless $id eq 'MThd';
! croak "handle $fh: MThd chunk length == $length_be? (6 expected)"
! unless $length_be == 6;
!
! my ($format, $tracks_expected, $division)
! = readn($fh,6,'nnn',\$file_size_left,"midi header chunk");
!
$opus->{'format'} = $format;
! $opus->{'ticks'} = $division; # ...which may be a munged 'negative' number
$opus->{'tracks'} = [];
***************
*** 464,507 ****
Track_Chunk:
! until( eof($fh) ) {
++$track_count;
print "Reading Track \# $track_count into a new track\n" if $Debug;
! if(defined $file_size_left) {
! $file_size_left -= 2;
! croak "reading further would exceed file_size_limit"
! if $file_size_left < 0;
! }
! my($header, $data);
! croak "Can't read header for track chunk \#$track_count"
! unless read($fh, $header, 8);
! my($type, $length) = unpack('A4N', $header);
- if(defined $track_size_limit and $track_size_limit > $length) {
croak "Track \#$track_count\'s length ($length) would"
! . " exceed track_size_limit $track_size_limit";
! }
!
! if(defined $file_size_left) {
! $file_size_left -= $length;
! croak "reading track \#$track_count (of length $length) "
! . "would exceed file_size_limit"
! if $file_size_left < 0;
! }
! read($fh, $data, $length); # whooboy, actually read it now
!
! if($length == length($data)) {
push(
@{ $opus->{'tracks'} },
&MIDI::Track::decode( $type, \$data, $options_r )
);
- } else {
- croak
- "Length of track \#$track_count is off in data from $fh; "
- . "I wanted $length\, but got "
- . length($data);
- }
}
--- 527,550 ----
Track_Chunk:
! until( defined $file_size_left ? $file_size_left <= 0 : eof($fh) ) {
++$track_count;
print "Reading Track \# $track_count into a new track\n" if $Debug;
! my($type, $length)
! = readn($fh,8,'A4N',\$file_size_left,"tag/length for midi track chunk \#$track_count");
! # carp "handle $fh: MIDI track chunk starts with tag '$type' ('MTrk' expected)"
! # unless $type eq 'MTrk';
croak "Track \#$track_count\'s length ($length) would"
! . " exceed track_size_limit $track_size_limit"
! if(defined $track_size_limit and $track_size_limit > $length);
! my $data = readn($fh,$length,undef,\$file_size_left,
! "data for midi track chunk \#$track_count");
push(
@{ $opus->{'tracks'} },
&MIDI::Track::decode( $type, \$data, $options_r )
);
}
***************
*** 514,517 ****
--- 557,752 ----
return $opus;
}
+
+
+ sub readn {
+ # read exactly $n bytes from $fh, unpack according to $fmt,
+ # update $$len, croak if we run out of file
+ #
+ my ($fh,$n,$fmt,$len,$what) = @_;
+ croak "handle $fh: attempting to read ".($n-$$len)
+ . " bytes beyond specified length"
+ . ($what&&" (trying to read $what)")
+ if (defined $$len and $$len < $n);
+ read($fh, my $in, $n) == $n ||
+ croak "handle $fh: read error or premature end of file"
+ . ($what&&" trying to read $what");
+ $$len -= $n if (defined $$len);
+ return defined $fmt ? unpack($fmt,$in) : $in;
+ }
+
+ ###########################################################################
+ ## Reading and Writing RMID (.RMI) files
+ ##
+ ## (an RMID file is a MIDI file with a RIFF wrapper around it).
+ ##
+ #
+ # Capsule summary of RIFF format:
+ #
+ # riffchunk = 4 byte tag
+ # + 4 byte length (little-endian)
+ # + data bytes + 0/1 bytes of padding
+ #
+ # possible tags:
+ # 'RIFF' => top level chunk: data = rifftype + riffchunks
+ # 'LIST' => other chunk with nested chunks: data = listtype + riffchunks
+ # no other tags contain nested chunks
+ #
+ # A RIFF file consists of a single 'RIFF' riffchunk.
+ #
+ # unlike MIDI file chunks, RIFF chunks are always padded out to even length
+ # so as to be 16-bit aligned, the length is byte-reversed,
+ # and chunks can nest inside 'RIFF' and 'LIST' chunks.
+ #
+ # The only rifftype we currently care about is 'RMID'
+ # for which the basic format is
+ #
+ # ['RIFF' 'RMID' ['data' mididata ] other_chunks...]
+ #
+ # mididata = data in standard MIDI file format
+ #
+ # Typical other_chunks that occur:
+ #
+ # ['DISP' binarycrap ] data in clipboard format (bitmap or text)
+ # ['LIST' 'INFO'
+ # ['ICOP' stringz ] copyright notice
+ # ['IART' stringz ] artist
+ # ['ISBJ' stringz ] subject
+ # ...]
+ #
+ # where stringz includes a terminating null.
+
+ #-------------------
+ # Reading:
+ #
+
+ our @midi_riffchunks = ();
+
+ sub read_as_rmid {
+ # read from $fh after having seen the tag $id='RIFF' and a $length;
+ # positions $fh at the start of the actual MIDI data and
+ # returns (length of midi data, RIFF structure of file)
+ #
+
+ my ($fh,$id,$length) = @_;
+ local @midi_riffchunks = ();
+ my $riff = read_riffchunk($fh,$id,$length);
+ return undef
+ if ($riff->[1] ne 'RMID');
+ croak "Garbage in file after EOF ($fh)"
+ unless (read($fh, my $toss, 1)==0);
+ croak "Malformed RMID file ($fh): could not find MIDI data "
+ unless (@midi_riffchunks == 1);
+ my ($pos,$len) = @{$midi_riffchunks[0]};
+
+ seek($fh,$pos,0) ||
+ croak "Bad position for MIDI data in RMID file ($fh).";
+
+ return ($len,$riff);
+ }
+
+ my %riff_readers =
+ (RIFF => \&read_riff_list,
+ LIST => \&read_riff_list,
+ data => \&read_riff_mididata,
+ );
+
+
+ sub read_riffchunk {
+ &{$riff_readers{$_[1]}||\&read_riff_default};
+ }
+
+ sub read_riff_list {
+ my ($fh,$id,$length) = @_;
+
+ my $type = readn($fh,4,'A4',\$length,"$id type tag");
+ my @subchunks = ($id, $type);
+ while ($length > 0) {
+ my ($cid,$clength) = readn($fh,8,'A4V',\$length,"$id subchunk length");
+ $length -= $clength + ($clength & 1);
+ croak "handle $fh: RIFF subchunk (size = $clength) larger than parent? ($cid > $id($type))" if $length < 0;
+ push @subchunks, read_riffchunk($fh,$cid,$clength);
+ }
+ \@subchunks;
+ }
+ sub read_riff_mididata {
+ my ($fh,$id,$length) = @_;
+ push @midi_riffchunks,[tell($fh),$length];
+ seek($fh,$length + ($length & 1),1) || croak "handle $fh: mididata seek failed";
+ [$id];
+ }
+ sub read_riff_default {
+ my ($fh,$id,$length) = @_;
+ my $data = readn($fh, $length, undef, \ my $toss, "$id subchunk data");
+ if ($length & 1) {
+ seek($fh,1,1) || croak "handle $fh: otherdata seek failed";
+ }
+ [$id, $data];
+ }
+
+ #-------------------
+ # Writing:
+ #
+
+ our %riff_writers =
+ (RIFF => \&write_riff_list,
+ LIST => \&write_riff_list,
+ );
+
+ # Write $riff_structure to $fh in RIFF format.
+ # $writers is expected to be of the form { tag => &callback ...}
+ # the &callback($fh,'tag',..) gets called for every ['tag',...]
+ # appearing in $riff_structure at the point where the data for
+ # the 'tag' chunk is to be written out.
+ #
+ sub write_with_riff_wrapper {
+ my ($fh,$riff_structure,$writers) = @_;
+ local %riff_writers = (%riff_writers, %$writers);
+ write_riff_chunk($fh,@$riff_structure);
+ }
+
+ sub write_riff_chunk {
+ my($fh,$id,$bytes) = @_;
+ print $fh pack('A4',$id);
+ my $writer = $riff_writers{$id};
+ if ($writer) {
+ print $fh pack('x4'); #fake length
+ my $here = (tell $fh || croak "urk!");
+ &$writer;
+ my $size = (tell $fh || croak "urk!")-$here;
+ seek($fh,$here-4,0) || croak "oops!";
+ print $fh pack('V',$size);
+ seek($fh,$size,1) || croak "oops!";
+ print $fh "\x00" if ($size & 1);
+ }
+ else {
+ print $fh pack ('V/a*',$bytes);
+ print $fh "\x00" if (length($bytes) & 1);
+ }
+ }
+
+ sub write_riff_list {
+ my($fh,$id,$type,@kids) = @_;
+ print $fh pack('A4',$type);
+ foreach (@kids) { write_riff_chunk($fh,@$_); }
+ }
+
+
+ #
+ # testing
+ #
+ sub _blow_chunks {
+ my ($chunk,$indent) = @_;
+ my ($id,@rest) = @$chunk;
+ my $container = ($id eq 'RIFF' || $id eq 'LIST');
+ my $type = ref($rest[0]) ? undef : shift @rest;
+ print ' 'x$indent,$id,' ',$type,"\n";
+ foreach (@rest) {
+ _blow_chunks($_,$indent+4);
+ }
+ }
+
+
+
+
###########################################################################