diff --git a/CHANGELOG.md b/CHANGELOG.md index cef4809..f86b599 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,8 @@ Notable changes will be documented here. This project strives for [Semantic Vers - Bug fix for issue #11, which spews out a bunch of unnecessary warnings. - README now links to the wiki. - Fix for issue #15: higher notes are now at the top of the plotting area. +- Functionality to remove notes more quickly. You can now drag across a row with grid cells set to turn them off. +- No longer rely on installation of MIDI-Perl. It is now included in the source directory under lib/. ## 0.01 - 2016-03-25 ### Added diff --git a/SeekMIDI.pl b/SeekMIDI.pl index c5d4fcb..ec71dd5 100644 --- a/SeekMIDI.pl +++ b/SeekMIDI.pl @@ -30,7 +30,7 @@ package Gtk2::MIDIPlot; # makes a class-global array that holds true/false values for which note blocks are enabled, and the global drawing area my @gtkObjects; my $this; -my ($dragRow, $dragStart) = (-1, -1); +my ($dragRow, $dragStart, $dragMode) = (-1, -1, -1); # sets up the class; asks for the signals we need; sets main widget size sub new { @@ -115,15 +115,19 @@ sub button { # if the left mouse button then invert this gridbox's state value if ($event->button == 1) { my ($xind, $yind) = (($event->x - ($event->x % 12)) / 12, ($event->y - ($event->y % 8)) / 8); - $gtkObjects[$xind][$yind] = !$gtkObjects[$xind][$yind]; if($gtkObjects[$xind][$yind] == 0) { - expose($this); - } else { + $gtkObjects[$xind][$yind] = 1; + # makes new Cairo context my $thisCairo = Gtk2::Gdk::Cairo::Context->create($this->get_window()); $thisCairo->rectangle($xind * 12, $yind * 8, 12, 8); $thisCairo->fill(); + $dragMode = 1; + } else { + $gtkObjects[$xind][$yind] = 0; + $dragMode = 0; + expose($this); } # initialize drag variables @@ -143,11 +147,11 @@ sub motion { my ($xind, $yind) = (($event->x - ($event->x % 12)) / 12, ($event->y - ($event->y % 8)) / 8); # check if the underlying cell is set or not and if not, check which mouse button is pressed, then draw and set $gtkObjects - if($gtkObjects[$xind][$dragRow] == 0) { - if(grep('button1-mask', $event->state)) { - # makes new Cairo context - my $thisCairo = Gtk2::Gdk::Cairo::Context->create($this->get_window()); + if(grep('button1-mask', $event->state)) { + # makes new Cairo context + my $thisCairo = Gtk2::Gdk::Cairo::Context->create($this->get_window()); + if($dragMode == 1) { # checks whether our overall drag is to the left or right and draws rectangles and updates $gtkObjects accordingly if($xind >= $dragStart) { $thisCairo->rectangle($dragStart * 12, $dragRow * 8, ($xind - $dragStart + 1) * 12, 8); @@ -160,14 +164,27 @@ sub motion { $gtkObjects[$inc][$dragRow] = 1; } } - $thisCairo->fill(); + } else { + # checks whether our overall drag is to the left or right and updates $gtkObjects accordingly + if($xind >= $dragStart) { + for(my $inc = $dragStart; $inc <= $xind; $inc++) { + $gtkObjects[$inc][$dragRow] = 0; + } + expose($this); + } else { + for(my $inc = $xind; $inc <= $dragStart; $inc++) { + $gtkObjects[$inc][$dragRow] = 0; + } + expose($this); + } } + $thisCairo->fill(); } } -# clears the current drag row and start point when the drag is ended +# clears the current drag row, start point, and drag mode when the drag is ended sub release { - ($dragRow, $dragStart) = (-1, -1); + ($dragRow, $dragStart, $dragMode) = (-1, -1, -1); } sub getMIDI { @@ -200,6 +217,7 @@ sub getMIDI { package main; +use lib './lib/'; use MIDI; use Gtk2 -init; # use Locale::gettext; diff --git a/lib/MIDI.pm b/lib/MIDI.pm new file mode 100644 index 0000000..deb4287 --- /dev/null +++ b/lib/MIDI.pm @@ -0,0 +1,425 @@ + +# Time-stamp: "2010-02-14 21:39:10 conklin" +require 5; +package MIDI; +use strict; +use vars qw($Debug $VERSION %number2note %note2number %number2patch + %patch2number %notenum2percussion %percussion2notenum); +use MIDI::Opus; +use MIDI::Track; +use MIDI::Event; +use MIDI::Score; + +# Doesn't use MIDI::Simple -- but MIDI::Simple uses this + +$Debug = 0; # currently doesn't do anything +$VERSION = '0.83'; + +# MIDI.pm doesn't do much other than 1) 'use' all the necessary submodules +# 2) provide some publicly useful hashes, 3) house a few private routines +# common to the MIDI::* modules, and 4) contain POD, glorious POD. + +=head1 NAME + +MIDI - read, compose, modify, and write MIDI files + +=head1 SYNOPSIS + + use MIDI; + use strict; + use warnings; + my @events = ( + ['text_event',0, 'MORE COWBELL'], + ['set_tempo', 0, 450_000], # 1qn = .45 seconds + ); + + for (1 .. 20) { + push @events, + ['note_on' , 90, 9, 56, 127], + ['note_off', 6, 9, 56, 127], + ; + } + foreach my $delay (reverse(1..96)) { + push @events, + ['note_on' , 0, 9, 56, 127], + ['note_off', $delay, 9, 56, 127], + ; + } + + my $cowbell_track = MIDI::Track->new({ 'events' => \@events }); + my $opus = MIDI::Opus->new( + { 'format' => 0, 'ticks' => 96, 'tracks' => [ $cowbell_track ] } ); + $opus->write_to_file( 'cowbell.mid' ); + + +=head1 DESCRIPTION + +This suite of modules provides routines for reading, composing, modifying, +and writing MIDI files. + +From FOLDOC (C): + +=over + +B + +Emultimedia, file formatE (MIDI /mi'-dee/, /mee'-dee/) A +hardware specification and protocol used to communicate note and +effect information between synthesisers, computers, music keyboards, +controllers and other electronic music devices. [...] + +The basic unit of information is a "note on/off" event which includes +a note number (pitch) and key velocity (loudness). There are many +other message types for events such as pitch bend, patch changes and +synthesizer-specific events for loading new patches etc. + +There is a file format for expressing MIDI data which is like a dump +of data sent over a MIDI port. [...] + +=back + +=head1 COMPONENTS + +The MIDI-Perl suite consists of these modules: + +L (which you're looking at), L, L, +L, L, and +L. All of these contain documentation in pod format. +You should read all of these pods. + +The order you want to read them in will depend on what you want to do +with this suite of modules: if you are focused on manipulating the +guts of existing MIDI files, read the pods in the order given above. + +But if you aim to compose music with this suite, read this pod, then +L and L, and then skim the rest. + + +=head1 INTRODUCTION + +This suite of modules is basically object-oriented, with the exception +of MIDI::Simple. MIDI opuses ("songs") are represented as objects +belonging to the class MIDI::Opus. An opus contains tracks, which are +objects belonging to the class MIDI::Track. A track will generally +contain a list of events, where each event is a list consisting of a +command, a delta-time, and some number of parameters. In other words, +opuses and tracks are objects, and the events in a track comprise a +LoL (and if you don't know what an LoL is, you must read L). + +Furthermore, for some purposes it's useful to analyze the totality of +a track's events as a "score" -- where a score consists of notes where +each event is a list consisting of a command, a time offset from the +start of the track, and some number of parameters. This is the level +of abstraction that MIDI::Score and MIDI::Simple deal with. + +While this suite does provide some functionality accessible only if +you're comfortable with various kinds of references, and while there +are some options that deal with the guts of MIDI encoding, you can (I +hope) get along just fine with just a basic grasp of the MIDI +"standard", and a command of LoLs. I have tried, at various points in +this documentation, to point out what things are not likely to be of +use to the casual user. + +=head1 GOODIES + +The bare module MIDI.pm doesn't I much more than C the +necessary component submodules (i.e., all except MIDI::Simple). But +it does provide some hashes you might find useful: + +=over + +=cut + +########################################################################### +# Note numbers => a representation of them + +=item C<%MIDI::note2number> and C<%MIDI::number2note> + +C<%MIDI::number2note> correponds MIDI note numbers to a more +comprehensible representation (e.g., 68 to 'Gs4', for G-sharp, octave +4); C<%MIDI::note2number> is the reverse. Have a look at the source +to see the contents of the hash. + +=cut +@number2note{0 .. 127} = ( +# (Do) (Re) (Mi) (Fa) (So) (La) (Ti) + 'C0', 'Cs0', 'D0', 'Ds0', 'E0', 'F0', 'Fs0', 'G0', 'Gs0', 'A0', 'As0', 'B0', + 'C1', 'Cs1', 'D1', 'Ds1', 'E1', 'F1', 'Fs1', 'G1', 'Gs1', 'A1', 'As1', 'B1', + 'C2', 'Cs2', 'D2', 'Ds2', 'E2', 'F2', 'Fs2', 'G2', 'Gs2', 'A2', 'As2', 'B2', + 'C3', 'Cs3', 'D3', 'Ds3', 'E3', 'F3', 'Fs3', 'G3', 'Gs3', 'A3', 'As3', 'B3', + 'C4', 'Cs4', 'D4', 'Ds4', 'E4', 'F4', 'Fs4', 'G4', 'Gs4', 'A4', 'As4', 'B4', + 'C5', 'Cs5', 'D5', 'Ds5', 'E5', 'F5', 'Fs5', 'G5', 'Gs5', 'A5', 'As5', 'B5', + 'C6', 'Cs6', 'D6', 'Ds6', 'E6', 'F6', 'Fs6', 'G6', 'Gs6', 'A6', 'As6', 'B6', + 'C7', 'Cs7', 'D7', 'Ds7', 'E7', 'F7', 'Fs7', 'G7', 'Gs7', 'A7', 'As7', 'B7', + 'C8', 'Cs8', 'D8', 'Ds8', 'E8', 'F8', 'Fs8', 'G8', 'Gs8', 'A8', 'As8', 'B8', + 'C9', 'Cs9', 'D9', 'Ds9', 'E9', 'F9', 'Fs9', 'G9', 'Gs9', 'A9', 'As9', 'B9', + 'C10','Cs10','D10','Ds10','E10','F10','Fs10','G10', + # Note number 69 reportedly == A440, under a default tuning. + # and note 60 = Middle C +); +%note2number = reverse %number2note; +# Note how I deftly avoid having to figure out how to represent a flat mark +# in ASCII. + +########################################################################### +# **** TABLE 1 - General MIDI Instrument Patch Map **** +# (groups sounds into sixteen families, w/8 instruments in each family) +# Note that I call the map 0-127, not 1-128. + +=item C<%MIDI::patch2number> and C<%MIDI::number2patch> + +C<%MIDI::number2patch> correponds General MIDI patch numbers +(0 to 127) to English names (e.g., 79 to 'Ocarina'); +C<%MIDI::patch2number> is the reverse. Have a look at the source +to see the contents of the hash. + +=cut +@number2patch{0 .. 127} = ( # The General MIDI map: patches 0 to 127 +#0: Piano + "Acoustic Grand", "Bright Acoustic", "Electric Grand", "Honky-Tonk", + "Electric Piano 1", "Electric Piano 2", "Harpsichord", "Clav", +# Chrom Percussion + "Celesta", "Glockenspiel", "Music Box", "Vibraphone", + "Marimba", "Xylophone", "Tubular Bells", "Dulcimer", + +#16: Organ + "Drawbar Organ", "Percussive Organ", "Rock Organ", "Church Organ", + "Reed Organ", "Accordion", "Harmonica", "Tango Accordion", +# Guitar + "Acoustic Guitar(nylon)", "Acoustic Guitar(steel)", + "Electric Guitar(jazz)", "Electric Guitar(clean)", + "Electric Guitar(muted)", "Overdriven Guitar", + "Distortion Guitar", "Guitar Harmonics", + +#32: Bass + "Acoustic Bass", "Electric Bass(finger)", + "Electric Bass(pick)", "Fretless Bass", + "Slap Bass 1", "Slap Bass 2", "Synth Bass 1", "Synth Bass 2", +# Strings + "Violin", "Viola", "Cello", "Contrabass", + "Tremolo Strings", "Pizzicato Strings", "Orchestral Strings", "Timpani", + +#48: Ensemble + "String Ensemble 1", "String Ensemble 2", "SynthStrings 1", "SynthStrings 2", + "Choir Aahs", "Voice Oohs", "Synth Voice", "Orchestra Hit", +# Brass + "Trumpet", "Trombone", "Tuba", "Muted Trumpet", + "French Horn", "Brass Section", "SynthBrass 1", "SynthBrass 2", + +#64: Reed + "Soprano Sax", "Alto Sax", "Tenor Sax", "Baritone Sax", + "Oboe", "English Horn", "Bassoon", "Clarinet", +# Pipe + "Piccolo", "Flute", "Recorder", "Pan Flute", + "Blown Bottle", "Skakuhachi", "Whistle", "Ocarina", + +#80: Synth Lead + "Lead 1 (square)", "Lead 2 (sawtooth)", "Lead 3 (calliope)", "Lead 4 (chiff)", + "Lead 5 (charang)", "Lead 6 (voice)", "Lead 7 (fifths)", "Lead 8 (bass+lead)", +# Synth Pad + "Pad 1 (new age)", "Pad 2 (warm)", "Pad 3 (polysynth)", "Pad 4 (choir)", + "Pad 5 (bowed)", "Pad 6 (metallic)", "Pad 7 (halo)", "Pad 8 (sweep)", + +#96: Synth Effects + "FX 1 (rain)", "FX 2 (soundtrack)", "FX 3 (crystal)", "FX 4 (atmosphere)", + "FX 5 (brightness)", "FX 6 (goblins)", "FX 7 (echoes)", "FX 8 (sci-fi)", +# Ethnic + "Sitar", "Banjo", "Shamisen", "Koto", + "Kalimba", "Bagpipe", "Fiddle", "Shanai", + +#112: Percussive + "Tinkle Bell", "Agogo", "Steel Drums", "Woodblock", + "Taiko Drum", "Melodic Tom", "Synth Drum", "Reverse Cymbal", +# Sound Effects + "Guitar Fret Noise", "Breath Noise", "Seashore", "Bird Tweet", + "Telephone Ring", "Helicopter", "Applause", "Gunshot", +); +%patch2number = reverse %number2patch; + +########################################################################### +# **** TABLE 2 - General MIDI Percussion Key Map **** +# (assigns drum sounds to note numbers. MIDI Channel 9 is for percussion) +# (it's channel 10 if you start counting at 1. But WE start at 0.) + +=item C<%MIDI::notenum2percussion> and C<%MIDI::percussion2notenum> + +C<%MIDI::notenum2percussion> correponds General MIDI Percussion Keys +to English names (e.g., 56 to 'Cowbell') -- but note that only numbers +35 to 81 (inclusive) are defined; C<%MIDI::percussion2notenum> is the +reverse. Have a look at the source to see the contents of the hash. + +=cut + +@notenum2percussion{35 .. 81} = ( + 'Acoustic Bass Drum', 'Bass Drum 1', 'Side Stick', 'Acoustic Snare', + 'Hand Clap', + + # the forties + 'Electric Snare', 'Low Floor Tom', 'Closed Hi-Hat', 'High Floor Tom', + 'Pedal Hi-Hat', 'Low Tom', 'Open Hi-Hat', 'Low-Mid Tom', 'Hi-Mid Tom', + 'Crash Cymbal 1', + + # the fifties + 'High Tom', 'Ride Cymbal 1', 'Chinese Cymbal', 'Ride Bell', 'Tambourine', + 'Splash Cymbal', 'Cowbell', 'Crash Cymbal 2', 'Vibraslap', 'Ride Cymbal 2', + + # the sixties + 'Hi Bongo', 'Low Bongo', 'Mute Hi Conga', 'Open Hi Conga', 'Low Conga', + 'High Timbale', 'Low Timbale', 'High Agogo', 'Low Agogo', 'Cabasa', + + # the seventies + 'Maracas', 'Short Whistle', 'Long Whistle', 'Short Guiro', 'Long Guiro', + 'Claves', 'Hi Wood Block', 'Low Wood Block', 'Mute Cuica', 'Open Cuica', + + # the eighties + 'Mute Triangle', 'Open Triangle', +); +%percussion2notenum = reverse %notenum2percussion; + +########################################################################### + +=back + +=head1 BRIEF GLOSSARY + +This glossary defines just a few terms, just enough so you can +(hopefully) make some sense of the documentation for this suite of +modules. If you're going to do anything serious with these modules, +however, you I invest in a good book about the MIDI +standard -- see the References. + +B: a logical channel to which control changes and patch +changes apply, and in which MIDI (note-related) events occur. + +B: one of the various numeric parameters associated with a +given channel. Like S registers in Hayes-set modems, MIDI controls +consist of a few well-known registers, and beyond that, it's +patch-specific and/or sequencer-specific. + +B: the time (in ticks) that a sequencer should wait +between playing the previous event and playing the current event. + +B: any of a mixed bag of events whose common trait is +merely that they are similarly encoded. Most meta-events apply to all +channels, unlike events, which mostly apply to just one channel. + +B: my oversimplistic term for items in a score structure. + +B: the term I prefer for a piece of music, as represented in +MIDI. Most specs use the term "song", but I think that this +falsely implies that MIDI files represent vocal pieces. + +B: an electronic model of the sound of a given notional +instrument. + +B: a form of modest compression where an event lacking +an event command byte (a "status" byte) is to be interpreted as having +the same event command as the preceding event -- which may, in turn, +lack a status byte and may have to be interpreted as having the same +event command as I previous event, and so on back. + +B: a structure of notes like an event structure, but where +notes are represented as single items, and where timing of items is +absolute from the beginning of the track, instead of being represented +in delta-times. + +B: what some MIDI specs call a song, I call an opus. + +B: a device or program that interprets and acts on MIDI +data. This prototypically refers to synthesizers or drum machines, +but can also refer to more limited devices, such as mixers or even +lighting control systems. + +B: a synonym for "event". + +B: a chunk of binary data encapsulated in the MIDI data stream, +for whatever purpose. + +B: any of the several meta-events (one of which is +actually called 'text_event') that conveys text. Most often used to +just label tracks, note the instruments used for a track, or to +provide metainformation about copyright, performer, and piece title +and author. + +B: the timing unit in a MIDI opus. + +B: an encoding method identical to what Perl +calls the 'w' (BER, Basic Encoding Rules) pack/unpack format for +integers. + +=head1 SEE ALSO + +L -- the MIDI-Perl homepage +on the Interwebs! + +L -- All the MIDI +things in CPAN! + +=head1 REFERENCES + +Christian Braut. I ISBN 0782112854. +[This one is indispensible, but sadly out of print. Look at abebooks.com +for it maybe --SMB] + +Langston, Peter S. 1998. "Little Music Languages", p.587-656 in: +Salus, Peter H,. editor in chief, /Handbook of Programming Languages/, +vol. 3. MacMillan Technical, 1998. [The volume it's in is probably +not worth the money, but see if you can at least glance at this +article anyway. It's not often you see 70 pages written on music +languages. --SMB] + +=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 AUTHORS + +Sean M. Burke C (until 2010) + +Darrell Conklin C (from 2010) +=cut + +########################################################################### +sub _dump_quote { + # Used variously by some MIDI::* modules. Might as well keep it here. + my @stuff = @_; + return + join(", ", + map + { # the cleaner-upper function + if(!length($_)) { # empty string + "''"; + } elsif( + $_ eq '0' or m/^-?(?:[1-9]\d*)$/s # integers + + # Was just: m/^-?\d+(?:\.\d+)?$/s + # but that's over-broad, as let "0123" thru, which is + # wrong, since that's octal 0123, == decimal 83. + + # m/^-?(?:(?:[1-9]\d*)|0)(?:\.\d+)?$/s and $_ ne '-0' + # would let thru all well-formed numbers, but also + # non-canonical forms of them like 0.3000000. + # Better to just stick to integers I think. + ) { + $_; + } elsif( # text with junk in it + s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> + <'\\x'.(unpack("H2",$1))>eg + ) { + "\"$_\""; + } else { # text with no junk in it + s<'><\\'>g; + "\'$_\'"; + } + } + @stuff + ); +} +########################################################################### + +1; + +__END__ diff --git a/lib/MIDI/Event.pm b/lib/MIDI/Event.pm new file mode 100644 index 0000000..0912467 --- /dev/null +++ b/lib/MIDI/Event.pm @@ -0,0 +1,1236 @@ + +# 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__ diff --git a/lib/MIDI/Opus.pm b/lib/MIDI/Opus.pm new file mode 100644 index 0000000..ec8adfa --- /dev/null +++ b/lib/MIDI/Opus.pm @@ -0,0 +1,770 @@ + +# 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__ diff --git a/lib/MIDI/Score.pm b/lib/MIDI/Score.pm new file mode 100644 index 0000000..7974f3d --- /dev/null +++ b/lib/MIDI/Score.pm @@ -0,0 +1,575 @@ + +# 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__ + diff --git a/lib/MIDI/Simple.pm b/lib/MIDI/Simple.pm new file mode 100644 index 0000000..e005049 --- /dev/null +++ b/lib/MIDI/Simple.pm @@ -0,0 +1,1932 @@ + +# 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__ diff --git a/lib/MIDI/Track.pm b/lib/MIDI/Track.pm new file mode 100644 index 0000000..a683c4c --- /dev/null +++ b/lib/MIDI/Track.pm @@ -0,0 +1,449 @@ + +# 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