MIDI-Perl-0.83/0000755000076500000240000000000012103035753012405 5ustar conklinstaffMIDI-Perl-0.83/ChangeLog0000644000076500000240000001500012102752024014147 0ustar conklinstaff Revision history for Perl suite MIDI-Perl Time-stamp: "2013-02-01 15:40:53 conklin" 2012-11-19 Darrell Conklin conklin@cpan.org * Release 0.83 * fixed GM patch 45 incorrect name: "Orchestral Strings"->"Pizzicato Strings" * added more explanatory error message in Opus.pm (track_count) * added a track->skyline() function 2010-12-23 Darrell Conklin conklin@cpan.org * fixed typo in %Lengths hash in Simple.pm 2010-02-14 Darrell Conklin conklin@cpan.org * maintainer -- DC has taken over as maintainer. Thanks to SB for his excellent module. * Release 0.82 * bug fix in Score.pm where events_r_to_score_r would destructively modify events * bug fix in Score.pm, when presented with two simultaneous events with the same note/channel, which led to unpredictable durations of score events, sometimes negative. * added grid quantization (to Opus, and Score) 2005-01-29 Sean M. Burke sburke@cpan.org * Release 0.81 -- maintenance release. * No Perl changes -- just doc tweaks mostly. * Rearranged the dist's contents to be more modern-like. * Of course, more cowbell. 2002-08-21 Sean M. Burke sburke@cpan.org * Release 0.80 -- just a docfix release, basically * Removing the out-dated Filespec.pod file. * To work around vstrings in Perl 5.6 (etc), MIDI::Simple volume specifications can now be expressed as V64 (etc), whereas previously you could only do v64. Bumping MIDI::SImple version up to 0.80. 2000-08-21 Sean M. Burke sburke@cpan.org * Release 0.79 * Bungled the Makefile on the previous release! This time should work. 2000-08-21 Sean M. Burke sburke@cpan.org * Release 0.78 * Fixed odd bug in MIDI::Score that would prematurely terminate a pending note on one channel if you started (or ended) a note with the same note number on a different channel. New logic assumes (safely, I think) that you can only have one note at a time per note-number per channel. (I.e., you can't start a C5 on channel 3, wait a second, start another C5 on channel 3, and have them both going at the same time. I think that if you start a C5 on channel 3, then start another, the second will implicitly end the first. Please do email me if you think this is non-standard behavior for a sequencer.) 2000-05-20 Sean M. Burke sburke@cpan.org * Release 0.77 * Fixing an incidental bug in MIDI::Simple (which surfaces only in Perl 5.6, apparently). Thanks to Matt Burt (m.burt@bcs.org.uk) for finding the bug, as well as noting the fix. * Changed MIDI::Score::score_r_to_events_r and MIDI::Score::events_r_to_score_r (which were useful only in list context previously) to do something useful (and rather intuitive) in scalar context. 2000-05-14 Sean M. Burke sburke@cpan.org * Release 0.76 * Noting my new email address. * MIDI::_dump_quote() was a bit over-broad in what string values it considered numbers (i.e., what things it didn't have to put quotes around). I've changed it to leave only integers unquoted. This shouldn't make any difference really, since if ever any Perl code (whether in MIDI-Perl or elsewhere) needs to treat a stringified numeral (whether integer or not) as a numeric value, conversion is automatic. Anyhow, almost all (absolutely all?) of the actual numeric arguments to MIDI::Event events are integers. 2000-03-05 Sean M. Burke sburke@netadventure.net * Release 0.75 * ChangeLog now goes recent-to-old, not old-to-recent * Changes in this version were mostly made in August 1999, but just never released: * A few optimizations to Event.pm's loops. * Opus.pm now does a little more sanity-checking, to avoid attempting reads of insane sizes, such as might be attempted in the case of parsing a mangled file. 1999-05-13 Sean M. Burke sburke@netadventure.net * Release 0.74 * Just made a few things friendlier to people using perl -w (warnings) * Did ya see my article on MIDI-Perl in /The Perl Journal/ #14? See www.tpj.com for back issues, or email me -- I might have it in some sort of electronic format. 1999-01-10 Sean M. Burke sburke@netadventure.net * Release 0.73 * Just some changes to the docs: Changed the MIDI homepage URL. Added the Langston reference. 1998-11-09 Sean M. Burke sburke@netadventure.net * Release 0.72 * Shigeaki Kobayashi pointed out a bug in MIDI::Opus's $opus->draw that was making it always ignore its options hashref. Fixed. * More carps/croaks instead of warn/dies. 1998-11-04 Sean M. Burke sburke@netadventure.net * Release 0.71 * Docs for MIDI::Simple are more complete now. * An obscure bit of note_map's behavior changed. But you'd never know, because this is the first version that ever documented note_map at all. * Added relative octave specs: o_d3, o_u3. 1998-10-18 Sean M. Burke sburke@netadventure.net * Release 0.70 * Some stupid typos in MIDI.pm fixed. * MIDI::Simple greatly expanded and changed. Almost a total rewrite, in fact -- too many changes to explain. Docs are feeble, tho. * More modules use strict now. 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.62: Hooboy! Third release in a 24-hour period! This time to fix a lame big in MIDI::Score. 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.61: Feh. Forgot to re-comment out the debug code in MIDI::Simple 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.60: Subtly destructive bug in MIDI::_dump_quote fixed. MIDI::Event::copy_structure didn't work; fixed. %MIDI::note2number and %MIDI::note2number were named backwards -- note2number actually mapped numbers to notes, and number2note mapped notes to numbers. It made no sense, so I reversed it. Ditto patch2number and number2patch! What was I thinking? Typos in %MIDI::note2number fixed. All the A#'s were "A#" instead of "A#3" or whatever. I also changed the "#" for sharp to "s", giving, e.g., "As3" instead of "A#3". This gives a representation compatable with MIDI::Simple's notation. But note that %MIDI::note2number doesn't contain all of the possible ways MIDI::Simple could let you represent a note -- just a (semi-quirky) subset of them. New module MIDI::Simple. Added MIDI::Event:: score subs, to support draw() and MIDI::Simple. Added MIDI::Opus::draw and supporting subs. 1998-08-14 Sean M. Burke sburke@netadventure.net * Release 0.52: makefile fix. chimes example in MIDI.pm 1998-08-13 Sean M. Burke sburke@netadventure.net * Release 0.51: First CPAN release. Get it while it's hot! MIDI-Perl-0.83/lib/0000755000076500000240000000000012103035753013153 5ustar conklinstaffMIDI-Perl-0.83/lib/MIDI/0000755000076500000240000000000012103035753013675 5ustar conklinstaffMIDI-Perl-0.83/lib/MIDI/Event.pm0000644000076500000240000012265511504616621015332 0ustar conklinstaff # Time-stamp: "2010-12-23 09:59:44 conklin" require 5.004; # I need BER working right, among other things. package MIDI::Event; use strict; use vars qw($Debug $VERSION @MIDI_events @Text_events @Nontext_meta_events @Meta_events @All_events ); use Carp; $Debug = 0; $VERSION = '0.83'; #First 100 or so lines of this module are straightforward. The actual # encoding logic below that is scary, tho. =head1 NAME MIDI::Event - MIDI events =head1 SYNOPSIS # Dump a MIDI file's text events die "No filename" unless @ARGV; use MIDI; # which "use"s MIDI::Event; MIDI::Opus->new( { "from_file" => $ARGV[0], "exclusive_event_callback" => sub{print "$_[2]\n"}, "include" => \@MIDI::Event::Text_events } ); # These options percolate down to MIDI::Event::decode exit; =head1 DESCRIPTION Functions and lists to do with MIDI events and MIDI event structures. An event is a list, like: ( 'note_on', 141, 4, 50, 64 ) where the first element is the event name, the second is the delta-time, and the remainder are further parameters, per the event-format specifications below. An I is a list of references to such events -- a "LoL". If you don't know how to deal with LoLs, you I read L. =head1 GOODIES For your use in code (as in the code in the Synopsis), this module provides a few lists: =over =item @MIDI_events a list of all "MIDI events" AKA voice events -- e.g., 'note_on' =item @Text_events a list of all text meta-events -- e.g., 'track_name' =item @Nontext_meta_events all other meta-events (plus 'raw_data' and F-series events like 'tune_request'). =item @Meta_events the combination of Text_events and Nontext_meta_events. =item @All_events the combination of all the above lists. =back =cut ########################################################################### # Some public-access lists: @MIDI_events = qw( note_off note_on key_after_touch control_change patch_change channel_after_touch pitch_wheel_change set_sequence_number ); @Text_events = qw( text_event copyright_text_event track_name instrument_name lyric marker cue_point text_event_08 text_event_09 text_event_0a text_event_0b text_event_0c text_event_0d text_event_0e text_event_0f ); @Nontext_meta_events = qw( end_track set_tempo smpte_offset time_signature key_signature sequencer_specific raw_meta_event sysex_f0 sysex_f7 song_position song_select tune_request raw_data ); # Actually, 'tune_request', for one, is is F-series event, not a # strictly-speaking meta-event @Meta_events = (@Text_events, @Nontext_meta_events); @All_events = (@MIDI_events, @Meta_events); =head1 FUNCTIONS This module provides three functions of interest, which all act upon event structures. As an end user, you probably don't need to use any of these directly, but note that options you specify for MIDI::Opus->new with a from_file or from_handle options will percolate down to these functions; so you should understand the options for the first two of the below functions. (The casual user should merely skim this section.) =over =item MIDI::Event::decode( \$data, { ...options... } ) This takes a I to binary MIDI data and decodes it into a new event structure (a LoL), a I to which is returned. Options are: =over 16 =item 'include' => LISTREF I, listref is interpreted as a reference to a list of event names (e.g., 'cue_point' or 'note_off') such that only these events will be parsed from the binary data provided. Events whose names are NOT in this list will be ignored -- i.e., they won't end up in the event structure, and they won't be each passed to any callbacks you may have specified. =item 'exclude' => LISTREF I, listref is interpreted as a reference to a list of event names (e.g., 'cue_point' or 'note_off') that will NOT be parsed from the binary stream; they'll be ignored -- i.e., they won't end up in the event structure, and they won't be passed to any callbacks you may have specified. Don't specify both an include and an exclude list. And if you specify I, all events will be decoded -- this is what you probably want most of the time. I've created this include/exclude functionality mainly so you can scan a file rather efficiently for just a few specific event types, e.g., just text events, or just sysexes. =item 'no_eot_magic' => 0 or 1 See the description of C<'end_track'>, in "EVENTS", below. =item 'event_callback' => CODEREF If defined, the code referred to (whether as C<\&wanted> or as C) is called on every event after it's been parsed into an event list (and any EOT magic performed), but before it's added to the event structure. So if you want to alter the event stream on the way to the event structure (which counts as deep voodoo), define 'event_callback' and have it modify its C<@_>. =item 'exclusive_event_callback' => CODEREF Just like 'event_callback'; but if you specify this, the callback is called I of adding the events to the event structure. (So the event structure returned by decode() at the end will always be empty.) Good for cases like the text dumper in the Synopsis, above. =back =item MIDI::Event::encode( \@events, {...options...}) This takes a I to an event structure (a LoL) and encodes it as binary data, which it returns a I to. Options: =over 16 =item 'unknown_callback' => CODEREF If this is specified, it's interpreted as a reference to a subroutine to be called when an unknown event name (say, 'macro_10' or something), is seen by encode(). The function is fed all of the event (its name, delta-time, and whatever parameters); the return value of this function is added to the encoded data stream -- so if you don't want to add anything, be sure to return ''. If no 'unknown_callback' is specified, encode() will C (well, C) of the unknown event. To merely block that, just set 'unknown_callback' to C =item 'no_eot_magic' => 0 or 1 Determines whether a track-final 0-length text event is encoded as a end-track event -- since a track-final 0-length text event probably started life as an end-track event read in by decode(), above. =item 'never_add_eot' => 0 or 1 If 1, C never ever I an end-track (EOT) event to the encoded data generated unless it's I there as an 'end_track' in the given event structure. You probably don't ever need this unless you're encoding for I writing to a MIDI port, instead of to a file. =item 'no_running_status' => 0 or 1 If 1, disables MIDI's "running status" compression. Probably never necessary unless you need to feed your MIDI data to a strange old sequencer that doesn't understand running status. =back Note: If you're encoding just a single event at a time or less than a whole trackful in any case, then you probably want something like: $data_r = MIDI::Event::encode( [ [ 'note_on', 141, 4, 50, 64 ] ], { 'never_add_eot' => 1} ); which just encodes that one event I an event structure of one event -- i.e., an LoL that's just a list of one list. But note that running status will not always apply when you're encoding less than a whole trackful at a time, since running status works only within a LoL encoded all at once. This'll result in non-optimally compressed, but still effective, encoding. =item MIDI::Event::copy_structure() This takes a I to an event structure, and returns a I to a copy of it. If you're thinking about using this, you probably should want to use the more straightforward $track2 = $track->copy instead. But it's here if you happen to need it. =back =cut ########################################################################### sub dump { my @event = ref($_[0]) ? @{ $_[0] } : @_; # Works as a method (in theory) or as a normal call print( " [", &MIDI::_dump_quote(@event), "],\n" ); } sub copy_structure { # Takes a REFERENCE to an event structure (a ref to a LoL), # and returns a REFERENCE to a copy of that structure. my $events_r = $_[0]; croak "\$_[0] ($events_r) isn't a reference for MIDI::Event::copy_structure()!!" unless ref($events_r); return [ map( [@$_], @$events_r ) ]; } ########################################################################### # The module code below this line is full of frightening things, all to do # with the actual encoding and decoding of binary MIDI data. ########################################################################### sub read_14_bit { # Decodes to a value 0 to 16383, as is used for some event encoding my($b1, $b2) = unpack("C2", $_[0]); return ($b1 | ($b2 << 7)); } sub write_14_bit { # encode a 14 bit quantity, as needed for some events return pack("C2", ($_[0] & 0x7F), # lower 7 bits (($_[0] >> 7) & 0x7F), # upper 7 bits ); } ########################################################################### # # One definite assumption is made here: that "variable-length-encoded" # quantities MUST NOT exceed 0xFFFFFFF (encoded, "\xFF\xFF\xFF\x7F") # -- i.e., must not take more than 4 bytes to encode. # ### sub decode { # decode track data into an event structure # Calling format: a REFERENCE to a big chunka MTrk track data. # Returns an (unblessed) REFERENCE to an event structure (a LoL) # Note that this is a function call, not a constructor method call. # Why a references and not the things themselves? For efficiency's sake. my $data_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my @events = (); unless(ref($data_r) eq 'SCALAR') { carp "\$_[0] is not a data reference, in MIDI::Event::decode!"; return []; } my %exclude = (); if(defined($options_r->{ 'exclude' })) { if( ref($options_r->{'exclude'}) eq 'ARRAY' ) { @exclude{ @{ $options_r->{'exclude'} } } = undef; } else { croak "parameter for MIDI::Event::decode option 'exclude' must be a listref!" if $options_r->{'exclude'}; # If it's false, carry on silently } } else { # If we get an include (and no exclude), make %exclude a list # of all possible events, /minus/ what include specifies if(defined($options_r->{ 'include' })) { if( ref($options_r->{'include'}) eq 'ARRAY' ) { @exclude{ @All_events } = undef; # rack 'em delete @exclude{ # and break 'em @{ $options_r->{'include'} } }; } else { croak "parameter for decode option 'include' must be a listref!" if $options_r->{'include'}; # If it's false, carry on silently } } } print "Exclusions: ", join(' ', map("<$_>", sort keys %exclude)), "\n" if $Debug; my $event_callback = undef; if(defined($options_r->{ 'event_callback' })) { if( ref($options_r->{'event_callback'}) eq 'CODE' ) { $event_callback = $options_r->{'event_callback'}; } else { carp "parameter for decode option 'event_callback' is not a coderef!\n"; } } my $exclusive_event_callback = undef; if(defined($options_r->{ 'exclusive_event_callback' })) { if( ref($options_r->{'exclusive_event_callback'}) eq 'CODE' ) { $exclusive_event_callback = $options_r->{'exclusive_event_callback'}; } else { carp "parameter for decode option 'exclusive_event_callback' is not a coderef!\n"; } } my $Pointer = 0; # points to where I am in the data ###################################################################### if($Debug) { if($Debug == 1) { print "Track data of ", length($$data_r), " bytes.\n"; } else { print "Track data of ", length($$data_r), " bytes: <", $$data_r ,">\n"; } } =head1 EVENTS AND THEIR DATA TYPES =head2 DATA TYPES Events use these data types: =over =item channel = a value 0 to 15 =item note = a value 0 to 127 =item dtime = a value 0 to 268,435,455 (0x0FFFFFFF) =item velocity = a value 0 to 127 =item channel = a value 0 to 15 =item patch = a value 0 to 127 =item sequence = a value 0 to 65,535 (0xFFFF) =item text = a string of 0 or more bytes of of ASCII text =item raw = a string of 0 or more bytes of binary data =item pitch_wheel = a value -8192 to 8191 (0x1FFF) =item song_pos = a value 0 to 16,383 (0x3FFF) =item song_number = a value 0 to 127 =item tempo = microseconds, a value 0 to 16,777,215 (0x00FFFFFF) =back For data types not defined above, (e.g., I and I for C<'key_signature'>), consult L and/or the source for C. And if you don't see it documented, it's probably because I don't understand it, so you'll have to consult a real MIDI reference. =head2 EVENTS And these are the events: =over =cut # Things I use variously, below. They're here just for efficiency's sake, # to avoid remying on each iteration. my($command, $channel, $parameter, $length, $time, $remainder); my $event_code = -1; # used for running status my $event_count = 0; Event: # Analyze the event stream. while($Pointer + 1 < length($$data_r)) { # loop while there's anything to analyze ... my $eot = 0; # When 1, the event registrar aborts this loop ++$event_count; my @E = (); # E for events -- this is what we'll feed to the event registrar # way at the end. # Slice off the delta time code, and analyze it #!# print "Chew-code <", substr($$data_r,$Pointer,4), ">\n"; ($time, $remainder) = unpack("wa*", substr($$data_r,$Pointer,4)); #!# print "Delta-time $time using ", 4 - length($remainder), " bytes\n" #!# if $Debug > 1; $Pointer += 4 - length($remainder); # We do this strangeness with remainders because we don't know # how many bytes the w-decoding should move the pointer ahead. # Now let's see what we can make of the command my $first_byte = ord(substr($$data_r, $Pointer, 1)); # Whatever parses $first_byte is responsible for moving $Pointer # forward. #!#print "Event \# $event_count: $first_byte at track-offset $Pointer\n" #!# if $Debug > 1; ###################################################################### if ($first_byte < 0xF0) { # It's a MIDI event ######################## if($first_byte >= 0x80) { print "Explicit event $first_byte" if $Debug > 2; ++$Pointer; # It's an explicit event. $event_code = $first_byte; } else { # It's a running status mofo -- just use last $event_code value if($event_code == -1) { warn "Uninterpretable use of running status; Aborting track." if $Debug; last Event; } # Let the argument-puller-offer move Pointer. } $command = $event_code & 0xF0; $channel = $event_code & 0x0F; if ($command == 0xC0 || $command == 0xD0) { # Pull off the 1-byte argument $parameter = substr($$data_r, $Pointer, 1); ++$Pointer; } else { # pull off the 2-byte argument $parameter = substr($$data_r, $Pointer, 2); $Pointer += 2; } ################################################################### # MIDI events =item ('note_off', I, I, I, I) =cut if ($command == 0x80) { next if $exclude{'note_off'}; # for sake of efficiency @E = ( 'note_off', $time, $channel, unpack('C2', $parameter)); =item ('note_on', I, I, I, I) =cut } elsif ($command == 0x90) { next if $exclude{'note_on'}; @E = ( 'note_on', $time, $channel, unpack('C2', $parameter)); =item ('key_after_touch', I, I, I, I) =cut } elsif ($command == 0xA0) { next if $exclude{'key_after_touch'}; @E = ( 'key_after_touch', $time, $channel, unpack('C2', $parameter)); =item ('control_change', I, I, I, I) =cut } elsif ($command == 0xB0) { next if $exclude{'control_change'}; @E = ( 'control_change', $time, $channel, unpack('C2', $parameter)); =item ('patch_change', I, I, I) =cut } elsif ($command == 0xC0) { next if $exclude{'patch_change'}; @E = ( 'patch_change', $time, $channel, unpack('C', $parameter)); =item ('channel_after_touch', I, I, I) =cut } elsif ($command == 0xD0) { next if $exclude{'channel_after_touch'}; @E = ('channel_after_touch', $time, $channel, unpack('C', $parameter)); =item ('pitch_wheel_change', I, I, I) =cut } elsif ($command == 0xE0) { next if $exclude{'pitch_wheel_change'}; @E = ('pitch_wheel_change', $time, $channel, &read_14_bit($parameter) - 0x2000); } else { warn # Should be QUITE impossible! "SPORK ERROR M:E:1 in track-offset $Pointer\n"; } ###################################################################### } elsif($first_byte == 0xFF) { # It's a Meta-Event! ################## ($command, $length, $remainder) = unpack("xCwa*", substr($$data_r, $Pointer, 6)); $Pointer += 6 - length($remainder); # Move past JUST the length-encoded. =item ('set_sequence_number', I, I) =cut if($command == 0x00) { @E = ('set_sequence_number', $time, unpack('n', substr($$data_r, $Pointer, $length) ) ); # Defined text events ---------------------------------------------- =item ('text_event', I, I) =item ('copyright_text_event', I, I) =item ('track_name', I, I) =item ('instrument_name', I, I) =item ('lyric', I, I) =item ('marker', I, I) =item ('cue_point', I, I) =item ('text_event_08', I, I) =item ('text_event_09', I, I) =item ('text_event_0a', I, I) =item ('text_event_0b', I, I) =item ('text_event_0c', I, I) =item ('text_event_0d', I, I) =item ('text_event_0e', I, I) =item ('text_event_0f', I, I) =cut } elsif($command == 0x01) { @E = ('text_event', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x02) { @E = ('copyright_text_event', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x03) { @E = ('track_name', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x04) { @E = ('instrument_name', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x05) { @E = ('lyric', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x06) { @E = ('marker', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x07) { @E = ('cue_point', $time, substr($$data_r, $Pointer, $length)); # DTime, TData # Reserved but apparently unassigned text events -------------------- } elsif($command == 0x08) { @E = ('text_event_08', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x09) { @E = ('text_event_09', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0a) { @E = ('text_event_0a', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0b) { @E = ('text_event_0b', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0c) { @E = ('text_event_0c', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0d) { @E = ('text_event_0d', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0e) { @E = ('text_event_0e', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0f) { @E = ('text_event_0f', $time, substr($$data_r, $Pointer, $length)); # DTime, TData # Now the sticky events --------------------------------------------- =item ('end_track', I) =cut } elsif($command == 0x2F) { @E = ('end_track', $time ); # DTime # The code for handling this oddly comes LATER, in the # event registrar. =item ('set_tempo', I, I) =cut } elsif($command == 0x51) { @E = ('set_tempo', $time, unpack("N", "\x00" . substr($$data_r, $Pointer, $length) ) ); # DTime, Microseconds =item ('smpte_offset', I, I
, I, I, I, I) =cut } elsif($command == 0x54) { @E = ('smpte_offset', $time, unpack("C*", # there SHOULD be exactly 5 bytes here substr($$data_r, $Pointer, $length) )); # DTime, HR, MN, SE, FR, FF =item ('time_signature', I, I, I
, I, I) =cut } elsif($command == 0x58) { @E = ('time_signature', $time, unpack("C*", # there SHOULD be exactly 4 bytes here substr($$data_r, $Pointer, $length) )); # DTime, NN, DD, CC, BB =item ('key_signature', I, I, I) =cut } elsif($command == 0x59) { @E = ('key_signature', $time, unpack("cC", # there SHOULD be exactly 2 bytes here substr($$data_r, $Pointer, $length) )); # DTime, SF(signed), MI =item ('sequencer_specific', I, I) =cut } elsif($command == 0x7F) { @E = ('sequencer_specific', $time, substr($$data_r, $Pointer, $length)); # DTime, Binary Data =item ('raw_meta_event', I, I(0-255), I) =cut } else { @E = ('raw_meta_event', $time, $command, substr($$data_r, $Pointer, $length) # "[uninterpretable meta-event $command of length $length]" ); # DTime, Command, Binary Data # It's uninterpretable; record it as raw_data. } # End of the meta-event ifcase. $Pointer += $length; # Now move Pointer ###################################################################### } elsif($first_byte == 0xF0 # It's a SYSEX ######################### || $first_byte == 0xF7) { # Note that sysexes in MIDI /files/ are different than sysexes in # MIDI transmissions!! # << The vast majority of system exclusive messages will just use the F0 # format. For instance, the transmitted message F0 43 12 00 07 F7 would # be stored in a MIDI file as F0 05 43 12 00 07 F7. As mentioned above, # it is required to include the F7 at the end so that the reader of the # MIDI file knows that it has read the entire message. >> # (But the F7 is omitted if this is a non-final block in a multiblock # sysex; but the F7 (if there) is counted in the message's declared # length, so we don't have to think about it anyway.) ($command, $length, $remainder) = unpack("Cwa*", substr($$data_r, $Pointer, 5)); $Pointer += 5 - length($remainder); # Move past just the encoding =item ('sysex_f0', I, I) =item ('sysex_f7', I, I) =cut @E = ( $first_byte == 0xF0 ? 'sysex_f0' : 'sysex_f7', $time, substr($$data_r, $Pointer, $length) ); # DTime, Data $Pointer += $length; # Now move past the data ###################################################################### # Now, the MIDI file spec says: # = + # = # = | | # I know that, on the wire, can include note_on, # note_off, and all the other 8x to Ex events, AND Fx events # other than F0, F7, and FF -- namely, , # , and . # # Whether these can occur in MIDI files is not clear specified from # the MIDI file spec. # # So, I'm going to assume that they CAN, in practice, occur. # I don't know whether it's proper for you to actually emit these # into a MIDI file. # ###################################################################### } elsif($first_byte == 0xF2) { # It's a Song Position ################ =item ('song_position', I) =cut # ::= F2 @E = ('song_position', $time, &read_14_bit(substr($$data_r,$Pointer+1,2) ) ); # DTime, Beats $Pointer += 3; # itself, and 2 data bytes ###################################################################### } elsif($first_byte == 0xF3) { # It's a Song Select ################## =item ('song_select', I, I) =cut # ::= F3 @E = ( 'song_select', $time, unpack('C', substr($$data_r,$Pointer+1,1) ) ); # DTime, Thing (?!) ... song number? whatever that is $Pointer += 2; # itself, and 1 data byte ###################################################################### } elsif($first_byte == 0xF6) { # It's a Tune Request! ################ =item ('tune_request', I) =cut # ::= F6 @E = ( 'tune_request', $time ); # DTime # What the Sam Scratch would a tune request be doing in a MIDI /file/? ++$Pointer; # itself ########################################################################### ## ADD MORE META-EVENTS HERE #Done: # f0 f7 -- sysexes # f2 -- song position # f3 -- song select # f6 -- tune request # ff -- metaevent ########################################################################### #TODO: # f1 -- MTC Quarter Frame Message. one data byte follows. # One data byte follows the Status. It's the time code value, a number # from 0 to 127. # f8 -- MIDI clock. no data. # fa -- MIDI start. no data. # fb -- MIDI continue. no data. # fc -- MIDI stop. no data. # fe -- Active sense. no data. # f4 f5 f9 fd -- unallocated ###################################################################### } elsif($first_byte > 0xF0) { # Some unknown kinda F-series event #### =item ('raw_data', I, I) =cut # Here we only produce a one-byte piece of raw data. # But the encoder for 'raw_data' accepts any length of it. @E = ( 'raw_data', $time, substr($$data_r,$Pointer,1) ); # DTime and the Data (in this case, the one Event-byte) ++$Pointer; # itself ###################################################################### } else { # Fallthru. How could we end up here? ###################### warn "Aborting track. Command-byte $first_byte at track offset $Pointer"; last Event; } # End of the big if-group ##################################################################### ###################################################################### ## # By the Power of Greyskull, I AM THE EVENT REGISTRAR! ## if( @E and $E[0] eq 'end_track' ) { # This's the code for exceptional handling of the EOT event. $eot = 1; unless( defined($options_r->{'no_eot_magic'}) and $options_r->{'no_eot_magic'} ) { if($E[1] > 0) { @E = ('text_event', $E[1], ''); # Make up a fictive 0-length text event as a carrier # for the non-zero delta-time. } else { # EOT with a delta-time of 0. Ignore it! @E = (); } } } if( @E and exists( $exclude{$E[0]} ) ) { if($Debug) { print " Excluding:\n"; &dump(@E); } } else { if($Debug) { print " Processing:\n"; &dump(@E); } if(@E){ if( $exclusive_event_callback ) { &{ $exclusive_event_callback }( @E ); } else { &{ $event_callback }( @E ) if $event_callback; push(@events, [ @E ]); } } } =back Three of the above events are represented a bit oddly from the point of view of the file spec: The parameter I for C<'pitch_wheel_change'> is a value -8192 to 8191, although the actual encoding of this is as a value 0 to 16,383, as per the spec. Sysex events are represented as either C<'sysex_f0'> or C<'sysex_f7'>, depending on the status byte they are encoded with. C<'end_track'> is a bit stranger, in that it is almost never actually found, or needed. When the MIDI decoder sees an EOT (i.e., an end-track status: FF 2F 00) with a delta time of 0, it is I! If in the unlikely event that it has a nonzero delta-time, it's decoded as a C<'text_event'> with whatever that delta-time is, and a zero-length text parameter. (This happens before the C<'event_callback'> or C<'exclusive_event_callback'> callbacks are given a crack at it.) On the encoding side, an EOT is added to the end of the track as a normal part of the encapsulation of track data. I chose to add this special behavior so that you could add events to the end of a track without having to work around any track-final C<'end_track'> event. However, if you set C as a decoding parameter, none of this magic happens on the decoding side -- C<'end_track'> is decoded just as it is. And if you set C as an encoding parameter, then a track-final 0-length C<'text_event'> with non-0 delta-times is left as is. Normally, such an event would be converted from a C<'text_event'> to an C<'end_track'> event with thath delta-time. Normally, no user needs to use the C option either in encoding or decoding. But it is provided in case you need your event LoL to be an absolutely literal representation of the binary data, and/or vice versa. =cut last Event if $eot; } # End of the bigass "Event" while-block return \@events; } ########################################################################### sub encode { # encode an event structure, presumably for writing to a file # Calling format: # $data_r = MIDI::Event::encode( \@event_lol, { options } ); # Takes a REFERENCE to an event structure (a LoL) # Returns an (unblessed) REFERENCE to track data. # If you want to use this to encode a /single/ event, # you still have to do it as a reference to an event structure (a LoL) # that just happens to have just one event. I.e., # encode( [ $event ] ) or encode( [ [ 'note_on', 100, 5, 42, 64] ] ) # If you're doing this, consider the never_add_eot track option, as in # print MIDI ${ encode( [ $event], { 'never_add_eot' => 1} ) }; my $events_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my @data = (); # what I'll store chunks of data in my $data = ''; # what I'll join @data all together into croak "MIDI::Event::encode's argument must be an array reference!" unless ref($events_r); # better be an array! my @events = @$events_r; # Yes, copy it. This is so my end_track magic won't corrupt the original my $unknown_callback = undef; $unknown_callback = $options_r->{'unknown_callback'} if ref($options_r->{'unknown_callback'}) eq 'CODE'; unless($options_r->{'never_add_eot'}) { # One way or another, tack on an 'end_track' if(@events) { # If there's any events... my $last = $events[ -1 ]; unless($last->[0] eq 'end_track') { # ...And there's no end_track already if($last->[0] eq 'text_event' and length($last->[2]) == 0) { # 0-length text event at track-end. if($options_r->{'no_eot_magic'}) { # Exceptional case: don't mess with track-final # 0-length text_events; just peg on an end_track push(@events, ['end_track', 0]); } else { # NORMAL CASE: replace it with an end_track, leaving the DTime $last->[0] = 'end_track'; } } else { # last event was neither a 0-length text_event nor an end_track push(@events, ['end_track', 0]); } } } else { # an eventless track! @events = ['end_track',0]; } } #print "--\n"; #foreach(@events){ MIDI::Event::dump($_) } #print "--\n"; my $maybe_running_status = not $options_r->{'no_running_status'}; my $last_status = -1; # Here so we don't have to re-my on every iteration my(@E, $event, $dtime, $event_data, $status, $parameters); Event_Encode: foreach my $event_r (@events) { next unless ref($event_r); # what'd such a thing ever be doing in here? @E = @$event_r; # Yes, copy it. Otherwise the shifting'd corrupt the original next unless @E; $event = shift @E; next unless length($event); $dtime = int shift @E; $event_data = ''; if( # MIDI events -- eligible for running status $event eq 'note_on' or $event eq 'note_off' or $event eq 'control_change' or $event eq 'key_after_touch' or $event eq 'patch_change' or $event eq 'channel_after_touch' or $event eq 'pitch_wheel_change' ) { #print "ziiz $event\n"; # $status = $parameters = ''; # This block is where we spend most of the time. Gotta be tight. if($event eq 'note_off'){ $status = 0x80 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'note_on'){ $status = 0x90 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'key_after_touch'){ $status = 0xA0 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'control_change'){ $status = 0xB0 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0xFF, int($E[2]) & 0xFF); } elsif($event eq 'patch_change'){ $status = 0xC0 | (int($E[0]) & 0x0F); $parameters = pack('C', int($E[1]) & 0xFF); } elsif($event eq 'channel_after_touch'){ $status = 0xD0 | (int($E[0]) & 0x0F); $parameters = pack('C', int($E[1]) & 0xFF); } elsif($event eq 'pitch_wheel_change'){ $status = 0xE0 | (int($E[0]) & 0x0F); $parameters = &write_14_bit(int($E[1]) + 0x2000); } else { die "BADASS FREAKOUT ERROR 31415!"; } # And now the encoding push(@data, ($maybe_running_status and $status == $last_status) ? pack('wa*', $dtime, $parameters) : # If we can use running status. pack('wCa*', $dtime, $status, $parameters) # If we can't. ); $last_status = $status; next; } else { # Not a MIDI event. # All the code in this block could be more efficient, but frankly, # this is not where the code needs to be tight. # So we wade thru the cases and eventually hopefully fall thru # with $event_data set. #print "zaz $event\n"; $last_status = -1; if($event eq 'raw_meta_event') { $event_data = pack("CCwa*", 0xFF, int($E[0]), length($E[1]), $E[1]); # Text meta-events... } elsif($event eq 'text_event') { $event_data = pack("CCwa*", 0xFF, 0x01, length($E[0]), $E[0]); } elsif($event eq 'copyright_text_event') { $event_data = pack("CCwa*", 0xFF, 0x02, length($E[0]), $E[0]); } elsif($event eq 'track_name') { $event_data = pack("CCwa*", 0xFF, 0x03, length($E[0]), $E[0]); } elsif($event eq 'instrument_name') { $event_data = pack("CCwa*", 0xFF, 0x04, length($E[0]), $E[0]); } elsif($event eq 'lyric') { $event_data = pack("CCwa*", 0xFF, 0x05, length($E[0]), $E[0]); } elsif($event eq 'marker') { $event_data = pack("CCwa*", 0xFF, 0x06, length($E[0]), $E[0]); } elsif($event eq 'cue_point') { $event_data = pack("CCwa*", 0xFF, 0x07, length($E[0]), $E[0]); } elsif($event eq 'text_event_08') { $event_data = pack("CCwa*", 0xFF, 0x08, length($E[0]), $E[0]); } elsif($event eq 'text_event_09') { $event_data = pack("CCwa*", 0xFF, 0x09, length($E[0]), $E[0]); } elsif($event eq 'text_event_0a') { $event_data = pack("CCwa*", 0xFF, 0x0a, length($E[0]), $E[0]); } elsif($event eq 'text_event_0b') { $event_data = pack("CCwa*", 0xFF, 0x0b, length($E[0]), $E[0]); } elsif($event eq 'text_event_0c') { $event_data = pack("CCwa*", 0xFF, 0x0c, length($E[0]), $E[0]); } elsif($event eq 'text_event_0d') { $event_data = pack("CCwa*", 0xFF, 0x0d, length($E[0]), $E[0]); } elsif($event eq 'text_event_0e') { $event_data = pack("CCwa*", 0xFF, 0x0e, length($E[0]), $E[0]); } elsif($event eq 'text_event_0f') { $event_data = pack("CCwa*", 0xFF, 0x0f, length($E[0]), $E[0]); # End of text meta-events } elsif($event eq 'end_track') { $event_data = "\xFF\x2F\x00"; } elsif($event eq 'set_tempo') { $event_data = pack("CCwa*", 0xFF, 0x51, 3, substr( pack('N', $E[0]), 1, 3 )); } elsif($event eq 'smpte_offset') { $event_data = pack("CCwCCCCC", 0xFF, 0x54, 5, @E[0,1,2,3,4] ); } elsif($event eq 'time_signature') { $event_data = pack("CCwCCCC", 0xFF, 0x58, 4, @E[0,1,2,3] ); } elsif($event eq 'key_signature') { $event_data = pack("CCwcC", 0xFF, 0x59, 2, @E[0,1]); } elsif($event eq 'sequencer_specific') { $event_data = pack("CCwa*", 0xFF, 0x7F, length($E[0]), $E[0]); # End of Meta-events # Other Things... } elsif($event eq 'sysex_f0') { $event_data = pack("Cwa*", 0xF0, length($E[0]), $E[0]); } elsif($event eq 'sysex_f7') { $event_data = pack("Cwa*", 0xF7, length($E[0]), $E[0]); } elsif($event eq 'song_position') { $event_data = "\xF2" . &write_14_bit( $E[0] ); } elsif($event eq 'song_select') { $event_data = pack('CC', 0xF3, $E[0] ); } elsif($event eq 'tune_request') { $event_data = "\xF6"; } elsif($event eq 'raw_data') { $event_data = $E[0]; # End of Other Stuff } else { # The Big Fallthru if($unknown_callback) { push(@data, &{ $unknown_callback }( @$event_r )); } else { warn "Unknown event: \'$event\'\n"; # To surpress complaint here, just set # 'unknown_callback' => sub { return () } } next; } #print "Event $event encoded part 2\n"; push(@data, pack('wa*', $dtime, $event_data)) if length($event_data); # how could $event_data be empty } } $data = join('', @data); return \$data; } ########################################################################### ########################################################################### =head1 MIDI BNF For your reference (if you can make any sense of it), here is a copy of the MIDI BNF, as I found it in a text file that's been floating around the Net since the late 1980s. Note that this seems to describe MIDI events as they can occur in MIDI-on-the-wire. I I that realtime data insertion (i.e., the ability to have Erealtime byteEs popping up in the I of messages) is something that can't happen in MIDI files. In fact, this library, as written, I correctly parse MIDI data that has such realtime bytes inserted in messages. Nor does it support representing such insertion in a MIDI event structure that's encodable for writing to a file. (Although you could theoretically represent events with embedded Erealtime byteEs as just C events; but then, you can always stow anything at all in a C event.) 1. ::= < MIDI Stream> 2. ::= | 3. ::= | | 4. ::= 5. ::= 6. ::= 7. ::= 8. ::= C | D 9. ::= 8 | 9 | A | B | E 10. ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | | 8 | 9 | A | B | C | D | E | F 11. ::= 12. ::= | | 13. ::= | 14. ::= | | 15. ::= 16. ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 17. ::= F8 | FA | FB | FC | FE | FF 18. ::= | | | | 19. ::= 20. ::= 21. ::= F0 22. ::= F7 23. ::= | | | | 24. ::= F6 25. ::= 26. ::= 27. ::=F2 28. ::= F3 =head1 COPYRIGHT Copyright (c) 1998-2005 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Sean M. Burke C (Except the BNF -- who knows who's behind that.) =cut 1; __END__ MIDI-Perl-0.83/lib/MIDI/Filespec.pod0000644000076500000240000000034511504611256016137 0ustar conklinstaff#!/usr/local/bin/perl =head1 NAME MIDI::Filespec -- MIDI File Specification =head1 SYNOPSIS (nil) =head1 DESCRIPTION Look around L to get a copy of the MIDI File Format specification. =cut MIDI-Perl-0.83/lib/MIDI/Opus.pm0000644000076500000240000006266112102476603015176 0ustar conklinstaff # Time-stamp: "2010-12-23 10:00:01 conklin" require 5; package MIDI::Opus; use strict; use vars qw($Debug $VERSION); use Carp; $Debug = 0; $VERSION = 0.83; =head1 NAME MIDI::Opus -- functions and methods for MIDI opuses =head1 SYNOPSIS use MIDI; # uses MIDI::Opus et al foreach $one (@ARGV) { my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 }); print "$one has ", scalar( $opus->tracks ) " tracks\n"; } exit; =head1 DESCRIPTION MIDI::Opus provides a constructor and methods for objects representing a MIDI opus (AKA "song"). It is part of the MIDI suite. An opus object has three attributes: a format (0 for MIDI Format 0), a tick parameter (parameter "division" in L), and a list of tracks objects that are the real content of that opus. Be aware that options specified for the encoding or decoding of an opus may not be documented in I module's documentation, as they may be (and, in fact, generally are) options just passed down to the decoder/encoder in MIDI::Event -- so see L for an explanation of most of them, actually. =head1 CONSTRUCTOR AND METHODS MIDI::Opus provides... =over =cut ########################################################################### =item the constructor MIDI::Opus->new({ ...options... }) This returns a new opus object. The options, which are optional, is an anonymous hash. By default, you get a new format-0 opus with no tracks and a tick parameter of 96. There are six recognized options: C, to set the MIDI format number (generally either 0 or 1) of the new object; C, to set its ticks parameter; C, which sets the tracks of the new opus to the contents of the list-reference provided; C, which is an exact synonym of C; C, which reads the opus from the given filespec; and C, which reads the opus from the the given filehandle reference (e.g., C<*STDIN{IO}>), after having called binmode() on that handle, if that's a problem. If you specify either C or C, you probably don't want to specify any of the other options -- altho you may well want to specify options that'll get passed down to the decoder in MIDI::Events, such as 'include' => ['sysex_f0', 'sysex_f7'], just for example. Finally, the option C can be used in conjuction with either C or C, and, if true, will block MTrk tracks' data from being parsed into MIDI events, and will leave them as track data (i.e., what you get from $track->data). This is useful if you are just moving tracks around across files (or just counting them in files, as in the code in the Synopsis, above), without having to deal with any of the events in them. (Actually, this option is implemented in code in MIDI::Track, but in a routine there that I've left undocumented, as you should access it only thru here.) =cut sub new { # Make a new MIDI opus object. my $class = shift; my $options_r = (defined($_[0]) and ref($_[0]) eq 'HASH') ? $_[0] : {}; my $this = bless( {}, $class ); print "New object in class $class\n" if $Debug; return $this if $options_r->{'no_opus_init'}; # bypasses all init. $this->_init( $options_r ); if( exists( $options_r->{'from_file'} ) && defined( $options_r->{'from_file'} ) && length( $options_r->{'from_file'} ) ){ $this->read_from_file( $options_r->{'from_file'}, $options_r ); } elsif( exists( $options_r->{'from_handle'} ) && defined( $options_r->{'from_handle'} ) && length( $options_r->{'from_handle'} ) ){ $this->read_from_handle( $options_r->{'from_handle'}, $options_r ); } return $this; } ########################################################################### =item the method $new_opus = $opus->copy This duplicates the contents of the given opus, and returns the duplicate. If you are unclear on why you may need this function, read the documentation for the C method in L. =cut sub copy { # Duplicate a given opus. Even dupes the tracks. # Call as $new_one = $opus->copy my $opus = shift; my $new = bless( { %{$opus} }, ref $opus ); # a first crude dupe. # yes, bless it into whatever class the original came from $new->{'tracks'} = # Now dupe the tracks. [ map( $_->copy, @{ $new->{'tracks'} } ) ] if $new->{'tracks'}; # (which should always be true anyhoo) return $new; } sub _init { # Init a MIDI object -- (re)set it with given parameters, or defaults my $this = shift; my $options_r = ref($_[0]) eq 'HASH' ? $_[0] : {}; print "_init called against $this\n" if $Debug; if($Debug) { if(%$options_r) { print "Parameters: ", map("<$_>", %$options_r), "\n"; } else { print "Null parameters for opus init\n"; } } $this->{'format'} = defined($options_r->{'format'}) ? $options_r->{'format'} : 1; $this->{'ticks'} = defined($options_r->{'ticks'}) ? $options_r->{'ticks'} : 96; $options_r->{'tracks'} = $options_r->{'tracks_r'} if( exists( $options_r->{'tracks_r'} ) and not exists( $options_r->{'tracks'} ) ); # so tracks_r => [ @tracks ] is a synonym for # tracks => [ @tracks ] # as on option for new() $this->{'tracks'} = ( defined($options_r->{'tracks'}) and ref($options_r->{'tracks'}) eq 'ARRAY' ) ? $options_r->{'tracks'} : [] ; return; } ######################################################################### =item the method $opus->tracks( @tracks ) Returns the list of tracks in the opus, possibly after having set it to @tracks, if specified and not empty. (If you happen to want to set the list of tracks to an empty list, for whatever reason, you have to use "$opus->tracks_r([])".) In other words: $opus->tracks(@tracks) is how to set the list of tracks (assuming @tracks is not empty), and @tracks = $opus->tracks is how to read the list of tracks. =cut sub tracks { my $this = shift; $this->{'tracks'} = [ @_ ] if @_; return @{ $this->{'tracks'} }; } =item the method $opus->tracks_r( $tracks_r ) Returns a reference to the list of tracks in the opus, possibly after having set it to $tracks_r, if specified. "$tracks_r" can actually be any listref, whether it comes from a scalar as in C<$some_tracks_r>, or from something like C<[@tracks]>, or just plain old C<\@tracks> Originally $opus->tracks was the only way to deal with tracks, but I added $opus->tracks_r to make possible 1) setting the list of tracks to (), for whatever that's worth, 2) parallel structure between MIDI::Opus::tracks[_r] and MIDI::Tracks::events[_r] and 3) so you can directly manipulate the opus's tracks, without having to I the list of tracks back and forth. This way, you can say: $tracks_r = $opus->tracks_r(); @some_stuff = splice(@$tracks_r, 4, 6); But if you don't know how to deal with listrefs like that, that's OK, just use $opus->tracks. =cut sub tracks_r { my $this = shift; $this->{'tracks'} = $_[0] if ref($_[0]); return $this->{'tracks'}; } =item the method $opus->ticks( $tick_parameter ) Returns the tick parameter from $opus, after having set it to $tick_parameter, if provided. =cut sub ticks { my $this = shift; $this->{'ticks'} = $_[0] if defined($_[0]); return $this->{'ticks'}; } =item the method $opus->format( $format ) Returns the MIDI format for $opus, after having set it to $format, if provided. =cut sub format { my $this = shift; $this->{'format'} = $_[0] if defined($_[0]); return $this->{'format'}; } sub info { # read-only # Hm, do I really want this routine? For ANYTHING at all? my $this = shift; return ( 'format' => $this->{'format'},# I want a scalar 'ticks' => $this->{'ticks'}, # I want a scalar 'tracks' => $this->{'tracks'} # I want a ref to a list ); } =item the method $new_opus = $opus->quantize This grid quantizes an opus. It simply calls MIDI::Score::quantize on every track. See docs for MIDI::Score::quantize. Original opus is destroyed, use MIDI::Opus::copy if you want to take a copy first. =cut sub quantize { my $this = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my $grid = $options_r->{grid}; if ($grid < 1) {carp "bad grid $grid in MIDI::Opus::quantize!"; return;} return if ($grid eq 1); # no quantizing to do my $qd = $options_r->{durations}; # quantize durations? my $new_tracks_r = []; foreach my $track ($this->tracks) { my $score_r = MIDI::Score::events_r_to_score_r($track->events_r); my $new_score_r = MIDI::Score::quantize($score_r,{grid=>$grid,durations=>$qd}); my $events_r = MIDI::Score::score_r_to_events_r($new_score_r); my $new_track = MIDI::Track->new({events_r=>$events_r}); push @{$new_tracks_r}, $new_track; } $this->tracks_r($new_tracks_r); } ########################################################################### =item the method $opus->dump( { ...options...} ) Dumps the opus object as a bunch of text, for your perusal. Options include: C, if true, will have each event in the opus as a tab-delimited line -- or as delimited with whatever you specify with option C; I, dump the data as Perl code that, if run, would/should reproduce the opus. For concision's sake, the track data isn't dumped, unless you specify the option C as true. =cut sub dump { # method; read-only my $this = $_[0]; my %info = $this->info(); my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; if($options_r->{'flat'}) { # Super-barebones dump mode my $d = $options_r->{'delimiter'} || "\t"; foreach my $track ($this->tracks) { foreach my $event (@{ $track->events_r }) { print( join($d, @$event), "\n" ); } } return; } print "MIDI::Opus->new({\n", " 'format' => ", &MIDI::_dump_quote($this->{'format'}), ",\n", " 'ticks' => ", &MIDI::_dump_quote($this->{'ticks'}), ",\n"; my @tracks = $this->tracks; if( $options_r->{'dump_tracks'} ) { print " 'tracks' => [ # ", scalar(@tracks), " tracks...\n\n"; foreach my $x (0 .. $#tracks) { my $track = $tracks[$x]; print " # Track \#$x ...\n"; if(ref($track)) { $track->dump($options_r); } else { print " # \[$track\] is not a reference!!\n"; } } print " ]\n"; } else { print " 'tracks' => [ ], # ", scalar(@tracks), " tracks (not dumped)\n"; } print "});\n"; return 1; } ########################################################################### # And now the real fun... ########################################################################### =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. =cut 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); unless(open(OUT_MIDI, ">$destination")) { croak "Can't open $destination for writing\: \"$!\"\n"; } $opus->write_to_handle( *OUT_MIDI{IO}, $options_r); close(OUT_MIDI) || croak "Can't close filehandle for $destination\: \"$!\"\n"; return; # nothing useful to return } sub read_from_file { # method, surprisingly enough # $opus->read_from_file("ziz1.mid", {'stuff' => 1}). # Overwrites the contents of $opus with the contents of the file ziz1.mid # $opus is presumably newly initted. # The options hash is optional. # This is currently meant to be called by only the # MIDI::Opus->new() constructor. my $opus = $_[0]; my $source = $_[1]; my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {}; croak "No source file specified" unless length($source); unless(open(IN_MIDI, "<$source")) { croak "Can't open $source for reading\: \"$!\"\n"; } my $size = -s $source; $size = undef unless $size; $opus->read_from_handle(*IN_MIDI{IO}, $options_r, $size); # Thanks to the EFNet #perl cabal for helping me puzzle out "*IN_MIDI{IO}" close(IN_MIDI) || croak "error while closing filehandle for $source\: \"$!\"\n"; return $opus; } =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, since MIDI files are not MIDI-on-the-wire. =cut ########################################################################### 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); my $tracks = scalar( $opus->tracks ); carp "Writing out an opus with no tracks!\n" if $tracks == 0; my $format; if( defined($opus->{'format'}) ) { $format = $opus->{'format'}; } else { # Defaults if($tracks == 0) { $format = 2; # hey, why not? } elsif ($tracks == 1) { $format = 0; } else { $format = 1; } } my $ticks = defined($opus->{'ticks'}) ? $opus->{'ticks'} : 96 ; # Ninety-six ticks per quarter-note seems a pleasant enough default. print $fh ( "MThd\x00\x00\x00\x06", # header; 6 bytes follow pack('nnn', $format, $tracks, $ticks) ); foreach my $track (@{ $opus->{'tracks'} }) { my $data = ''; my $type = substr($track->{'type'} . "\x00\x00\x00\x00", 0, 4); # Force it to be 4 chars long. $data = ${ $track->encode( $options_r ) }; # $track->encode will handle the issue of whether # to use the track's data or its events print $fh ($type, pack('N', length($data)), $data); } return; } ############################################################################ sub read_from_handle { # a method, surprisingly enough # $opus->read_from_handle(*STDIN{IO}, {'stuff' => 1}). # Overwrites the contents of $opus with the contents of the MIDI file # from the filehandle you're passing a reference to. # $opus is presumably newly initted. # The options hash is optional. # This is currently meant to be called by only the # 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'} = []; print "file header from handle $fh read and parsed fine.\n" if $Debug; my $track_count = 0; 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); } } carp "Header in data from $fh says to expect $tracks_expected tracks, " . "but $track_count were found\n" unless $tracks_expected == $track_count; carp "No tracks read in data from $fh\n" if $track_count == 0; return $opus; } ########################################################################### =item the method $opus->draw({ ...options...}) This currently experimental method returns a new GD image object that's a graphic representation of the notes in the given opus. Options include: C -- the width of the image in pixels (defaults to 600); C -- a six-digit hex RGB representation of the background color for the image (defaults to $MIDI::Opus::BG_color, currently '000000'); C -- a reference to a list of colors (in six-digit hex RGB) to use for representing notes on given channels. Defaults to @MIDI::Opus::Channel_colors. This list is a list of pairs of colors, such that: the first of a pair (color N*2) is the color for the first pixel in a note on channel N; and the second (color N*2 + 1) is the color for the remaining pixels of that note. If you specify only enough colors for channels 0 to M, notes on a channels above M will use 'recycled' colors -- they will be plotted with the color for channel "channel_number % M" (where C<%> = the MOD operator). This means that if you specify channel_colors => ['00ffff','0000ff'] then all the channels' notes will be plotted with an aqua pixel followed by blue ones; and if you specify channel_colors => ['00ffff','0000ff', 'ff00ff','ff0000'] then all the I channels' notes will be plotted with an aqua pixel followed by blue ones, and all the I channels' notes will be plotted with a purple pixel followed by red ones. As to what to do with the object you get back, you probably want something like: $im = $chachacha->draw; open(OUT, ">$gif_out"); binmode(OUT); print OUT $im->gif; close(OUT); Using this method will cause a C if it can't successfully C. I emphasise that C is expermental, and, in any case, is only meant to be a crude hack. Notably, it does not address well some basic problems: neither volume nor patch-selection (nor any notable aspects of the patch selected) are represented; pitch-wheel changes are not represented; percussion (whether on percussive patches or on channel 10) is not specially represented, as it probably should be; notes overlapping are not represented at all well. =cut sub draw { # method my $opus = $_[0]; my $options_r = ref($_[1]) ? $_[1] : {}; &use_GD(); # will die at runtime if we call this function but it can't use GD my $opus_time = 0; my @scores = (); foreach my $track ($opus->tracks) { my($score_r, $track_time) = MIDI::Score::events_r_to_score_r( $track->events_r ); push(@scores, $score_r) if @$score_r; $opus_time = $track_time if $track_time > $opus_time; } my $width = $options_r->{'width'} || 600; croak "opus can't be drawn because it takes no time" unless $opus_time; my $pixtix = $opus_time / $width; # Number of ticks a pixel represents my $im = GD::Image->new($width,127); # This doesn't handle pitch wheel, nor does it tread things on channel 10 # (percussion) as specially as it probably should. # The problem faced here is how to map onto pixel color all the # characteristics of a note (say, Channel, Note, Volume, and Patch). # I'll just do it for channels. Rewrite this on your own if you want # something different. my $bg_color = $im->colorAllocate(unpack('C3', pack('H2H2H2',unpack('a2a2a2', ( length($options_r->{'bg_color'}) ? $options_r->{'bg_color'} : $MIDI::Opus::BG_color) ))) ); @MIDI::Opus::Channel_colors = ( '00ffff' , '0000ff' ) unless @MIDI::Opus::Channel_colors; my @colors = map( $im->colorAllocate( unpack('C3', pack('H2H2H2',unpack('a2a2a2',$_))) ), # convert 6-digit hex to a scalar tuple ref($options_r->{'channel_colors'}) ? @{$options_r->{'channel_colors'}} : @MIDI::Opus::Channel_colors ); my $channels_in_palette = int(@colors / 2); $im->fill(0,0,$bg_color); foreach my $score_r (@scores) { foreach my $event_r (@$score_r) { next unless $event_r->[0] eq 'note'; my($time, $duration, $channel, $note, $volume) = @{$event_r}[1,2,3,4,5]; my $y = 127 - $note; my $start_x = $time / $pixtix; $im->line($start_x, $y, ($time + $duration) / $pixtix, $y, $colors[1 + ($channel % $channels_in_palette)] ); $im->setPixel($start_x , $y, $colors[$channel % $channels_in_palette] ); } } return $im; # Returns the GD object, which the user then dumps however } #-------------------------------------------------------------------------- { # Closure so we can use this wonderful variable: my $GD_used = 0; sub use_GD { return if $GD_used; eval("use GD;"); croak "You don't seem to have GD installed." if $@; $GD_used = 1; return; } # Why use GD at runtime like this, instead of at compile-time like normal? # So we can still use everything in this module except &draw even if we # don't have GD on this system. } ###################################################################### # This maps channel number onto colors for draw(). It is quite unimaginative, # and reuses colors two or three times. It's a package global. You can # change it by assigning to @MIDI::Simple::Channel_colors. @MIDI::Opus::Channel_colors = ( 'c0c0ff', '6060ff', # start / sustain color, channel 0 'c0ffc0', '60ff60', # start / sustain color, channel 1, etc... 'ffc0c0', 'ff6060', 'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', 'c0ffff', '60ffff', 'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060', 'c0c0c0', '707070', # channel 10 'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', 'c0ffff', '60ffff', 'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060', ); $MIDI::Opus::BG_color = '000000'; # Black goes with everything, you know. ########################################################################### =back =head1 WHERE'S THE DESTRUCTOR? Because MIDI objects (whether opuses or tracks) do not contain any circular data structures, you don't need to explicitly destroy them in order to deallocate their memory. Consider this code snippet: use MIDI; foreach $one (@ARGV) { my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 }); print "$one has ", scalar( $opus->tracks ) " tracks\n"; } At the end of each iteration of the foreach loop, the variable $opus goes away, along with its contents, a reference to the opus object. Since no other references to it exist (i.e., you didn't do anything like push(@All_opuses,$opus) where @All_opuses is a global), the object is automagically destroyed and its memory marked for recovery. If you wanted to explicitly free up the memory used by a given opus object (and its tracks, if those tracks aren't used anywhere else) without having to wait for it to pass out of scope, just replace it with a new empty object: $opus = MIDI::Opus->new; or replace it with anything at all -- or even just undef it: undef $opus; Of course, in the latter case, you can't then use $opus as an opus object anymore, since it isn't one. =head1 NOTE ON TICKS If you want to use "negative" values for ticks (so says the spec: "If division is negative, it represents the division of a second represented by the delta-times in the file,[...]"), then it's up to you to figure out how to represent that whole ball of wax so that when it gets C'd as an "n", it comes out right. I think it'll involve something like: $opus->ticks( (unpack('C', pack('c', -25)) << 8) & 80 ); for bit resolution (80) at 25 f/s. But I've never tested this. Let me know if you get it working right, OK? If anyone I get it working right, and tells me how, I'll try to support it natively. =head1 NOTE ON WARN-ING AND DIE-ING In the case of trying to parse a malformed MIDI file (which is not a common thing, in my experience), this module (or MIDI::Track or MIDI::Event) may warn() or die() (Actually, carp() or croak(), but it's all the same in the end). For this reason, you shouldn't use this suite in a case where the script, well, can't warn or die -- such as, for example, in a CGI that scans for text events in a uploaded MIDI file that may or may not be well-formed. If this I the kind of task you or someone you know may want to do, let me know and I'll consider some kind of 'no_die' parameter in future releases. (Or just trap the die in an eval { } around your call to anything you think you could die.) =head1 COPYRIGHT Copyright (c) 1998-2002 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Sean M. Burke C (until 2010) Darrell Conklin C (from 2010) =cut 1; __END__ MIDI-Perl-0.83/lib/MIDI/Score.pm0000644000076500000240000004136712103035507015316 0ustar conklinstaff # Time-stamp: "2013-02-01 22:40:45 conklin" require 5; package MIDI::Score; use strict; use vars qw($Debug $VERSION); use Carp; $VERSION = '0.83'; =head1 NAME MIDI::Score - MIDI scores =head1 SYNOPSIS # it's a long story; see below =head1 DESCRIPTION This module provides functions to do with MIDI scores. It is used as the basis for all the functions in MIDI::Simple. (Incidentally, MIDI::Opus's draw() method also uses some of the functions in here.) Whereas the events in a MIDI event structure are items whose timing is expressed in delta-times, the timing of items in a score is expressed as an absolute number of ticks from the track's start time. Moreover, pairs of 'note_on' and 'note_off' events in an event structure are abstracted into a single 'note' item in a score structure. 'note' takes the following form: ('note_on', I, I, I, I, I) The problem that score structures are meant to solve is that 1) people definitely don't think in delta-times -- they think in absolute times or in structures based on that (like 'time from start of measure'); 2) people think in notes, not note_on and note_off events. So, given this event structure: ['text_event', 0, 'www.ely.anglican.org/parishes/camgsm/chimes.html'], ['text_event', 0, 'Lord through this hour/ be Thou our guide'], ['text_event', 0, 'so, by Thy power/ no foot shall slide'], ['patch_change', 0, 1, 8], ['note_on', 0, 1, 25, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 29, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 27, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 20, 96], ['note_off', 192, 0, 1, 0], ['note_on', 0, 1, 25, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 27, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 29, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 25, 96], ['note_off', 192, 0, 1, 0], ['note_on', 0, 1, 29, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 25, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 27, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 20, 96], ['note_off', 192, 0, 1, 0], ['note_on', 0, 1, 20, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 27, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 29, 96], ['note_off', 96, 0, 1, 0], ['note_on', 0, 1, 25, 96], ['note_off', 192, 0, 1, 0], here is the corresponding score structure: ['text_event', 0, 'www.ely.anglican.org/parishes/camgsm/chimes.html'], ['text_event', 0, 'Lord through this hour/ be Thou our guide'], ['text_event', 0, 'so, by Thy power/ no foot shall slide'], ['patch_change', 0, 1, 8], ['note', 0, 96, 1, 25, 96], ['note', 96, 96, 1, 29, 96], ['note', 192, 96, 1, 27, 96], ['note', 288, 192, 1, 20, 96], ['note', 480, 96, 1, 25, 96], ['note', 576, 96, 1, 27, 96], ['note', 672, 96, 1, 29, 96], ['note', 768, 192, 1, 25, 96], ['note', 960, 96, 1, 29, 96], ['note', 1056, 96, 1, 25, 96], ['note', 1152, 96, 1, 27, 96], ['note', 1248, 192, 1, 20, 96], ['note', 1440, 96, 1, 20, 96], ['note', 1536, 96, 1, 27, 96], ['note', 1632, 96, 1, 29, 96], ['note', 1728, 192, 1, 25, 96] Note also that scores aren't crucially ordered. So this: ['note', 768, 192, 1, 25, 96], ['note', 960, 96, 1, 29, 96], ['note', 1056, 96, 1, 25, 96], means the same thing as: ['note', 960, 96, 1, 29, 96], ['note', 768, 192, 1, 25, 96], ['note', 1056, 96, 1, 25, 96], The only exception to this is in the case of things like: ['patch_change', 200, 2, 15], ['note', 200, 96, 2, 25, 96], where two (or more) score items happen I and where one affects the meaning of the other. =head1 WHAT CAN BE IN A SCORE Besides the new score structure item C (covered above), the possible contents of a score structure can be summarized thus: Whatever can appear in an event structure can appear in a score structure, save that its second parameter denotes not a delta-time in ticks, but instead denotes the absolute number of ticks from the start of the track. To avoid the long periphrase "items in a score structure", I will occasionally refer to items in a score structure as "notes", whether or not they are actually C commands. This leaves "event" to unambiguously denote items in an event structure. These, below, are all the items that can appear in a score. This is basically just a repetition of the table in L, with starttime substituting for dtime -- so refer to L for an explanation of what the data types (like "velocity" or "pitch_wheel"). As far as order, the first items are generally the most important: =over =item ('note', I, I, I, I, I) =item ('key_after_touch', I, I, I, I) =item ('control_change', I, I, I, I) =item ('patch_change', I, I, I) =item ('channel_after_touch', I, I, I) =item ('pitch_wheel_change', I, I, I) =item ('set_sequence_number', I, I) =item ('text_event', I, I) =item ('copyright_text_event', I, I) =item ('track_name', I, I) =item ('instrument_name', I, I) =item ('lyric', I, I) =item ('marker', I, I) =item ('cue_point', I, I) =item ('text_event_08', I, I) =item ('text_event_09', I, I) =item ('text_event_0a', I, I) =item ('text_event_0b', I, I) =item ('text_event_0c', I, I) =item ('text_event_0d', I, I) =item ('text_event_0e', I, I) =item ('text_event_0f', I, I) =item ('end_track', I) =item ('set_tempo', I, I) =item ('smpte_offset', I, I
, I, I, I, I) =item ('time_signature', I, I, I
, I, I) =item ('key_signature', I, I, I) =item ('sequencer_specific', I, I) =item ('raw_meta_event', I, I(0-255), I) =item ('sysex_f0', I, I) =item ('sysex_f7', I, I) =item ('song_position', I) =item ('song_select', I, I) =item ('tune_request', I) =item ('raw_data', I, I) =back =head1 FUNCTIONS This module provides these functions: =over =item $score2_r = MIDI::Score::copy_structure($score_r) This takes a I to a score structure, and returns a I to a copy of it. Example usage: @new_score = @{ MIDI::Score::copy_structure( \@old_score ) }; =cut sub copy_structure { return &MIDI::Event::copy_structure(@_); # hey, a LoL is an LoL } ########################################################################## =item $events_r = MIDI::Score::score_r_to_events_r( $score_r ) =item ($events_r, $ticks) = MIDI::Score::score_r_to_events_r( $score_r ) This takes a I to a score structure, and converts it to an event structure, which it returns a I to. In list context, also returns a second value, a count of the number of ticks that structure takes to play (i.e., the end-time of the temporally last item). =cut sub score_r_to_events_r { # list context: Returns the events_r AND the total tick time # scalar context: Returns events_r my $score_r = $_[0]; my $time = 0; my @events = (); croak "MIDI::Score::score_r_to_events_r's first arg must be a listref" unless ref($score_r); # First, turn instances of 'note' into 'note_on' and 'note_off': foreach my $note_r (@$score_r) { next unless ref $note_r; if($note_r->[0] eq 'note') { my @note_on = @$note_r; #print "In: ", map("<$_>", @note_on), "\n"; $note_on[0] = 'note_on'; my $duration = splice(@note_on, 2, 1); my @note_off = @note_on; # /now/ copy it $note_off[0] = 'note_off'; $note_off[1] += $duration; $note_off[4] = 0; # set volume to 0 push(@events, \@note_on, \@note_off); #print "on: ", map("<$_>", @note_on), "\n"; #print "off: ", map("<$_>", @note_off), "\n"; } else { push(@events, [@$note_r]); } } # warn scalar(@events), " events in $score_r"; $score_r = sort_score_r(\@events); # warn scalar(@$score_r), " events in $score_r"; # Now we turn it into an event structure by fiddling the timing $time = 0; foreach my $event (@$score_r) { next unless ref($event) && @$event; my $delta = $event->[1] - $time; # Figure out the delta $time = $event->[1]; # Move it forward $event->[1] = $delta; # Swap it in } return($score_r, $time) if wantarray; return $score_r; } ########################################################################### =item $score2_r = MIDI::Score::sort_score_r( $score_r) This takes a I to a score structure, and returns a I to a sorted (by time) copy of it. Example usage: @sorted_score = @{ MIDI::Score::sort_score_r( \@old_score ) }; =cut sub sort_score_r { # take a reference to a score LoL, and sort it by note start time, # and return a reference to that sorted LoL. Notes from the same # time must be left in the order they're found!!!! That's why we can't # just use sort { $a->[1] <=> $b->[1] } (@$score_r) my $score_r = $_[0]; my %timing = (); foreach my $note_r (@$score_r) { push( @{$timing{ $note_r->[1] }}, $note_r ) if ref($note_r); } # warn scalar(@$score_r), " events in $score_r"; #print "sequencing for times: ", map("<$_> ", # sort {$a <=> $b} keys(%timing) # ), "\n"; return [ map(@{ $timing{$_} }, sort {$a <=> $b} keys(%timing) ) ]; } ########################################################################### =item $score_r = MIDI::Score::events_r_to_score_r( $events_r ) =item ($score_r, $ticks) = MIDI::Score::events_r_to_score_r( $events_r ) This takes a I to an event structure, converts it to a score structure, which it returns a I to. If called in list context, also returns a count of the number of ticks that structure takes to play (i.e., the end-time of the temporally last item). =cut sub events_r_to_score_r { # Returns the score_r AND the total tick time my $events_r = $_[0]; croak "first argument to MIDI::Score::events_to_score is not a listref!" unless $events_r; my $options_r = ref($_[1]) ? $_[1] : {}; my $time = 0; if( $options_r->{'no_note_abstraction'} ) { my $score_r = MIDI::Event::copy_structure($events_r); foreach my $event_r (@$score_r) { # print join(' ', @$event_r), "\n"; $event_r->[1] = ($time += $event_r->[1]) if ref($event_r); } return($score_r, $time) if wantarray; return $score_r; } else { my %note = (); my @score = map { if(!ref($_)) { (); } else { # 0.82: the following must be declared local local $_ = [@$_]; # copy. $_->[1] = ($time += $_->[1]) if ref($_); if($_->[0] eq 'note_off' or($_->[0] eq 'note_on' && $_->[4] == 0) ) { # End of a note # print "Note off : @$_\n"; # 0.82: handle multiple prior events with same chan/note. if ((exists $note{pack 'CC', @{$_}[2,3]}) && (@{$note{pack 'CC', @{$_}[2,3]}})) { shift(@{$note{pack 'CC', @{$_}[2,3]}})->[2] += $time; unless(@{$note{pack 'CC', @{$_}[2,3]}}) {delete $note{pack 'CC', @{$_}[2,3]};} } (); # Erase this event. } elsif ($_->[0] eq 'note_on') { # Start of a note $_ = [@$_]; push(@{$note{ pack 'CC', @{$_}[2,3] }},$_); splice(@$_, 2, 0, -$time); $_->[0] = 'note'; # ('note', Starttime, Duration, Channel, Note, Veloc) $_; } else { $_; } } } @$events_r ; #print "notes remaining on stack: ", scalar(values %note), "\n" # if values %note; # 0.82: clean up pending events gracefully foreach my $k (keys %note) { foreach my $one (@{$note{$k}}) { $one->[2] += $time; } } return(\@score, $time) if wantarray; return \@score; } } ########################################################################### =item $ticks = MIDI::Score::score_r_time( $score_r ) This takes a I to a score structure, and returns a count of the number of ticks that structure takes to play (i.e., the end-time of the temporally last item). =cut sub score_r_time { # returns the duration of the score you pass a reference to my $score_r = $_[0]; croak "arg 1 of MIDI::Score::score_r_time isn't a ref" unless ref $score_r; my $track_time = 0; foreach my $event_r (@$score_r) { next unless @$event_r; my $event_end_time = ($event_r->[0] eq 'note') ? ($event_r->[1] + $event_r->[2]) : $event_r->[1] ; #print "event_end_time: $event_end_time\n"; $track_time = $event_end_time if $event_end_time > $track_time; } return $track_time; } ########################################################################### =item MIDI::Score::dump_score( $score_r ) This dumps (via C) a text representation of the contents of the event structure you pass a reference to. =cut sub dump_score { my $score_r = $_[0]; print "\@notes = ( # ", scalar(@$score_r), " notes...\n"; foreach my $note_r (@$score_r) { print " [", &MIDI::_dump_quote(@$note_r), "],\n" if @$note_r; } print ");\n"; return; } ########################################################################### =item MIDI::Score::quantize( $score_r ) This takes a I to a score structure, performs a grid quantize on all events, returning a new score reference with new quantized events. Two parameters to the method are: 'grid': the quantization grid, and 'durations': whether or not to also quantize event durations (default off). When durations of note events are quantized, they can get 0 duration. These events are I from the returned score, and it is the responsiblity of the caller to deal with them. =cut # new in 0.82! sub quantize { my $score_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my $grid = $options_r->{grid}; if ($grid < 1) {carp "bad grid $grid in MIDI::Score::quantize!"; $grid = 1;} my $qd = $options_r->{durations}; # quantize durations? my $new_score_r = []; my $n_event_r; foreach my $event_r (@{$score_r}) { my $n_event_r = []; @{$n_event_r} = @{$event_r}; $n_event_r->[1] = $grid * int(($n_event_r->[1] / $grid) + 0.5); if ($qd && $n_event_r->[0] eq 'note') { $n_event_r->[2] = $grid * int(($n_event_r->[2] / $grid) + 0.5); } push @{$new_score_r}, $n_event_r; } $new_score_r; } ########################################################################### =item MIDI::Score::skyline( $score_r ) This takes a I to a score structure, performs skyline (create a monophonic track by extracting the event with highest pitch at unique onset times) on the score, returning a new score reference. The parameters to the method is: 'clip': whether durations of events are preserved or possibly clipped and modified. To explain this, consider the following (from Bach 2 part invention no.6 in E major): |------e------|-------ds--------|-------d------|... |****--E-----|-------Fs-------|------Gs-----|... Without duration cliping, the skyline is E, Fs, Gs... With duration clipping, the skyline is E, e, ds, d..., where the duration of E is clipped to just the * portion above =cut # new in 0.83! author DC sub skyline { my $score_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my $clip = $options_r->{clip}; my $new_score_r = []; my %events = (); my $n_event_r; my ($typeidx,$stidx,$duridx,$pitchidx) = (0,1,2,4); # create some nicer event indices # gather all note events into an onset-index hash. push all others directly into the new score. foreach my $event_r (@{$score_r}) { if ($event_r->[$typeidx] eq "note") {push @{$events{$event_r->[$stidx]}}, $event_r;} else {push @{$new_score_r}, $event_r;} } my $loff = 0; my $lev = []; # iterate over increasing onsets foreach my $onset (sort {$a<=>$b} (keys %events)) { # find highest pitch at this onset my $ev = (sort {$b->[$pitchidx] <=> $a->[$pitchidx]} (@{$events{$onset}}))[0]; if ($onset >= ($lev->[$stidx] + $lev->[$duridx])) { push @{$new_score_r}, $ev; $lev = $ev; } elsif ($clip) { if ($ev->[$pitchidx] > $lev->[$pitchidx]) { $lev->[$duridx] = $ev->[$stidx] - $lev->[$stidx]; push @{$new_score_r}, $ev; $lev = $ev; } } } $new_score_r; } ########################################################################### =back =head1 COPYRIGHT Copyright (c) 1998-2002 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Sean M. Burke C (until 2010) Darrell Conklin C (from 2010) =cut 1; __END__ MIDI-Perl-0.83/lib/MIDI/Simple.pm0000644000076500000240000017733211504612077015505 0ustar conklinstaff # Time-stamp: "2010-12-23 09:19:57 conklin" require 5; package MIDI::Simple; use MIDI; use Carp; use strict 'vars'; use strict 'subs'; use vars qw(@ISA @EXPORT $VERSION $Debug %package %Volume @Note %Note %Length); use subs qw(&make_opus($\@) &write_score($$\@) &read_score($) &dump_score(\@) ); require Exporter; @ISA = qw(Exporter); $VERSION = '0.83'; $Debug = 0; @EXPORT = qw( new_score n r noop interval note_map Score Time Duration Channel Octave Tempo Notes Volume Score_r Time_r Duration_r Channel_r Octave_r Tempo_r Notes_r Volume_r Cookies Cookies_r Self write_score read_score dump_score make_opus synch is_note_spec is_relative_note_spec is_absolute_note_spec number_to_absolute number_to_relative key_after_touch control_change patch_change channel_after_touch pitch_wheel_change set_sequence_number text_event copyright_text_event track_name instrument_name lyric marker cue_point text_event_08 text_event_09 text_event_0a text_event_0b text_event_0c text_event_0d text_event_0e text_event_0f end_track set_tempo smpte_offset time_signature key_signature sequencer_specific raw_meta_event sysex_f0 sysex_f7 song_position song_select tune_request raw_data ); # _test_proc local %package = (); # hash of package-scores: accessible as $MIDI::Simple::package{"packagename"} # but REALLY think twice about writing to it, OK? # To get at the current package's package-score object, just call # $my_object = Self; # / #| 'Alchemical machinery runs smoothest in the imagination.' #| -- Terence McKenna # \ =head1 NAME MIDI::Simple - procedural/OOP interface for MIDI composition =head1 SYNOPSIS use MIDI::Simple; new_score; text_event 'http://www.ely.anglican.org/parishes/camgsm/bells/chimes.html'; text_event 'Lord through this hour/ be Thou our guide'; text_event 'so, by Thy power/ no foot shall slide'; set_tempo 500000; # 1 qn => .5 seconds (500,000 microseconds) patch_change 1, 8; # Patch 8 = Celesta noop c1, f, o5; # Setup # Now play n qn, Cs; n F; n Ds; n hn, Gs_d1; n qn, Cs; n Ds; n F; n hn, Cs; n qn, F; n Cs; n Ds; n hn, Gs_d1; n qn, Gs_d1; n Ds; n F; n hn, Cs; write_score 'westmister_chimes.mid'; =head1 DESCRIPTION This module sits on top of all the MIDI modules -- notably MIDI::Score (so you should skim L) -- and is meant to serve as a basic interface to them, for composition. By composition, I mean composing anew; you can use this module to add to or modify existing MIDI files, but that functionality is to be considered a bit experimental. This module provides two related but distinct bits of functionality: 1) a mini-language (implemented as procedures that can double as methods) for composing by adding notes to a score structure; and 2) simple functions for reading and writing scores, specifically the scores you make with the composition language. The fact that this module's interface is both procedural and object-oriented makes it a definite two-headed beast. The parts of the guts of the source code are not for the faint of heart. =head1 NOTE ON VERSION CHANGES This module is somewhat incompatible with the MIDI::Simple versions before .700 (but that was a I time ago). =cut %Volume = ( # I've simply made up these values from more or less nowhere. # You no like? Change 'em at runtime, or just use "v64" or whatever, # to specify the volume as a number 1-127. 'ppp' => 1, # pianississimo 'pp' => 12, # pianissimo 'p' => 24, # piano 'mp' => 48, # mezzopiano 'm' => 64, # mezzo / medio / meta` / middle / whatever 'mezzo' => 64, 'mf' => 80, # mezzoforte 'f' => 96, # forte 'ff' => 112, # fortissimo 'fff' => 127, # fortississimo ); %Length = ( # this list should be rather uncontroversial. # The numbers here are multiples of a quarter note's length # The abbreviations are: # qn for "quarter note", # dqn for "dotted quarter note", # ddqn for "double-dotten quarter note", # tqn for "triplet quarter note" 'wn' => 4, 'dwn' => 6, 'ddwn' => 7, 'twn' => (8/3), 'hn' => 2, 'dhn' => 3, 'ddhn' => 3.5, 'thn' => (4/3), 'qn' => 1, 'dqn' => 1.5, 'ddqn' => 1.75, 'tqn' => (2/3), 'en' => .5, 'den' => .75, 'dden' => .875, 'ten' => (1/3), 'sn' => .25, 'dsn' => .375, 'ddsn' => .4375, 'tsn' => (1/6), # Yes, these fractions could lead to round-off errors, I suppose. # But note that 96 * all of these == a WHOLE NUMBER!!!!! # Dangit, tsn for "thirty-second note" clashes with pre-existing tsn for # "triplet sixteenth note" #For 32nd notes, tha values'd be: # .125 .1875 .21875 (1/12) #But hell, just access 'em as: # d12 d18 d21 d8 #(assuming Tempo = 96) ); %Note = ( 'C' => 0, 'Cs' => 1, 'Df' => 1, 'Csharp' => 1, 'Dflat' => 1, 'D' => 2, 'Ds' => 3, 'Ef' => 3, 'Dsharp' => 3, 'Eflat' => 3, 'E' => 4, 'F' => 5, 'Fs' => 6, 'Gf' => 6, 'Fsharp' => 6, 'Gflat' => 6, 'G' => 7, 'Gs' => 8, 'Af' => 8, 'Gsharp' => 8, 'Aflat' => 8, 'A' => 9, 'As' => 10, 'Bf' => 10, 'Asharp' => 10, 'Bflat' => 10, 'B' => 11, ); @Note = qw(C Df D Ef E F Gf G Af A Bf B); # These are for converting note numbers to names, via, e.g., $Note[2] # These must be a subset of the keys to %Note. # You may choose to have these be your /favorite/ names for the particular # notes. I've taken a stab at that myself. ########################################################################### =head2 OBJECT STRUCTURE A MIDI::Simple object is a data structure with the following attributes: =over =item Score This is a list of all the notes (each a listref) that constitute this one-track musical piece. Scores are explained in L. You probably don't need to access the Score attribute directly, but be aware that this is where all the notes you make with C events go. =item Time This is a non-negative integer expressing the start-time, in ticks from the start-time of the MIDI piece, that the next note pushed to the Score will have. =item Channel This is a number in the range [0-15] that specifies the current default channel for note events. =item Duration This is a non-negative (presumably nonzero) number expressing, in ticks, the current default length of note events, or rests. =item Octave This is a number in the range [0-10], expressing what the current default octave number is. This is used for figuring out exactly what note-pitch is meant by a relative note-pitch specification like "A". =item Notes This is a list (presumably non-empty) of note-pitch specifications, I in the range [0-127]. =item Volume This is an integer in the range [0-127] expressing the current default volume for note events. =item Tempo This is an integer expressing the number of ticks a quarter note occupies. It's currently 96, and you shouldn't alter it unless you I know what you're doing. If you want to control the tempo of a piece, use the C routine, instead. =item Cookies This is a hash that can be used by user-defined object-methods for storing whatever they want. =back Each package that you call the procedure C from, has a default MIDI::Simple object associated with it, and all the above attributes are accessible as: @Score $Time $Channel $Duration $Octave @Notes $Volume $Tempo %Cookies (Although I doubt you'll use these from any package other than "main".) If you don't know what a package is, don't worry about it. Just consider these attributes synonymous with the above-listed variables. Just start your programs with use MIDI::Simple; new_score; and you'll be fine. =head2 Routine/Method/Procedure MIDI::Simple provides some pure functions (i.e., things that take input, and give a return value, and that's all they do), but what you're mostly interested in its routines. By "routine" I mean a subroutine that you call, whether as a procedure or as a method, and that affects data structures other than the return value. Here I'm using "procedure" to mean a routine you call like this: name(parameters...); # or, just maybe: name; (In technical terms, I mean a non-method subroutine that can have side effects, and which may not even provide a useful return value.) And I'm using "method" to mean a routine you call like this: $object->name(parameters); So bear these terms in mind when you see routines below that act like one, or the other, or both. =head2 MAIN ROUTINES These are the most important routines: =over =item new_score() or $obj = MIDI::Simple->new_score() As a procedure, this initializes the package's default object (Score, etc.). As a method, this is a constructor, returning a new MIDI::Simple object. Neither form takes any parameters. =cut =item n(...parameters...) or $obj->n(...parameters...) This uses the parameters given (and/or the state variables like Volume, Channel, Notes, etc) to add a new note to the Score -- or several notes to the Score, if Notes has more than one element in it -- or no notes at all, if Notes is empty list. Then it moves Time ahead as appropriate. See the section "Parameters For n/r/noop", below. =cut sub n { # a note my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); &MIDI::Simple::_parse_options($it, @_); foreach my $note_val (@{$it->{"Notes"}}) { # which should presumably not be a null list unless($note_val =~ /^\d+$/) { carp "note value \"$note_val\" from Notes is non-numeric! Skipping."; next; } push @{$it->{"Score"}}, ['note', int(${$it->{"Time"}}), int(${$it->{"Duration"}}), int(${$it->{"Channel"}}), int($note_val), int(${$it->{"Volume"}}), ]; } ${$it->{"Time"}} += ${$it->{"Duration"}}; return; } ########################################################################### =item r(...parameters...) or $obj->r(...parameters...) This is exactly like C, except it never pushes anything to Score, but moves ahead Time. (In other words, there is no such thing as a rest-event; it's just a item during which there are no note-events playing.) =cut sub r { # a rest my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); &MIDI::Simple::_parse_options($it, @_); ${$it->{"Time"}} += ${$it->{"Duration"}}; return; } ########################################################################### =item noop(...parameters...) or $obj->noop(...parameters...) This is exactly like C and C, except it never alters Score, I never changes Time. It is meant to be used for setting the other state variables, i.e.: Channel, Duration, Octave, Volume, Notes. =cut sub noop { # no operation my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); &MIDI::Simple::_parse_options($it, @_); return; } #-------------------------------------------------------------------------- =back =cut =head2 Parameters for n/r/noop A parameter in an C, C, or C call is meant to change an attribute (AKA state variable), namely Channel, Duration, Octave, Volume, or Notes. Here are the kinds of parameters you can use in calls to n/r/noop: * A numeric B parameter. This has the form "V" followed by a positive integer in the range 0 (completely inaudible?) to 127 (AS LOUD AS POSSIBLE). Example: "V90" sets Volume to 90. * An alphanumeric B parameter. This is a key from the hash %MIDI::Simple::Volume. Current legal values are "ppp", "pp", "p", "mp", "mezzo" (or "m"), "mf", "f", "ff", and "fff". Example: "ff" sets Volume to 112. (Note that "m" isn't a good bareword, so use "mezzo" instead, or just always remember to use quotes around "m".) * A numeric B parameter. This has the form "c" followed by a positive integer 0 to 15. Example: "c2", to set Channel to 2. * A numeric B parameter. This has the form "d" followed by a positive (presumably nonzero) integer. Example: "d48", to set Duration to 48. * An alphabetic (or in theory, possibly alphanumeric) B parameter. This is a key from the hash %MIDI::Simple::Length. Current legal values start with "wn", "hn", "qn", "en", "sn" for whole, half, quarter, eighth, or sixteenth notes. Add "d" to the beginning of any of these to get "dotted..." (e.g., "dqn" for a dotted quarter note). Add "dd" to the beginning of any of that first list to get "double-dotted..." (e.g., "ddqn" for a double-dotted quarter note). Add "t" to the beginning of any of that first list to get "triplet..." (e.g., "tsn" for a triplet sixteenth note -- i.e. a note such that 3 of them add up to something as long as one eighth note). You may add to the contents of %MIDI::Simple::Length to support whatever abbreviations you want, as long as the parser can't mistake them for any other kind of n/r/noop parameter. * A numeric, absolute B specification. This has the form: an "o" (lowercase oh), and then an integer in the range 0 to 10, representing an octave 0 to 10. The Octave attribute is used only in resolving relative note specifications, as explained further below in this section. (All absolute note specifications also set Octave to whatever octave they occur in.) * A numeric, relative B specification. This has the form: "o_d" ("d" for down) or "o_u" ("u" for down), and then an integer. This increments, or decrements, Octave. E.g., if Octave is 6, "o_d2" will decrement Octave by 2, making it 4. If this moves Octave below 0, it is forced to 0. Or if it moves Octave above 10, it is forced to 10. (For more information, see the section "Invalid or Out-of-Range Parameters to n/r/noop", below.) * A numeric, absolute B specification. This has the form: an optional "n", and then an integer in the range 0 to 127, representing a note ranging from C0 to G10. The source to L has a useful reference table showing the meanings of given note numbers. Examples: "n60", or "60", which each add a 60 to the list Notes. Since this is a kind of absolute note specification, it sets Octave to whatever octave the given numeric note occurs in. E.g., "n60" is "C5", and therefore sets Octave to 5. The setting of the Notes list is a bit special, compared to how setting the other attributes works. If there are any note specifications in a given parameter list for n, r, or noop, then all those specifications together are assigned to Notes. If there are no note specifications in the parameter list for n, r, or noop, then Notes isn't changed. (But see the description of "rest", at the end of this section.) So this: n mf, n40, n47, n50; sets Volume to 80, and Notes to (40, 47, 50). And it sets Octave, first to 3 (since n40 is in octave 3), then to 3 again (since n47 = B3), and then finally to 4 (since n50 = D4). Note that this is the same as: n n40, n47, n50, mf; The relative orders of parameters is B irrelevant; but see the section "Order of Parameters in a Call to n/r/noop", below. * An alphanumeric, absolute B specification. These have the form: a string denoting a note within the octave (as determined by %MIDI::Simple::Note -- see below, in the description of alphanumeric, relative note specifications), and then a number denoting the octave number (in the range 0-10). Examples: "C3", "As4" or "Asharp4", "Bf9" or "Bflat9". Since this is a kind of absolute note specification, it sets Octave to whatever octave the given numeric note occurs in. E.g., "C3" sets Octave to 3, "As4" sets Octave to 4, and "Bflat9" sets Octave to 9. This: n E3, B3, D4, mf; does the same as this example of ours from before: n n40, n47, n50, mf; * An alphanumeric, relative B specification. These have the form: a string denoting a note within the octave (as determined by %MIDI::Simple::Note), and then an optional parameter "_u[number]" meaning "so many octaves up from the current octave" or "_d[parameter]" meaning "so many octaves down from the current octave". Examples: "C", "As" or "Asharp", "Bflat" or "Bf", "C_d3", "As_d1" or "Asharp_d1", "Bflat_u3" or "Bf_u3". In resolving what actual notes these kinds of specifications denote, the current value of Octave is used. What's a legal for the first bit (before any optional octave up/down specification) comes from the keys to the hash %MIDI::Simple::Note. The current acceptable values are: C (maps to the value 0) Cs or Df or Csharp or Dflat (maps to the value 1) D (maps to the value 2) Ds or Ef or Dsharp or Eflat (maps to the value 3) E (maps to the value 4) F (maps to the value 5) Fs or Gf or Fsharp or Gflat (maps to the value 6) G (maps to the value 7) Gs or Af or Gsharp or Aflat (maps to the value 8) A (maps to the value 9) As or Bf or Asharp or Bflat (maps to the value 10) B (maps to the value 11) (Note that these are based on the English names for these notes. If you prefer to add values to accomodate other strings denoting notes in the octave, you may do so by adding to the hash %MIDI::Simple::Note like so: use MIDI::Simple; %MIDI::Simple::Note = (%MIDI::Simple::Note, # keep all the old values 'H' => 10, 'Do' => 0, # ...etc... ); But the values you add must not contain any characters outside the range [A-Za-z\x80-\xFF]; and your new values must not look like anything that could be any other kind of specification. E.g., don't add "mf" or "o3" to %MIDI::Simple::Note.) Consider that these bits of code all do the same thing: n E3, B3, D4, mf; # way 1 n E3, B, D_u1, mf; # way 2 n o3, E, B, D_u1, mf; # way 3 noop o3, mf; # way 4 n E, B, D_u1; or even n o3, E, B, o4, D, mf; # way 5! n o6, E_d3, B_d3, D_d2, mf; # way 6! If a "_d[number]" would refer to a note in an octave below 0, it is forced into octave 0. If a "_u[number]" would refer to a note in an octave above 10, it is forced into octave 10. E.g., if Octave is 8, "G_u4" would resolve to the same as "G10" (not "G12" -- as that's out of range); if Octave is 2, "G_d4" would resolve to the same as "G0". (For more information, see the section "Invalid or Out-of-Range Parameters to n/r/noop", below.) * The string "C" acts as a sort of note specification -- it sets Notes to empty-list. That way you can make a call to C actually make a rest: n qn, G; # makes a G quarter-note n hn, rest; # half-rest -- alters Notes, making it () n C,G; # half-note chord: simultaneous C and G r; # half-rest -- DOESN'T alter Notes. n qn; # quarter-note chord: simultaneous C and G n rest; # quarter-rest n; # another quarter-rest (If you can follow the above code, then you understand.) A "C" that occurs in a parameter list with other note specs (e.g., "n qn, A, rest, G") has B, so don't do that. =head2 Order of Parameters in a Call to n/r/noop The order of parameters in calls to n/r/noop is not important except insofar as the parameters change the Octave parameter, which may change how some relative note specifications are resolved. For example: noop o4, mf; n G, B, A3, C; is the same as "n mf, G4, B4, A3, C3". But just move that "C" to the start of the list: noop o4, mf; n C, G, B, A3; and you something different, equivalent to "n mf, C4, G4, B4, A3". But note that you can put the "mf" anywhere without changing anything. But B, I strongly advise putting note parameters at the B of the parameter list: n mf, c10, C, B; # 1. good n C, B, mf, c10; # 2. bad n C, mf, c10, B; # 3. so bad! 3 is particularly bad because an uninformed/inattentive reader may get the impression that the C may be at a different volume and on a different channel than the B. (Incidentally, "n C5,G5" and "n G5,C5" are the same for most purposes, since the C and the G are played at the same time, and with the same parameters (channel and volume); but actually they differ in which note gets put in the Score first, and therefore which gets encoded first in the MIDI file -- but this makes no difference at all, unless you're manipulating the note-items in Score or the MIDI events in a track.) =head2 Invalid or Out-of-Range Parameters to n/r/noop If a parameter in a call to n/r/noop is uninterpretable, Perl dies with an error message to that effect. If a parameter in a call to n/r/noop has an out-of-range value (like "o12" or "c19"), Perl dies with an error message to that effect. As somewhat of a merciful exception to this rule, if a parameter in a call to n/r/noop is a relative specification (whether like "o_d3" or "o_u3", or like "G_d3" or "G_u3") which happens to resolve to an out-of-range value (like "G_d3" given an Octave value of 2), then Perl will B die, but instead will silently try to bring that note back into range, by forcing it up to octave 0 (if it would have been lower), or down into 9 or 10 (if it would have been an octave higher than 10, or a note higher than G10), as appropriate. (This becomes strange in that, given an Octave of 8, "G_u4" is forced down to G10, but "A_u4" is forced down to an A9. But that boundary has to pop up someplace -- it's just unfortunate that it's in the middle of octave 10.) =cut sub _parse_options { # common parser for n/r/noop options # This is the guts of the whole module. Understand this and you'll # understand everything. my( $it, @args ) = @_; my @new_notes = (); print "options for _parse_options: ", map("<$_>", @args), "\n" if $Debug > 3; croak "no target for _parse_options" unless ref $it; foreach my $arg (@args) { next unless length($arg); # sanity check if($arg =~ m<^d(\d+)$>s) { # numeric duration spec ${$it->{"Duration"}} = $1; } elsif($arg =~ m<^[vV](\d+)$>s) { # numeric volume spec croak "Volume out of range: $1" if $1 > 127; ${$it->{"Volume"}} = $1; } elsif($arg eq 'rest') { # 'rest' clears the note list @{$it->{"Notes"}} = (); } elsif($arg =~ m<^c(\d+)$>s) { # channel spec croak "Channel out of range: $1" if $1 > 15; ${$it->{"Channel"}} = $1; } elsif($arg =~ m<^o(\d+)$>s) { # absolute octave spec croak "Octave out of range: \"$1\" in \"$arg\"" if $1 > 10; ${$it->{"Octave"}} = int($1); } elsif($arg =~ m<^n?(\d+)$>s) { # numeric note spec # note that the "n" is optional croak "Note out of range: $1" if $1 > 127; push @new_notes, $1; ${$it->{"Octave"}} = int($1 / 12); # The more complex ones follow... } elsif( exists( $MIDI::Simple::Volume{$arg} )) { # volume spec ${$it->{"Volume"}} = $MIDI::Simple::Volume{$arg}; } elsif( exists( $MIDI::Simple::Length{$arg} )) { # length spec ${$it->{"Duration"}} = ${$it->{"Tempo"}} * $MIDI::Simple::Length{$arg}; } elsif($arg =~ m<^o_d(\d+)$>s) { # rel (down) octave spec ${$it->{"Octave"}} -= int($1); ${$it->{"Octave"}} = 0 if ${$it->{"Octave"}} < 0; ${$it->{"Octave"}} = 10 if ${$it->{"Octave"}} > 10; } elsif($arg =~ m<^o_u(\d+)$>s) { # rel (up) octave spec ${$it->{"Octave"}} += int($1); ${$it->{"Octave"}} = 0 if ${$it->{"Octave"}} < 0; ${$it->{"Octave"}} = 10 if ${$it->{"Octave"}} > 10; } elsif( $arg =~ m<^([A-Za-z\x80-\xFF]+)((?:_[du])?\d+)?$>s and exists( $MIDI::Simple::Note{$1}) ) { my $note = $MIDI::Simple::Note{$1}; my $octave = ${$it->{"Octave"}}; my $o_spec = $2; print "note<$1> => <$note> ; octave_spec<$2> Octave<$octave>\n" if $Debug; if(! (defined($o_spec) && length($o_spec))){ # it's a bare note like "C" or "Bflat" # noop } elsif ($o_spec =~ m<^(\d+)$>s) { # absolute! (alphanumeric) ${$it->{"Octave"}} = $octave = $1; croak "Octave out of range: \"$1\" in \"$arg\"" if $1 > 10; } elsif ($o_spec =~ m<^_d(\d+)$>s) { # relative with _dN $octave -= $1; $octave = 0 if $octave < 0; } elsif ($o_spec =~ m<^_u(\d+)$>s) { # relative with _uN $octave += $1; $octave = 10 if $octave > 10; } else { die "Unexpected error 5176123"; } my $note_value = int($note + $octave * 12); # Enforce sanity... while($note_value < 0) { $note_value += 12 } # bump up an octave while($note_value > 127) { $note_value -= 12 } # drop down an octave push @new_notes, $note_value; # 12 = number of MIDI notes in an octive } else { croak "Unknown note/rest option: \"$arg\"" if length($arg); } } @{$it->{"Notes"}} = @new_notes if @new_notes; # otherwise inherit last list return; } # Internal-use proc: create a package object for the package named. sub _package_object { my $package = $_[0] || die "no package!!!"; no strict; print "Linking to package $package\n" if $Debug; $package{$package} = bless { # note that these are all refs, not values "Score" => \@{"$package\::Score"}, "Time" => \${"$package\::Time"}, "Duration" => \${"$package\::Duration"}, "Channel" => \${"$package\::Channel"}, "Octave" => \${"$package\::Octave"}, "Tempo" => \${"$package\::Tempo"}, "Notes" => \@{"$package\::Notes"}, "Volume" => \${"$package\::Volume"}, "Cookies" => \%{"$package\::Cookies"}, }; &_init_score($package{$package}); return $package{$package}; } ########################################################################### sub new_score { my $p1 = $_[0]; my $it; if( defined($p1) && ($p1 eq 'MIDI::Simple' or ref($p1) eq 'MIDI::Simple') ) { # I'm a method! print "~ new_score as a MIDI::Simple constructor\n" if $Debug; $it = bless {}; &_init_score($it); } else { # I'm a proc! my $cpackage = (caller)[0]; print "~ new_score as a proc for package $cpackage\n" if $Debug; if( ref($package{ $cpackage }) ) { # Already exists in %package print "~ reinitting pobj $cpackage\n" if $Debug; &_init_score( $it = $package{ $cpackage } ); # no need to call _package_object } else { # Doesn't exist in %package print "~ new pobj $cpackage\n" if $Debug; $package{ $cpackage } = $it = &_package_object( $cpackage ); # no need to call _init_score } } return $it; # for object use, we'll be capturing this } sub _init_score { # Set some default initial values for the object my $it = $_[0]; print "Initting score $it\n" if $Debug; @{$it->{"Score"}} = (['text_event', 0, "$0 at " . scalar(localtime) ]); ${$it->{"Time"}} = 0; ${$it->{"Duration"}} = 96; # a whole note ${$it->{"Channel"}} = 0; ${$it->{"Octave"}} = 5; ${$it->{"Tempo"}} = 96; # ticks per qn @{$it->{"Notes"}} = (60); # middle C. why not. ${$it->{"Volume"}} = 64; # normal %{$it->{"Cookies"}} = (); # empty return; } ########################################################################### ########################################################################### =head2 ATTRIBUTE METHODS The object attributes discussed above are readable and writeable with object methods. For each attribute there is a read/write method, and a read-only method that returns a reference to the attribute's value: Attribute || R/W-Method || RO-R-Method ----------++-------------++-------------------------------------- Score || Score || Score_r (returns a listref) Notes || Notes || Notes_r (returns a listref) Time || Time || Time_r (returns a scalar ref) Duration || Duration || Duration_r (returns a scalar ref) Channel || Channel || Channel_r (returns a scalar ref) Octave || Octave || Octave_r (returns a scalar ref) Volume || Volume || Volume_r (returns a scalar ref) Tempo || Tempo || Tempo_r (returns a scalar ref) Cookies || Cookies || Cookies_r (returns a hashref) To read any of the above via a R/W-method, call with no parameters, e.g.: $notes = $obj->Notes; # same as $obj->Notes() The above is the read-attribute ("get") form. To set the value, call with parameters: $obj->Notes(13,17,22); The above is the write-attribute ("put") form. Incidentally, when used in write-attribute form, the return value is the same as the parameters, except for Score or Cookies. (In those two cases, I've suppressed it for efficiency's sake.) Alternately (and much more efficiently), you can use the read-only reference methods to read or alter the above values; $notes_r = $obj->Notes_r; # to read: @old_notes = @$notes_r; # to write: @$notes_r = (13,17,22); And this is the only way to set Cookies, Notes, or Score to a (), like so: $notes_r = $obj->Notes_r; @$notes_r = (); Since this: $obj->Notes; is just the read-format call, remember? Like all methods in this class, all the above-named attribute methods double as procedures that act on the default object -- in other words, you can say: Volume 10; # same as: $Volume = 10; @score_copy = Score; # same as: @score_copy = @Score Score @new_score; # same as: @Score = @new_score; $score_ref = Score_r; # same as: $score_ref = \@Score Volume(Volume + 10) # same as: $Volume += 10 But, stylistically, I suggest not using these procedures -- just directly access the variables instead. =cut #-------------------------------------------------------------------------- # read-or-write methods sub Score (;\@) { # yes, a prototype! my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); if(@_) { if($am_method){ @{$it->{'Score'}} = @_; } else { @{$it->{'Score'}} = @{$_[0]}; # sneaky, huh! } return; # special case -- return nothing if this is a PUT } else { return @{$it->{'Score'}}; # you asked for it } } sub Cookies { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); %{$it->{'Cookies'}} = @_ if @_; # Better have an even number of elements! return %{$it->{'Cookies'}}; } sub Time { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Time'}} = $_[0] if @_; return ${$it->{'Time'}}; } sub Duration { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Duration'}} = $_[0] if @_; return ${$it->{'Duration'}}; } sub Channel { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Channel'}} = $_[0] if @_; return ${$it->{'Channel'}}; } sub Octave { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Octave'}} = $_[0] if @_; return ${$it->{'Octave'}}; } sub Tempo { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Tempo'}} = $_[0] if @_; return ${$it->{'Tempo'}}; } sub Notes { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); @{$it->{'Notes'}} = @_ if @_; return @{$it->{'Notes'}}; } sub Volume { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); ${$it->{'Volume'}} = $_[0] if @_; return ${$it->{'Volume'}}; } #-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#- # read-only methods that return references sub Score_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Score'}; } sub Time_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Time'}; } sub Duration_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Duration'}; } sub Channel_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Channel'}; } sub Octave_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Octave'}; } sub Tempo_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Tempo'}; } sub Notes_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Notes'}; } sub Volume_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Volume'}; } sub Cookies_r { my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_) : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )); return $it->{'Cookies'}; } ########################################################################### ########################################################################### =head2 MIDI EVENT ROUTINES These routines, below, add a MIDI event to the Score, with a start-time of Time. Example: text_event "And now the bongos!"; # procedure use $obj->text_event "And now the bongos!"; # method use These are named after the MIDI events they add to the score, so see L for an explanation of what the data types (like "velocity" or "pitch_wheel") mean. I've reordered this list so that what I guess are the most important ones are toward the top: =over =item patch_change I, I; =item key_after_touch I, I, I; =item channel_after_touch I, I; =item control_change I, I, I; =item pitch_wheel_change I, I; =item set_tempo I; (See the section on tempo, below.) =item smpte_offset I
, I, I, I, I; =item time_signature I, I
, I, I; =item key_signature I, I; =item text_event I; =item copyright_text_event I; =item track_name I; =item instrument_name I; =item lyric I; =item set_sequence_number I; =item marker I; =item cue_point I; =item sequencer_specific I; =item sysex_f0 I; =item sysex_f7 I; =back And here's the ones I'll be surprised if anyone ever uses: =over =item text_event_08 I; =item text_event_09 I; =item text_event_0a I; =item text_event_0b I; =item text_event_0c I; =item text_event_0d I; =item text_event_0e I; =item text_event_0f I; =item raw_meta_event I(0-255), I; =item song_position I; =item song_select I; =item tune_request I; =item raw_data I; =item end_track I; =item note I, I, I, I; =back =cut sub key_after_touch ($$$) { &_common_push('key_after_touch', @_) } sub control_change ($$$) { &_common_push('control_change', @_) } sub patch_change ($$) { &_common_push('patch_change', @_) } sub channel_after_touch ($$) { &_common_push('channel_after_touch', @_) } sub pitch_wheel_change ($$) { &_common_push('pitch_wheel_change', @_) } sub set_sequence_number ($) { &_common_push('set_sequence_number', @_) } sub text_event ($) { &_common_push('text_event', @_) } sub copyright_text_event ($) { &_common_push('copyright_text_event', @_) } sub track_name ($) { &_common_push('track_name', @_) } sub instrument_name ($) { &_common_push('instrument_name', @_) } sub lyric ($) { &_common_push('lyric', @_) } sub marker ($) { &_common_push('marker', @_) } sub cue_point ($) { &_common_push('cue_point', @_) } sub text_event_08 ($) { &_common_push('text_event_08', @_) } sub text_event_09 ($) { &_common_push('text_event_09', @_) } sub text_event_0a ($) { &_common_push('text_event_0a', @_) } sub text_event_0b ($) { &_common_push('text_event_0b', @_) } sub text_event_0c ($) { &_common_push('text_event_0c', @_) } sub text_event_0d ($) { &_common_push('text_event_0d', @_) } sub text_event_0e ($) { &_common_push('text_event_0e', @_) } sub text_event_0f ($) { &_common_push('text_event_0f', @_) } sub end_track ($) { &_common_push('end_track', @_) } sub set_tempo ($) { &_common_push('set_tempo', @_) } sub smpte_offset ($$$$$) { &_common_push('smpte_offset', @_) } sub time_signature ($$$$) { &_common_push('time_signature', @_) } sub key_signature ($$) { &_common_push('key_signature', @_) } sub sequencer_specific ($) { &_common_push('sequencer_specific', @_) } sub raw_meta_event ($$) { &_common_push('raw_meta_event', @_) } sub sysex_f0 ($) { &_common_push('sysex_f0', @_) } sub sysex_f7 ($) { &_common_push('sysex_f7', @_) } sub song_position () { &_common_push('song_position', @_) } sub song_select ($) { &_common_push('song_select', @_) } sub tune_request () { &_common_push('tune_request', @_) } sub raw_data ($) { &_common_push('raw_data', @_) } sub _common_push { # I'm your doctor when you need / Have some coke # / Want some weed / I'm Your Pusher Man #print "*", map("<$_>", @_), "\n"; my(@p) = @_; my $event = shift @p; my $it; if(ref($p[0]) eq "MIDI::Simple") { $it = shift @p; } else { $it = ($package{ (caller(1))[0] } ||= &_package_object( (caller(1))[0] ) ); } #print "**", map("<$_>", @p), " from ", ()[0], "\n"; #printf "Pushee to %s 's %s: e<%s>, t<%s>, p<%s>\n", # $it, $it->{'Score'}, $event, ${$it->{'Time'}}, join("~", @p); push @{$it->{'Score'}}, [ $event, ${$it->{'Time'}}, @p ]; return; } =head2 About Tempo The chart above shows that tempo is set with a method/procedure that takes the form set_tempo(I), and L says that I is "microseconds, a value 0 to 16,777,215 (0x00FFFFFF)". But at the same time, you see that there's an attribute of the MIDI::Simple object called "Tempo", which I've warned you to leave at the default value of 96. So you may wonder what the deal is. The "Tempo" attribute (AKA "Divisions") is an integer that specifies the number of "ticks" per MIDI quarter note. Ticks is just the notional timing unit all MIDI events are expressed in terms of. Calling it "Tempo" is misleading, really; what you want to change to make your music go faster or slower isn't that parameter, but instead the mapping of ticks to actual time -- and that is what C does. Its one parameter is the number of microseconds each quarter note should get. Suppose you wanted a tempo of 120 quarter notes per minute. In terms of microseconds per quarter note: set_tempo 500_000; # you can use _ like a thousands-separator comma In other words, this says to make each quarter note take up 500,000 microseconds, namely .5 seconds. And there's 120 of those half-seconds to the minute; so, 120 quarter notes to the minute. If you see a "[quarter note symbol] = 160" in a piece of sheet music, and you want to figure out what number you need for the C, do: 60_000_000 / 160 ... and you get: 375_000 Therefore, you should call: set_tempo 375_000; So in other words, this general formula: set_tempo int(60_000_000 / $quarter_notes_per_minute); should do you fine. As to the Tempo/Duration parameter, leave it alone and just assume that 96 ticks-per-quarter-note is a universal constant, and you'll be happy. (You may wonder: Why 96? As far as I've worked out, all purmutations of the normal note lengths (whole, half, quarter, eighth, sixteenth, and even thirty-second notes) and tripletting, dotting, or double-dotting, times 96, all produce integers. For example, if a quarter note is 96 ticks, then a double-dotted thirty-second note is 21 ticks (i.e., 1.75 * 1/8 * 96). But that'd be a messy 10.5 if there were only 48 ticks to a quarter note. Now, if you wanted a quintuplet anywhere, you'd be out of luck, since 96 isn't a factor of five. It's actually 3 * (2 ** 5), i.e., three times two to the fifth. If you really need quintuplets, then you have my very special permission to mess with the Tempo attribute -- I suggest multiples of 96, e.g., 5 * 96.) (You may also have read in L that C allows you to define an arbitrary mapping of your concept of quarter note, to MIDI's concept of quarter note. For your sanity and mine, leave them the same, at a 1:1 mapping -- i.e., with an '8' for C's last parameter, for "eight notated 32nd-notes per MIDI quarter note". And this is relevant only if you're calling C anyway, which is not necessarily a given.) =cut ########################################################################### ########################################################################### =head2 MORE ROUTINES =over =cut sub _test_proc { my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); print " am method: $am_method\n it: $it\n params: <", join(',',@_), ">\n"; } ########################################################################### =item $opus = write_score I =item $opus = $obj->write_score(I) Writes the score to the filespec (e.g, "../../samples/funk2.midi", or a variable containing that value), with the score's Ticks as its tick parameters (AKA "divisions"). Among other things, this function calls the function C, below, and if you capture the output of write_score, you'll get the opus created, if you want it for anything. (Also: you can also use a filehandle-reference instead of the filespec: C.) =cut sub write_score { my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); my($out, $ticks, $score_r) = ( $_[0], (${$it->{'Tempo'}} || 96), $it->{'Score'} ); croak "First parameter to MIDI::Simple::write_score can't be null\n" unless( ref($out) || length($out) ); croak "Ticks can't be 0" unless $ticks; carp "Writing a score with no notes!" unless @$score_r; my $opus = $it->make_opus; # $opus->dump( { 'dump_tracks' => 1 } ); if(ref($out)) { $opus->write_to_handle($out); } else { $opus->write_to_file($out); } return $opus; # capture it if you want it. } ########################################################################### =item read_score I =item $obj = MIDI::Simple->read_score('foo.mid')) In the first case (a procedure call), does C to erase and initialize the object attributes (Score, Octave, etc), then reads from the file named. The file named has to be a MIDI file with exactly one eventful track, or Perl dies. And in the second case, C acts as a constructor method, returning a new object read from the file. Score, Ticks, and Time are all affected: Score is the event form of all the MIDI events in the MIDI file. (Note: I deformed MIDI files may confuse the routine that turns MIDI events into a Score.) Ticks is set from the ticks setting (AKA "divisions") of the file. Time is set to the end time of the latest event in the file. (Also: you can also use a filehandle-reference instead of the filespec: C.) If ever you have to make a Score out of a single track from a I file, read the file into an $opus, and then consider something like: new_score; $opus = MIDI::Opus->new({ 'from_file' => "foo2.mid" }); $track = ($opus->tracks)[2]; # get the third track ($score_r, $end_time) = MIDI::Score::events_r_to_score_r($track->events_r); $Ticks = $opus->ticks; @Score = @$score_r; $Time = $end_time; =cut sub read_score { my $am_cons = ($_[0] eq "MIDI::Simple"); shift @_ if $am_cons; my $in = $_[0]; my($track, @eventful_tracks); croak "First parameter to MIDI::Simple::read_score can't be null\n" unless( ref($in) || length($in) ); my $in_switch = ref($in) ? 'from_handle' : 'from_file'; my $opus = MIDI::Opus->new({ $in_switch => $in }); @eventful_tracks = grep( scalar(@{$_->events_r}), $opus->tracks ); if(@eventful_tracks == 0) { croak "Opus from $in has NO eventful tracks to consider as a score!\n"; } elsif (@eventful_tracks > 1) { croak "Opus from $in has too many (" . scalar(@eventful_tracks) . ") tracks to be a score.\n"; } # else OK... $track = $eventful_tracks[0]; #print scalar($track->events), " events in track\n"; # If ever you want just a single track as a score, here's how: #my $score_r = ( MIDI::Score::events_r_to_score_r($track->events_r) )[0]; my( $score_r, $time) = MIDI::Score::events_r_to_score_r($track->events_r); #print scalar(@$score_r), " notes in score\n"; my $it; if($am_cons) { # just make a new object and return it. $it = MIDI::Simple->new_score; $it->{'Score'} = $score_r; } else { # need to fudge it back into the pobj my $cpackage = (caller)[0]; #print "~ read_score as a proc for package $cpackage\n"; if( ref($package{ $cpackage }) ) { # Already exists in %package print "~ reinitting pobj $cpackage\n" if $Debug; &_init_score( $it = $package{ $cpackage } ); # no need to call _package_object } else { # Doesn't exist in %package print "~ new pobj $cpackage\n" if $Debug; $package{ $cpackage } = $it = &_package_object( $cpackage ); # no need to call _init_score } @{$it->{'Score'}} = @$score_r; } ${$it->{'Tempo'}} = $opus->ticks; ${$it->{'Time'}} = $time; return $it; } ########################################################################### =item synch( LIST of coderefs ) =item $obj->synch( LIST of coderefs ) LIST is a list of coderefs (whether as a series of anonymous subs, or as a list of items like C<(\&foo, \&bar, \&baz)>, or a mixture of both) that C calls in order to add to the given object -- which in the first form is the package's default object, and which in the second case is C<$obj>. What C does is: * remember the initial value of Time, before calling any of the routines; * for each routine given, reset Time to what it was initially, call the routine, and then note what the value of Time is, after each call; * then, after having called all of the routines, set Time to whatever was the greatest (equals latest) value of Time that resulted from any of the calls to the routines. The coderefs are all called with one argument in C<@_> -- the object they are supposed to affect. All these routines should/must therefore use method calls instead of procedure calls. Here's an example usage of synch: my $measure = 0; my @phrases =( [ Cs, F, Ds, Gs_d1 ], [Cs, Ds, F, Cs], [ F, Cs, Ds, Gs_d1 ], [Gs_d1, Ds, F, Cs] ); for(1 .. 20) { synch(\&count, \&lalala); } sub count { my $it = $_[0]; $it->r(wn); # whole rest # not just "r(wn)" -- we want a method, not a procedure! ++$measure; } sub lalala { my $it = $_[0]; $it->noop(c1,mf,o3,qn); # setup my $phrase_number = ($measure + -1) % 4; my @phrase = @{$phrases[$phrase_number]}; foreach my $note (@phrase) { $it->n($note); } } =cut sub synch { my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); my @subs = grep(ref($_) eq 'CODE', @_); print " My subs: ", map("<$_> ", @subs), ".\n" if $Debug; return unless @subs; # my @end_times = (); # I am the Lone Array of the Apocalypse! my $orig_time = ${$it->{'Time'}}; my $max_time = $orig_time; foreach my $sub (@subs) { printf " Before %s\: Entry time: %s Score items: %s\n", $sub, $orig_time, scalar(@{$it->{'Score'}}) if $Debug; ${$it->{'Time'}} = $orig_time; # reset Time &{$sub}($it); # now call it printf " %s items ending at %s\n", scalar( @{$it->{'Score'}} ), ${$it->{'Time'}} if $Debug; $max_time = ${$it->{'Time'}} if ${$it->{'Time'}} > $max_time; } print " max end-time of subs: $max_time\n" if $Debug; # now update and get out ${$it->{'Time'}} = $max_time; } ########################################################################### =item $opus = make_opus or $opus = $obj->make_opus Makes an opus (a MIDI::Opus object) out of Score, setting the opus's tick parameter (AKA "divisions") to $ticks. The opus is, incidentally, format 0, with one track. =cut sub make_opus { # Make a format-0 one-track MIDI out of this score. my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); my($ticks, $score_r) = (${$it->{'Tempo'}}, $it->{'Score'}); carp "Encoding a score with no notes!" unless @$score_r; my $events_r = ( MIDI::Score::score_r_to_events_r($score_r) )[0]; carp "Creating a track with no events!" unless @$events_r; my $opus = MIDI::Opus->new({ 'ticks' => $ticks, 'format' => 0, 'tracks' => [ MIDI::Track->new({ 'events' => $events_r }) ] }); return $opus; } ########################################################################### =item dump_score or $obj->dump_score Dumps Score's contents, via C (so you can C an output handle for it). Currently this is in this somewhat uninspiring format: ['note', 0, 96, 1, 25, 96], ['note', 96, 96, 1, 29, 96], as it is (currently) just a call to &MIDI::Score::dump_score; but in the future I may (should?) make it output in C/C notation. In the meantime I assume you'll use this, if at all, only for debugging purposes. =cut sub dump_score { my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); return &MIDI::Score::dump_score( $it->{'Score'} ); } ########################################################################### ########################################################################### =back =head2 FUNCTIONS These are subroutines that aren't methods and don't affect anything (i.e., don't have "side effects") -- they just take input and/or give output. =over =item interval LISTREF, LIST This takes a reference to a list of integers, and a list of note-pitch specifications (whether relative or absolute), and returns a list consisting of the given note specifications transposed by that many half-steps. E.g., @majors = interval [0,4,7], C, Bflat3; which returns the list C<(C,E,G,Bf3,D4,F4)>. Items in LIST which aren't note specifications are passed thru unaltered. =cut sub interval { # apply an interval to a list of notes. my(@out); my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); my($interval_r, @notes) = @_; croak "first argument to &MIDI::Simple::interval must be a listref\n" unless ref($interval_r); # or a valid key into a hash %Interval? foreach my $note (@notes) { my(@them, @status, $a_flag, $note_number); @status = &is_note_spec($note); unless(@status) { # not a note spec push @out, $note; } ($a_flag, $note_number) = @status; @them = map { $note_number + $_ } @$interval_r; if($a_flag) { # If based on an absolute note spec. if($note =~ m<^\d+$>s) { # "12" # no-op -- leave as is } elsif ($note =~ m<^n\d+$>s) { # "n12" @them = map("n$_", @them); } else { # "C4" @them = map(&number_to_absolute($_), @them); } } else { # If based on a relative note spec. @them = map(&number_to_relative($_), @them); } push @out, @them; } return @out; } #-------------------------------------------------------------------------- =item note_map { BLOCK } LIST This is pretty much based on (or at least inspired by) the normal Perl C function, altho the syntax is a bit more restrictive (i.e., C can take the form C or C -- the latter won't work with C). C evaluates the BLOCK for each element of LIST (locally setting $_ to each element's note-number value) and returns the list value composed of the results of each such evaluation. Evaluates BLOCK in a list context, so each element of LIST may produce zero, one, or more elements in the returned value. Moreover, besides setting $_, C feeds BLOCK (which it sees as an anonymous subroutine) three parameters, which BLOCK can access in @_ : $_[0] : Same as $_. I.e., The current note-specification, as a note number. This is the result of having fed the original note spec (which you can see in $_[2]) to is_note_spec. $_[1] : The absoluteness flag for this note, from the above-mentioned call to is_note_spec. 0 = it was relative (like 'C') 1 = it was absolute (whether as 'C4' or 'n41' or '41') $_[2] : the actual note specification from LIST, if you want to access it for any reason. Incidentally, any items in LIST that aren't a note specification are passed thru unchanged -- BLOCK isn't called on it. So, in other words, what C does, for each item in LIST, is: * It calls C on it to test whether it's a note specification at all. If it isn't, just passes it thru. If it is, then C stores the note number and the absoluteness flag that C returned, and... * It calls BLOCK, providing the note number in $_ and $_[0], the absoluteness flag in $_[1], and the original note specification in $_[2]. Stores the return value of calling BLOCK (in a list context of course) -- this should be a list of note numbers. * For each element of the return value (which is actually free to be an empty list), converts it from a note number to whatever B of specification the original note value was. So, for each element, if the original was relative, C interprets the return value as a relative note number, and calls C on it; if it was absolute, C will try to restore it to the correspondingly formatted absolute specification type. An example is, I hope, helpful: This: note_map { $_ - 3, $_ + 2 } qw(Cs3 n42 50 Bf) returns this: ('Bf2', 'Ef3', 'n39', 'n44', '47', '52', 'G', 'C_u1') Or, to line things up: Cs3 n42 50 Bf | | | | /-----\ /-----\ /---\ /----\ Bf2 Ef3 n39 n44 47 52 G C_u1 Now, of course, this is the same as what this: interval [-3, 2], qw(Cs3 n42 50 Bf) returns. This is fitting, as C, internally, is basically a simplified version of C. But C only lets you do unconditional transposition, whereas C lets you do anything at all. For example: @note_specs = note_map { $funky_lookup_table{$_} } C, Gf; or @note_specs = note_map { $_ + int(rand(2)) } @stuff; C, like C, can seem confusing to beginning programmers (and many intermediate ones, too), but it is quite powerful. =cut sub note_map (&@) { # map a function to a list of notes my($sub, @notes) = @_; return() unless @notes; return map { # For each input note... my $note = $_; my @status = &is_note_spec($note); if(@status) { my($a_flag, $note_number) = @status; my $orig_note = $note; # Just in case BLOCK changes it! my $orig_a_flag = $a_flag; # Ditto! my @them = map { &{$sub}($note_number, $a_flag, $note ) } $note_number; if($orig_a_flag) { # If based on an absolute note spec. # try to duplicate the original format if($orig_note =~ m<^\d+$>s) { # "12" # no-op -- leave as is } elsif ($orig_note =~ m<^n\d+$>s) { # "n12" @them = map("n$_", @them); } else { # "C4" @them = map(&number_to_absolute($_), @them); } } else { # If based on a relative note spec. @them = map(&number_to_relative($_), @them); } @them; } else { # it wasn't a real notespec $note; } } @notes ; } ########################################################################### =item number_to_absolute NUMBER This returns the absolute note specification (in the form "C5") that the MIDI note number in NUMBER represents. This is like looking up the note number in %MIDI::number2note -- not exactly the same, but effectively the same. See the source for more details. =cut sub number_to_absolute ($) { my $in = int($_[0]); # Look for @Note at the top of this document. return( $MIDI::Simple::Note[ $in % 12 ] . int($in / 12) ); } =item the function number_to_relative NUMBER This returns the relative note specification that NUMBER represents. The idea of a numerical representation for C note specifications was necessitated by C and C -- since without this, you couldn't meaningfully say, for example, interval [0,2] 'F'. This should illustrate the concept: number_to_relative(-10) => "D_d1" number_to_relative( -3) => "A_d1" number_to_relative( 0) => "C" number_to_relative( 5) => "F" number_to_relative( 10) => "Bf" number_to_relative( 19) => "G_u1" number_to_relative( 40) => "E_u3" =cut sub number_to_relative ($) { my $o_spec; my $in = int($_[0]); if($in < 0) { # Negative, so 'octave(s) down' $o_spec = '_d' . (1 + abs(int(($in + 1) / 12))); # Crufty, but it works. } elsif($in < 12) { # so 'same octave' $o_spec = ''; } else { # Positive, greater than 12, so 'N octave(s) up' $o_spec = '_u' . int($in / 12); } return( $MIDI::Simple::Note[ $in % 12 ] . $o_spec ); } ########################################################################### =item is_note_spec STRING If STRING is a note specification, C returns a list of two elements: first, a flag of whether the note specification is absolute (flag value 1) or relative (flag value 0); and second, a note number corresponding to that note specification. If STRING is not a note specification, C returns an empty list (which in a boolean context is FALSE). Implementationally, C just uses C and C. Example usage: @note_details = is_note_spec($thing); if(@note_details) { ($absoluteness_flag, $note_num) = @note_details; ...stuff... } else { push @other_stuff, $thing; # or whatever } =cut sub is_note_spec ($) { # if false, return() # if true, return(absoluteness_flag, $note_number) my($in, @ret) = ($_[0]); return() unless length $in; @ret = &is_absolute_note_spec($in); return(1, @ret) if @ret; @ret = &is_relative_note_spec($in); return(0, @ret) if @ret; return(); } =item is_relative_note_spec STRING If STRING is an relative note specification, returns the note number for that specification as a one-element list (which in a boolean context is TRUE). Returns empty-list (which in a boolean context is FALSE) if STRING is NOT a relative note specification. To just get the boolean value: print "Snorf!\n" unless is_relative_note_spec($note); But to actually get the note value: ($note_number) = is_relative_note_spec($note); Or consider this: @is_rel = is_relative_note_spec($note); if(@is_rel) { $note_number = $is_rel[0]; } else { print "Snorf!\n"; } (Author's note, two years later: all this business of returning lists of various sizes, with this and other functions in here, is basically a workaround for the fact that there's not really any such thing as a boolean context in Perl -- at least, not as far as user-defined functions can see. I now think I should have done this with just returning a single scalar value: a number (which could be 0!) if the input is a number, and undef/emptylist (C) if not -- then, the user could test: # Hypothetical -- # This fuction doesn't actually work this way: if(defined(my $note_val = is_relative_note_spec($string))) { ...do things with $note_val... } else { print "Hey, that's no note!\n"; } However, I don't anticipate users actually using these messy functions often at all -- I basically wrote these for internal use by MIDI::Simple, then I documented them on the off chance they I be of use to anyone else.) =cut sub is_relative_note_spec ($) { # if false, return() # if true, return($note_number) my($note_number, $octave_number, $in, @ret) = (-1, 0, $_[0]); return() unless length $in; if($in =~ m<^([A-Za-z]+)$>s # Cs and exists( $MIDI::Simple::Note{$1} ) ){ $note_number = $MIDI::Simple::Note{$1}; } elsif($in =~ m<^([A-Za-z]+)_([du])(\d+)$>s # Cs_d4, Cs_u1 and exists( $MIDI::Simple::Note{$1} ) ){ $note_number = $MIDI::Simple::Note{$1}; $octave_number = $3; $octave_number *= -1 if $2 eq "d"; } else { @ret = (); } unless($note_number == -1) { @ret = ( $note_number + $octave_number * 12 ); } return @ret; } =item is_absolute_note_spec STRING Just like C, but for absolute note specifications instead of relative ones. =cut sub is_absolute_note_spec ($) { # if false, return() # if true, return($note_number) my($note_number, $in, @ret) = (-1, $_[0]); return() unless length $in; if( $in =~ /^n?(\d+)$/s ) { # E.g., "29", "n38" $note_number = 0 + $1; } elsif( $in =~ /^([A-Za-z]+)(\d+)/s ) { # E.g., "C3", "As4" $note_number = $MIDI::Simple::Note{$1} + $2 * 12 if exists($MIDI::Simple::Note{$1}); } @ret = ($note_number) if( $note_number >= 0 and $note_number < 128); return @ret; } #-------------------------------------------------------------------------- =item Self() or $obj->Self(); Presumably the second syntax is useless -- it just returns $obj. But the first syntax returns the current package's default object. Suppose you write a routine, C, that does something-or-other to a given MIDI::Simple object. You could write it so that acts on the current package's default object, which is fine -- but, among other things, that means you can't call C from a sub you have C call, since such routines should/must use only method calls. So let's say that, instead, you write C so that the first argument to it is the object to act on. If the MIDI::Simple object you want it to act on is it C<$sonata>, you just say funkify($sonata) However, if you want it to act on the current package's default MIDI::Simple object, what to say? Simply, $package_opus = Self; funkify($package_opus); =cut sub Self { # pointless as a method -- but as a sub, useful if # you want to access your current package's object. # Juuuuuust in case you need it. my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple") ? (1, shift @_) : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) ); return $it; } =back =cut ########################################################################### =head1 COPYRIGHT Copyright (c) 1998-2005 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Sean M. Burke C =cut 1; __END__ MIDI-Perl-0.83/lib/MIDI/Track.pm0000644000076500000240000003362412103035556015310 0ustar conklinstaff # Time-stamp: "2013-02-01 22:40:38 conklin" require 5; package MIDI::Track; use strict; use vars qw($Debug $VERSION); use Carp; $Debug = 0; $VERSION = '0.83'; =head1 NAME MIDI::Track -- functions and methods for MIDI tracks =head1 SYNOPSIS use MIDI; # ...which "use"s MIDI::Track et al $taco_track = MIDI::Track->new; $taco_track->events( ['text_event', 0, "I like tacos!"], ['note_on', 0, 4, 50, 96 ], ['note_off', 300, 4, 50, 96 ], ); $opus = MIDI::Opus->new( { 'format' => 0, 'ticks' => 240, 'tracks' => [ $taco_track ] } ); ...etc... =head1 DESCRIPTION MIDI::Track provides a constructor and methods for objects representing a MIDI track. It is part of the MIDI suite. MIDI tracks have, currently, three attributes: a type, events, and data. Almost all tracks you'll ever deal with are of type "MTrk", and so this is the type by default. Events are what make up an MTrk track. If a track is not of type MTrk, or is an unparsed MTrk, then it has (or better have!) data. When an MTrk track is encoded, if there is data defined for it, that's what's encoded (and "encoding data" means just passing it thru untouched). Note that this happens even if the data defined is "" (but it won't happen if the data is undef). However, if there's no data defined for the MTrk track (as is the general case), then the track's events are encoded, via a call to C. (If neither events not data are defined, it acts as a zero-length track.) If a non-MTrk track is encoded, its data is encoded. If there's no data for it, it acts as a zero-length track. In other words, 1) events are meaningful only in an MTrk track, 2) you probably don't want both data and events defined, and 3) 99.999% of the time, just worry about events in MTrk tracks, because that's all you ever want to deal with anyway. =head1 CONSTRUCTOR AND METHODS MIDI::Track provides... =over =cut ########################################################################### =item the constructor MIDI::Track->new({ ...options... }) This returns a new track object. By default, the track is of type MTrk, which is probably what you want. The options, which are optional, is an anonymous hash. There are four recognized options: C, which sets the data of the new track to the string provided; C, which sets the type of the new track to the string provided; C, which sets the events of the new track to the contents of the list-reference provided (i.e., a reference to a LoL -- see L for the skinny on LoLs); and C, which is an exact synonym of C. =cut sub new { # make a new track. my $class = shift; my $this = bless( {}, $class ); print "New object in class $class\n" if $Debug; $this->_init( @_ ); return $this; } sub _init { # You can specify options: # 'event' => [a list of events], AKA 'event_r' # 'type' => 'Whut', # default is 'MTrk' # 'data' => 'scads of binary data as you like it' my $this = shift; my $options_r = ref($_[0]) eq 'HASH' ? $_[0] : {}; print "_init called against $this\n" if $Debug; if($Debug) { if(%$options_r) { print "Parameters: ", map("<$_>", %$options_r), "\n"; } else { print "Null parameters for opus init\n"; } } $this->{'type'} = defined($options_r->{'type'}) ? $options_r->{'type'} : 'MTrk'; $this->{'data'} = $options_r->{'data'} if defined($options_r->{'data'}); $options_r->{'events'} = $options_r->{'events_r'} if( exists( $options_r->{'events_r'} ) and not exists( $options_r->{'events'} ) ); # so events_r => [ @events ] is a synonym for # events => [ @events ] # as on option for new() $this->{'events'} = ( defined($options_r->{'events'}) and ref($options_r->{'events'}) eq 'ARRAY' ) ? $options_r->{'events'} : [] ; return; } =item the method $new_track = $track->copy This duplicates the contents of the given track, and returns the duplicate. If you are unclear on why you may need this function, consider: $funk = MIDI::Opus->new({'from_file' => 'funk1.mid'}); $samba = MIDI::Opus->new({'from_file' => 'samba1.mid'}); $bass_track = ( $funk->tracks )[-1]; # last track push(@{ $samba->tracks_r }, $bass_track ); # make it the last track &funk_it_up( ( $funk->tracks )[-1] ); # modifies the last track of $funk &turn_it_out( ( $samba->tracks )[-1] ); # modifies the last track of $samba $funk->write_to_file('funk2.mid'); $samba->write_to_file('samba2.mid'); exit; So you have your routines funk_it_up and turn_it_out, and they each modify the track they're applied to in some way. But the problem is that the above code probably does not do what you want -- because the last track-object of $funk and the last track-object of $samba are the I. An object, you may be surprised to learn, can be in different opuses at the same time -- which is fine, except in cases like the above code. That's where you need to do copy the object. Change the above code to read: push(@{ $samba->tracks_r }, $bass_track->copy ); and what you want to happen, will. Incidentally, this potential need to copy also occurs with opuses (and in fact any reference-based data structure, altho opuses and tracks should cover almost all cases with MIDI stuff), which is why there's $opus->copy, for copying entire opuses. (If you happen to need to copy a single event, it's just $new = [@$old] ; and if you happen to need to copy an event structure (LoL) outside of a track for some reason, use MIDI::Event::copy_structure.) =cut sub copy { # Duplicate a given track. Even dupes the events. # Call as $new_one = $track->copy my $track = shift; my $new = bless( { %{$track} }, ref $track ); # a first crude dupe $new->{'events'} = &MIDI::Event::copy_structure( $new->{'events'} ) if $new->{'events'}; return $new; } ########################################################################### =item track->skyline({ ...options... }) skylines the entire track. Modifies the track. See MIDI::Score for documentation on skyline =cut sub skyline { my $track = shift; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my $score_r = MIDI::Score::events_r_to_score_r($track->events_r); my $new_score_r = MIDI::Score::skyline($score_r,$options_r); my $events_r = MIDI::Score::score_r_to_events_r($new_score_r); $track->events_r($events_r); } ########################################################################### # These three modify all the possible attributes of a track =item the method $track->events( @events ) Returns the list of events in the track, possibly after having set it to @events, if specified and not empty. (If you happen to want to set the list of events to an empty list, for whatever reason, you have to use "$track->events_r([])".) In other words: $track->events(@events) is how to set the list of events (assuming @events is not empty), and @events = $track->events is how to read the list of events. =cut sub events { # list or set events in this object my $this = shift; $this->{'events'} = [ @_ ] if @_; return @{ $this->{'events'} }; } =item the method $track->events_r( $event_r ) Returns a reference to the list of events in the track, possibly after having set it to $events_r, if specified. Actually, "$events_r" can be any listref to a LoL, whether it comes from a scalar as in C<$some_events_r>, or from something like C<[@events]>, or just plain old C<\@events> Originally $track->events was the only way to deal with events, but I added $track->events_r to make possible 1) setting the list of events to (), for whatever that's worth, and 2) so you can directly manipulate the track's events, without having to I the list of events (which might be tens of thousands of elements long) back and forth. This way, you can say: $events_r = $track->events_r(); @some_stuff = splice(@$events_r, 4, 6); But if you don't know how to deal with listrefs outside of LoLs, that's OK, just use $track->events. =cut sub events_r { # return (maybe set) a list-reference to the event-structure for this track my $this = shift; if(@_) { croak "parameter for MIDI::Track::events_r must be an array-ref" unless ref($_[0]); $this->{'events'} = $_[0]; } return $this->{'events'}; } =item the method $track->type( 'MFoo' ) Returns the type of $track, after having set it to 'MFoo', if provided. You probably won't ever need to use this method, other than in a context like: if( $track->type eq 'MTrk' ) { # The usual case give_up_the_funk($track); } # Else just keep on walkin'! Track types must be 4 bytes long; see L for details. =cut sub type { my $this = shift; $this->{'type'} = $_[0] if @_; # if you're setting it return $this->{'type'}; } =item the method $track->data( $kooky_binary_data ) Returns the data from $track, after having set it to $kooky_binary_data, if provided -- even if it's zero-length! You probably won't ever need to use this method. For your information, $track->data(undef) is how to undefine the data for a track. =cut sub data { # meant for reading/setting generally non-MTrk track data my $this = shift; $this->{'data'} = $_[0] if @_; return $this->{'data'}; } ########################################################################### =item the method $track->new_event('event', ...parameters... ) This adds the event ('event', ...parameters...) to the end of the event list for $track. It's just sugar for: push( @{$this_track->events_r}, [ 'event', ...params... ] ) If you want anything other than the equivalent of that, like some kinda splice(), then do it yourself with $track->events_r or $track->events. =cut sub new_event { # Usage: # $this_track->new_event('text_event', 0, 'Lesbia cum Prono'); my $track = shift; push( @{$track->{'events'}}, [ @_ ] ); # this returns the new number of events in that event list, if that # interests you. } ########################################################################### =item the method $track->dump({ ...options... }) This dumps the track's contents for your inspection. The dump format is code that looks like Perl code that you'd use to recreate that track. This routine outputs with just C, so you can use C