MIDI-Perl-0.84/000755 000765 000024 00000000000 14513435350 013672 5ustar00conklinstaff000000 000000 MIDI-Perl-0.84/ChangeLog000644 000765 000024 00000015346 14511461723 015456 0ustar00conklinstaff000000 000000 Revision history for Perl suite MIDI-Perl Time-stamp: "2023-10-11 10:58:40 conklin" 2023-10-05 Darrell Conklin conklin@cpan.org * Release 0.84 * documentation fixes (many) by Avery Adams * bug fix in track->skyline() * added Opus::skyline() * added Opus::format0() 2012-11-19 Darrell Conklin conklin@cpan.org * Release 0.83 * fixed GM patch 45 incorrect name: "Orchestral Strings"->"Pizzicato Strings" * added more explanatory error message in Opus.pm (track_count) * added a track->skyline() function 2010-12-23 Darrell Conklin conklin@cpan.org * fixed typo in %Lengths hash in Simple.pm 2010-02-14 Darrell Conklin conklin@cpan.org * maintainer -- DC has taken over as maintainer. Thanks to SB for his excellent module. * Release 0.82 * bug fix in Score.pm where events_r_to_score_r would destructively modify events * bug fix in Score.pm, when presented with two simultaneous events with the same note/channel, which led to unpredictable durations of score events, sometimes negative. * added grid quantization (to Opus, and Score) 2005-01-29 Sean M. Burke sburke@cpan.org * Release 0.81 -- maintenance release. * No Perl changes -- just doc tweaks mostly. * Rearranged the dist's contents to be more modern-like. * Of course, more cowbell. 2002-08-21 Sean M. Burke sburke@cpan.org * Release 0.80 -- just a docfix release, basically * Removing the out-dated Filespec.pod file. * To work around vstrings in Perl 5.6 (etc), MIDI::Simple volume specifications can now be expressed as V64 (etc), whereas previously you could only do v64. Bumping MIDI::SImple version up to 0.80. 2000-08-21 Sean M. Burke sburke@cpan.org * Release 0.79 * Bungled the Makefile on the previous release! This time should work. 2000-08-21 Sean M. Burke sburke@cpan.org * Release 0.78 * Fixed odd bug in MIDI::Score that would prematurely terminate a pending note on one channel if you started (or ended) a note with the same note number on a different channel. New logic assumes (safely, I think) that you can only have one note at a time per note-number per channel. (I.e., you can't start a C5 on channel 3, wait a second, start another C5 on channel 3, and have them both going at the same time. I think that if you start a C5 on channel 3, then start another, the second will implicitly end the first. Please do email me if you think this is non-standard behavior for a sequencer.) 2000-05-20 Sean M. Burke sburke@cpan.org * Release 0.77 * Fixing an incidental bug in MIDI::Simple (which surfaces only in Perl 5.6, apparently). Thanks to Matt Burt (m.burt@bcs.org.uk) for finding the bug, as well as noting the fix. * Changed MIDI::Score::score_r_to_events_r and MIDI::Score::events_r_to_score_r (which were useful only in list context previously) to do something useful (and rather intuitive) in scalar context. 2000-05-14 Sean M. Burke sburke@cpan.org * Release 0.76 * Noting my new email address. * MIDI::_dump_quote() was a bit over-broad in what string values it considered numbers (i.e., what things it didn't have to put quotes around). I've changed it to leave only integers unquoted. This shouldn't make any difference really, since if ever any Perl code (whether in MIDI-Perl or elsewhere) needs to treat a stringified numeral (whether integer or not) as a numeric value, conversion is automatic. Anyhow, almost all (absolutely all?) of the actual numeric arguments to MIDI::Event events are integers. 2000-03-05 Sean M. Burke sburke@netadventure.net * Release 0.75 * ChangeLog now goes recent-to-old, not old-to-recent * Changes in this version were mostly made in August 1999, but just never released: * A few optimizations to Event.pm's loops. * Opus.pm now does a little more sanity-checking, to avoid attempting reads of insane sizes, such as might be attempted in the case of parsing a mangled file. 1999-05-13 Sean M. Burke sburke@netadventure.net * Release 0.74 * Just made a few things friendlier to people using perl -w (warnings) * Did ya see my article on MIDI-Perl in /The Perl Journal/ #14? See www.tpj.com for back issues, or email me -- I might have it in some sort of electronic format. 1999-01-10 Sean M. Burke sburke@netadventure.net * Release 0.73 * Just some changes to the docs: Changed the MIDI homepage URL. Added the Langston reference. 1998-11-09 Sean M. Burke sburke@netadventure.net * Release 0.72 * Shigeaki Kobayashi pointed out a bug in MIDI::Opus's $opus->draw that was making it always ignore its options hashref. Fixed. * More carps/croaks instead of warn/dies. 1998-11-04 Sean M. Burke sburke@netadventure.net * Release 0.71 * Docs for MIDI::Simple are more complete now. * An obscure bit of note_map's behavior changed. But you'd never know, because this is the first version that ever documented note_map at all. * Added relative octave specs: o_d3, o_u3. 1998-10-18 Sean M. Burke sburke@netadventure.net * Release 0.70 * Some stupid typos in MIDI.pm fixed. * MIDI::Simple greatly expanded and changed. Almost a total rewrite, in fact -- too many changes to explain. Docs are feeble, tho. * More modules use strict now. 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.62: Hooboy! Third release in a 24-hour period! This time to fix a lame big in MIDI::Score. 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.61: Feh. Forgot to re-comment out the debug code in MIDI::Simple 1998-08-16 Sean M. Burke sburke@netadventure.net * Release 0.60: Subtly destructive bug in MIDI::_dump_quote fixed. MIDI::Event::copy_structure didn't work; fixed. %MIDI::note2number and %MIDI::note2number were named backwards -- note2number actually mapped numbers to notes, and number2note mapped notes to numbers. It made no sense, so I reversed it. Ditto patch2number and number2patch! What was I thinking? Typos in %MIDI::note2number fixed. All the A#'s were "A#" instead of "A#3" or whatever. I also changed the "#" for sharp to "s", giving, e.g., "As3" instead of "A#3". This gives a representation compatable with MIDI::Simple's notation. But note that %MIDI::note2number doesn't contain all of the possible ways MIDI::Simple could let you represent a note -- just a (semi-quirky) subset of them. New module MIDI::Simple. Added MIDI::Event:: score subs, to support draw() and MIDI::Simple. Added MIDI::Opus::draw and supporting subs. 1998-08-14 Sean M. Burke sburke@netadventure.net * Release 0.52: makefile fix. chimes example in MIDI.pm 1998-08-13 Sean M. Burke sburke@netadventure.net * Release 0.51: First CPAN release. Get it while it's hot! MIDI-Perl-0.84/MANIFEST000644 000765 000024 00000001021 14513435350 015015 0ustar00conklinstaff000000 000000 ChangeLog lib/MIDI.pm lib/MIDI/Event.pm lib/MIDI/Filespec.pod lib/MIDI/Opus.pm lib/MIDI/Score.pm lib/MIDI/Simple.pm lib/MIDI/Track.pm Makefile.PL MANIFEST This list of files META.yml MYMETA.json MYMETA.yml README t/00_about_verbose.t t/10_packw.t t/20_cowbell.t t/30_chimes.t t/40_cage.t t/50_dr_m.t t/60_hb.t t/70_j07003.t t/80_nl.t t/90_paradox.t t/91_quant.t t/92_skyline.t t/cage.mid t/dr_m.mid t/hb.mid t/j07003.mid t/skyline.mid t/t.mid META.json Module JSON meta-data (added by MakeMaker) MIDI-Perl-0.84/MYMETA.yml000644 000765 000024 00000001004 14513435303 015402 0ustar00conklinstaff000000 000000 --- abstract: 'read, compose, modify, and write MIDI files' author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MIDI-Perl no_index: directory: - t - inc version: '0.84' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MIDI-Perl-0.84/t/000755 000765 000024 00000000000 14513435350 014135 5ustar00conklinstaff000000 000000 MIDI-Perl-0.84/README000644 000765 000024 00000003514 14513433343 014555 0ustar00conklinstaff000000 000000 README for MIDI-Perl Time-stamp: "2023-10-17 09:25:22 conklin" MIDI-Perl MIDI-Perl is a suite of Perl modules that allows you to read, compose, modify, and write MIDI files. It is largely object-oriented, but if you follow the example code, you should be able to get along fine. See http://interglacial.com/~sburke/pub/perl_midi/ for more info. PREREQUISITES This suite requires Perl 5. MIDI-Perl uses no external libraries at this time, aside from Carp, which has been standard for as long as I can remember. If you want to use MIDI::Opus::draw, you'll also need GD.pm, however. INSTALLATION You install this module-suite, as you would install any perl module library, by running these commands: perl Makefile.PL make make test make install If you want to install a private copy of this module-suite in your home directory, then you should try to produce the initial Makefile with something like this command: perl Makefile.PL PREFIX=~/perl See perldoc perlmodinstall for more information on installing modules. DOCUMENTATION See lib/MIDI.pm for an overview of the suite. See ChangeLog for recent changes. POD-style documentation is included in all modules. POD is readable with the 'perldoc' utility. MACPERL INSTALLATION NOTES Don't bother with the makefiles. Just move MIDI.pm and the "MIDI" folder into your MacPerl library folder. Read the PODs with Shuck. SUPPORT Questions, bug reports, useful code bits, and suggestions for MIDI-Perl should just be sent to me at CONKLIN@cpan.org AVAILABILITY The latest version of MIDI-Perl is available from the Comprehensive Perl Archive Network (CPAN). is my favorite way to view CPAN. COPYRIGHT Copyright 1998+ by Sean M. Burke sburke@cpan.org Copyright 2010+ by D. Conklin conklin@cpan.org MIDI-Perl-0.84/MYMETA.json000644 000765 000024 00000001467 14513435303 015567 0ustar00conklinstaff000000 000000 { "abstract" : "read, compose, modify, and write MIDI files", "author" : [ "unknown" ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "MIDI-Perl", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } } }, "release_status" : "stable", "version" : "0.84", "x_serialization_backend" : "JSON::PP version 4.02" } MIDI-Perl-0.84/META.yml000644 000765 000024 00000001004 14513435350 015136 0ustar00conklinstaff000000 000000 --- abstract: 'read, compose, modify, and write MIDI files' author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MIDI-Perl no_index: directory: - t - inc version: '0.84' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MIDI-Perl-0.84/lib/000755 000765 000024 00000000000 14513435350 014440 5ustar00conklinstaff000000 000000 MIDI-Perl-0.84/Makefile.PL000644 000765 000024 00000001045 14507535366 015657 0ustar00conklinstaff000000 000000 # This -*-perl-*- script writes the Makefile for installing this distribution. # # See "perldoc perlmodinstall" or "perldoc ExtUtils::MakeMaker" for # info on how to control how the installation goes. # # Time-stamp: "2005-01-29 15:11:45 AST" require 5.004; use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'MIDI-Perl', VERSION_FROM => 'lib/MIDI.pm', ABSTRACT => 'read, compose, modify, and write MIDI files', 'dist' => { COMPRESS => 'gzip -6f', SUFFIX => 'gz', }, ); MIDI-Perl-0.84/META.json000644 000765 000024 00000001467 14513435350 015323 0ustar00conklinstaff000000 000000 { "abstract" : "read, compose, modify, and write MIDI files", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "MIDI-Perl", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } } }, "release_status" : "stable", "version" : "0.84", "x_serialization_backend" : "JSON::PP version 4.02" } MIDI-Perl-0.84/lib/MIDI/000755 000765 000024 00000000000 14513435350 015162 5ustar00conklinstaff000000 000000 MIDI-Perl-0.84/lib/MIDI.pm000644 000765 000024 00000036235 14513433477 015541 0ustar00conklinstaff000000 000000 # Time-stamp: "2023-10-17 09:26:53 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.84'; # 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> corresponds 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> corresponds 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", "Shakuhachi", "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> corresponds 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__ MIDI-Perl-0.84/lib/MIDI/Event.pm000644 000765 000024 00000122655 14513434372 016617 0ustar00conklinstaff000000 000000 # Time-stamp: "2023-10-11 11:08:41 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.84'; #First 100 or so lines of this module are straightforward. The actual # encoding logic below that is scary, tho. =head1 NAME MIDI::Event - MIDI events =head1 SYNOPSIS # Dump a MIDI file's text events die "No filename" unless @ARGV; use MIDI; # which "use"s MIDI::Event; MIDI::Opus->new( { "from_file" => $ARGV[0], "exclusive_event_callback" => sub{print "$_[2]\n"}, "include" => \@MIDI::Event::Text_events } ); # These options percolate down to MIDI::Event::decode exit; =head1 DESCRIPTION Functions and lists to do with MIDI events and MIDI event structures. An event is a list, like: ( 'note_on', 141, 4, 50, 64 ) where the first element is the event name, the second is the delta-time, and the remainder are further parameters, per the event-format specifications below. An I is a list of references to such events -- a "LoL". If you don't know how to deal with LoLs, you I read L. =head1 GOODIES For your use in code (as in the code in the Synopsis), this module provides a few lists: =over =item @MIDI_events a list of all "MIDI events" AKA voice events -- e.g., 'note_on' =item @Text_events a list of all text meta-events -- e.g., 'track_name' =item @Nontext_meta_events all other meta-events (plus 'raw_data' and F-series events like 'tune_request'). =item @Meta_events the combination of Text_events and Nontext_meta_events. =item @All_events the combination of all the above lists. =back =cut ########################################################################### # Some public-access lists: @MIDI_events = qw( note_off note_on key_after_touch control_change patch_change channel_after_touch pitch_wheel_change set_sequence_number ); @Text_events = qw( text_event copyright_text_event track_name instrument_name lyric marker cue_point text_event_08 text_event_09 text_event_0a text_event_0b text_event_0c text_event_0d text_event_0e text_event_0f ); @Nontext_meta_events = qw( end_track set_tempo smpte_offset time_signature key_signature sequencer_specific raw_meta_event sysex_f0 sysex_f7 song_position song_select tune_request raw_data ); # Actually, 'tune_request', for one, is is F-series event, not a # strictly-speaking meta-event @Meta_events = (@Text_events, @Nontext_meta_events); @All_events = (@MIDI_events, @Meta_events); =head1 FUNCTIONS This module provides three functions of interest, which all act upon event structures. As an end user, you probably don't need to use any of these directly, but note that options you specify for MIDI::Opus->new with a from_file or from_handle options will percolate down to these functions; so you should understand the options for the first two of the below functions. (The casual user should merely skim this section.) =over =item MIDI::Event::decode( \$data, { ...options... } ) This takes a I to binary MIDI data and decodes it into a new event structure (a LoL), a I to which is returned. Options are: =over 16 =item 'include' => LISTREF I, listref is interpreted as a reference to a list of event names (e.g., 'cue_point' or 'note_off') such that only these events will be parsed from the binary data provided. Events whose names are NOT in this list will be ignored -- i.e., they won't end up in the event structure, and they won't be each passed to any callbacks you may have specified. =item 'exclude' => LISTREF I, listref is interpreted as a reference to a list of event names (e.g., 'cue_point' or 'note_off') that will NOT be parsed from the binary stream; they'll be ignored -- i.e., they won't end up in the event structure, and they won't be passed to any callbacks you may have specified. Don't specify both an include and an exclude list. And if you specify I, all events will be decoded -- this is what you probably want most of the time. I've created this include/exclude functionality mainly so you can scan a file rather efficiently for just a few specific event types, e.g., just text events, or just sysexes. =item 'no_eot_magic' => 0 or 1 See the description of C<'end_track'>, in "EVENTS", below. =item 'event_callback' => CODEREF If defined, the code referred to (whether as C<\&wanted> or as C) is called on every event after it's been parsed into an event list (and any EOT magic performed), but before it's added to the event structure. So if you want to alter the event stream on the way to the event structure (which counts as deep voodoo), define 'event_callback' and have it modify its C<@_>. =item 'exclusive_event_callback' => CODEREF Just like 'event_callback'; but if you specify this, the callback is called I of adding the events to the event structure. (So the event structure returned by decode() at the end will always be empty.) Good for cases like the text dumper in the Synopsis, above. =back =item MIDI::Event::encode( \@events, {...options...}) This takes a I to an event structure (a LoL) and encodes it as binary data, which it returns a I to. Options: =over 16 =item 'unknown_callback' => CODEREF If this is specified, it's interpreted as a reference to a subroutine to be called when an unknown event name (say, 'macro_10' or something), is seen by encode(). The function is fed all of the event (its name, delta-time, and whatever parameters); the return value of this function is added to the encoded data stream -- so if you don't want to add anything, be sure to return ''. If no 'unknown_callback' is specified, encode() will C (well, C) of the unknown event. To merely block that, just set 'unknown_callback' to C =item 'no_eot_magic' => 0 or 1 Determines whether a track-final 0-length text event is encoded as a end-track event -- since a track-final 0-length text event probably started life as an end-track event read in by decode(), above. =item 'never_add_eot' => 0 or 1 If 1, C never ever I an end-track (EOT) event to the encoded data generated unless it's I there as an 'end_track' in the given event structure. You probably don't ever need this unless you're encoding for I writing to a MIDI port, instead of to a file. =item 'no_running_status' => 0 or 1 If 1, disables MIDI's "running status" compression. Probably never necessary unless you need to feed your MIDI data to a strange old sequencer that doesn't understand running status. =back Note: If you're encoding just a single event at a time or less than a whole trackful in any case, then you probably want something like: $data_r = MIDI::Event::encode( [ [ 'note_on', 141, 4, 50, 64 ] ], { 'never_add_eot' => 1} ); which just encodes that one event I an event structure of one event -- i.e., an LoL that's just a list of one list. But note that running status will not always apply when you're encoding less than a whole trackful at a time, since running status works only within a LoL encoded all at once. This'll result in non-optimally compressed, but still effective, encoding. =item MIDI::Event::copy_structure() This takes a I to an event structure, and returns a I to a copy of it. If you're thinking about using this, you probably should want to use the more straightforward $track2 = $track->copy instead. But it's here if you happen to need it. =back =cut ########################################################################### sub dump { my @event = ref($_[0]) ? @{ $_[0] } : @_; # Works as a method (in theory) or as a normal call print( " [", &MIDI::_dump_quote(@event), "],\n" ); } sub copy_structure { # Takes a REFERENCE to an event structure (a ref to a LoL), # and returns a REFERENCE to a copy of that structure. my $events_r = $_[0]; croak "\$_[0] ($events_r) isn't a reference for MIDI::Event::copy_structure()!!" unless ref($events_r); return [ map( [@$_], @$events_r ) ]; } ########################################################################### # The module code below this line is full of frightening things, all to do # with the actual encoding and decoding of binary MIDI data. ########################################################################### sub read_14_bit { # Decodes to a value 0 to 16383, as is used for some event encoding my($b1, $b2) = unpack("C2", $_[0]); return ($b1 | ($b2 << 7)); } sub write_14_bit { # encode a 14 bit quantity, as needed for some events return pack("C2", ($_[0] & 0x7F), # lower 7 bits (($_[0] >> 7) & 0x7F), # upper 7 bits ); } ########################################################################### # # One definite assumption is made here: that "variable-length-encoded" # quantities MUST NOT exceed 0xFFFFFFF (encoded, "\xFF\xFF\xFF\x7F") # -- i.e., must not take more than 4 bytes to encode. # ### sub decode { # decode track data into an event structure # Calling format: a REFERENCE to a big chunka MTrk track data. # Returns an (unblessed) REFERENCE to an event structure (a LoL) # Note that this is a function call, not a constructor method call. # Why a references and not the things themselves? For efficiency's sake. my $data_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my @events = (); unless(ref($data_r) eq 'SCALAR') { carp "\$_[0] is not a data reference, in MIDI::Event::decode!"; return []; } my %exclude = (); if(defined($options_r->{ 'exclude' })) { if( ref($options_r->{'exclude'}) eq 'ARRAY' ) { @exclude{ @{ $options_r->{'exclude'} } } = undef; } else { croak "parameter for MIDI::Event::decode option 'exclude' must be a listref!" if $options_r->{'exclude'}; # If it's false, carry on silently } } else { # If we get an include (and no exclude), make %exclude a list # of all possible events, /minus/ what include specifies if(defined($options_r->{ 'include' })) { if( ref($options_r->{'include'}) eq 'ARRAY' ) { @exclude{ @All_events } = undef; # rack 'em delete @exclude{ # and break 'em @{ $options_r->{'include'} } }; } else { croak "parameter for decode option 'include' must be a listref!" if $options_r->{'include'}; # If it's false, carry on silently } } } print "Exclusions: ", join(' ', map("<$_>", sort keys %exclude)), "\n" if $Debug; my $event_callback = undef; if(defined($options_r->{ 'event_callback' })) { if( ref($options_r->{'event_callback'}) eq 'CODE' ) { $event_callback = $options_r->{'event_callback'}; } else { carp "parameter for decode option 'event_callback' is not a coderef!\n"; } } my $exclusive_event_callback = undef; if(defined($options_r->{ 'exclusive_event_callback' })) { if( ref($options_r->{'exclusive_event_callback'}) eq 'CODE' ) { $exclusive_event_callback = $options_r->{'exclusive_event_callback'}; } else { carp "parameter for decode option 'exclusive_event_callback' is not a coderef!\n"; } } my $Pointer = 0; # points to where I am in the data ###################################################################### if($Debug) { if($Debug == 1) { print "Track data of ", length($$data_r), " bytes.\n"; } else { print "Track data of ", length($$data_r), " bytes: <", $$data_r ,">\n"; } } =head1 EVENTS AND THEIR DATA TYPES =head2 DATA TYPES Events use these data types: =over =item channel = a value 0 to 15 =item note = a value 0 to 127 =item dtime = a value 0 to 268,435,455 (0x0FFFFFFF) =item velocity = a value 0 to 127 =item channel = a value 0 to 15 =item patch = a value 0 to 127 =item sequence = a value 0 to 65,535 (0xFFFF) =item text = a string of 0 or more bytes of of ASCII text =item raw = a string of 0 or more bytes of binary data =item pitch_wheel = a value -8192 to 8191 (0x1FFF) =item song_pos = a value 0 to 16,383 (0x3FFF) =item song_number = a value 0 to 127 =item tempo = microseconds, a value 0 to 16,777,215 (0x00FFFFFF) =back For data types not defined above, (e.g., I and I for C<'key_signature'>), consult L and/or the source for C. And if you don't see it documented, it's probably because I don't understand it, so you'll have to consult a real MIDI reference. =head2 EVENTS And these are the events: =over =cut # Things I use variously, below. They're here just for efficiency's sake, # to avoid remying on each iteration. my($command, $channel, $parameter, $length, $time, $remainder); my $event_code = -1; # used for running status my $event_count = 0; Event: # Analyze the event stream. while($Pointer + 1 < length($$data_r)) { # loop while there's anything to analyze ... my $eot = 0; # When 1, the event registrar aborts this loop ++$event_count; my @E = (); # E for events -- this is what we'll feed to the event registrar # way at the end. # Slice off the delta time code, and analyze it #!# print "Chew-code <", substr($$data_r,$Pointer,4), ">\n"; ($time, $remainder) = unpack("wa*", substr($$data_r,$Pointer,4)); #!# print "Delta-time $time using ", 4 - length($remainder), " bytes\n" #!# if $Debug > 1; $Pointer += 4 - length($remainder); # We do this strangeness with remainders because we don't know # how many bytes the w-decoding should move the pointer ahead. # Now let's see what we can make of the command my $first_byte = ord(substr($$data_r, $Pointer, 1)); # Whatever parses $first_byte is responsible for moving $Pointer # forward. #!#print "Event \# $event_count: $first_byte at track-offset $Pointer\n" #!# if $Debug > 1; ###################################################################### if ($first_byte < 0xF0) { # It's a MIDI event ######################## if($first_byte >= 0x80) { print "Explicit event $first_byte" if $Debug > 2; ++$Pointer; # It's an explicit event. $event_code = $first_byte; } else { # It's a running status mofo -- just use last $event_code value if($event_code == -1) { warn "Uninterpretable use of running status; Aborting track." if $Debug; last Event; } # Let the argument-puller-offer move Pointer. } $command = $event_code & 0xF0; $channel = $event_code & 0x0F; if ($command == 0xC0 || $command == 0xD0) { # Pull off the 1-byte argument $parameter = substr($$data_r, $Pointer, 1); ++$Pointer; } else { # pull off the 2-byte argument $parameter = substr($$data_r, $Pointer, 2); $Pointer += 2; } ################################################################### # MIDI events =item ('note_off', I, I, I, I) =cut if ($command == 0x80) { next if $exclude{'note_off'}; # for sake of efficiency @E = ( 'note_off', $time, $channel, unpack('C2', $parameter)); =item ('note_on', I, I, I, I) =cut } elsif ($command == 0x90) { next if $exclude{'note_on'}; @E = ( 'note_on', $time, $channel, unpack('C2', $parameter)); =item ('key_after_touch', I, I, I, I) =cut } elsif ($command == 0xA0) { next if $exclude{'key_after_touch'}; @E = ( 'key_after_touch', $time, $channel, unpack('C2', $parameter)); =item ('control_change', I, I, I, I) =cut } elsif ($command == 0xB0) { next if $exclude{'control_change'}; @E = ( 'control_change', $time, $channel, unpack('C2', $parameter)); =item ('patch_change', I, I, I) =cut } elsif ($command == 0xC0) { next if $exclude{'patch_change'}; @E = ( 'patch_change', $time, $channel, unpack('C', $parameter)); =item ('channel_after_touch', I, I, I) =cut } elsif ($command == 0xD0) { next if $exclude{'channel_after_touch'}; @E = ('channel_after_touch', $time, $channel, unpack('C', $parameter)); =item ('pitch_wheel_change', I, I, I) =cut } elsif ($command == 0xE0) { next if $exclude{'pitch_wheel_change'}; @E = ('pitch_wheel_change', $time, $channel, &read_14_bit($parameter) - 0x2000); } else { warn # Should be QUITE impossible! "SPORK ERROR M:E:1 in track-offset $Pointer\n"; } ###################################################################### } elsif($first_byte == 0xFF) { # It's a Meta-Event! ################## ($command, $length, $remainder) = unpack("xCwa*", substr($$data_r, $Pointer, 6)); $Pointer += 6 - length($remainder); # Move past JUST the length-encoded. =item ('set_sequence_number', I, I) =cut if($command == 0x00) { @E = ('set_sequence_number', $time, unpack('n', substr($$data_r, $Pointer, $length) ) ); # Defined text events ---------------------------------------------- =item ('text_event', I, I) =item ('copyright_text_event', I, I) =item ('track_name', I, I) =item ('instrument_name', I, I) =item ('lyric', I, I) =item ('marker', I, I) =item ('cue_point', I, I) =item ('text_event_08', I, I) =item ('text_event_09', I, I) =item ('text_event_0a', I, I) =item ('text_event_0b', I, I) =item ('text_event_0c', I, I) =item ('text_event_0d', I, I) =item ('text_event_0e', I, I) =item ('text_event_0f', I, I) =cut } elsif($command == 0x01) { @E = ('text_event', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x02) { @E = ('copyright_text_event', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x03) { @E = ('track_name', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x04) { @E = ('instrument_name', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x05) { @E = ('lyric', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x06) { @E = ('marker', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x07) { @E = ('cue_point', $time, substr($$data_r, $Pointer, $length)); # DTime, TData # Reserved but apparently unassigned text events -------------------- } elsif($command == 0x08) { @E = ('text_event_08', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x09) { @E = ('text_event_09', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0a) { @E = ('text_event_0a', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0b) { @E = ('text_event_0b', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0c) { @E = ('text_event_0c', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0d) { @E = ('text_event_0d', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0e) { @E = ('text_event_0e', $time, substr($$data_r, $Pointer, $length)); # DTime, TData } elsif($command == 0x0f) { @E = ('text_event_0f', $time, substr($$data_r, $Pointer, $length)); # DTime, TData # Now the sticky events --------------------------------------------- =item ('end_track', I) =cut } elsif($command == 0x2F) { @E = ('end_track', $time ); # DTime # The code for handling this oddly comes LATER, in the # event registrar. =item ('set_tempo', I, I) =cut } elsif($command == 0x51) { @E = ('set_tempo', $time, unpack("N", "\x00" . substr($$data_r, $Pointer, $length) ) ); # DTime, Microseconds =item ('smpte_offset', I, I
, I, I, I, I) =cut } elsif($command == 0x54) { @E = ('smpte_offset', $time, unpack("C*", # there SHOULD be exactly 5 bytes here substr($$data_r, $Pointer, $length) )); # DTime, HR, MN, SE, FR, FF =item ('time_signature', I, I, I
, I, I) =cut } elsif($command == 0x58) { @E = ('time_signature', $time, unpack("C*", # there SHOULD be exactly 4 bytes here substr($$data_r, $Pointer, $length) )); # DTime, NN, DD, CC, BB =item ('key_signature', I, I, I) =cut } elsif($command == 0x59) { @E = ('key_signature', $time, unpack("cC", # there SHOULD be exactly 2 bytes here substr($$data_r, $Pointer, $length) )); # DTime, SF(signed), MI =item ('sequencer_specific', I, I) =cut } elsif($command == 0x7F) { @E = ('sequencer_specific', $time, substr($$data_r, $Pointer, $length)); # DTime, Binary Data =item ('raw_meta_event', I, I(0-255), I) =cut } else { @E = ('raw_meta_event', $time, $command, substr($$data_r, $Pointer, $length) # "[uninterpretable meta-event $command of length $length]" ); # DTime, Command, Binary Data # It's uninterpretable; record it as raw_data. } # End of the meta-event ifcase. $Pointer += $length; # Now move Pointer ###################################################################### } elsif($first_byte == 0xF0 # It's a SYSEX ######################### || $first_byte == 0xF7) { # Note that sysexes in MIDI /files/ are different than sysexes in # MIDI transmissions!! # << The vast majority of system exclusive messages will just use the F0 # format. For instance, the transmitted message F0 43 12 00 07 F7 would # be stored in a MIDI file as F0 05 43 12 00 07 F7. As mentioned above, # it is required to include the F7 at the end so that the reader of the # MIDI file knows that it has read the entire message. >> # (But the F7 is omitted if this is a non-final block in a multiblock # sysex; but the F7 (if there) is counted in the message's declared # length, so we don't have to think about it anyway.) ($command, $length, $remainder) = unpack("Cwa*", substr($$data_r, $Pointer, 5)); $Pointer += 5 - length($remainder); # Move past just the encoding =item ('sysex_f0', I, I) =item ('sysex_f7', I, I) =cut @E = ( $first_byte == 0xF0 ? 'sysex_f0' : 'sysex_f7', $time, substr($$data_r, $Pointer, $length) ); # DTime, Data $Pointer += $length; # Now move past the data ###################################################################### # Now, the MIDI file spec says: # = + # = # = | | # I know that, on the wire, can include note_on, # note_off, and all the other 8x to Ex events, AND Fx events # other than F0, F7, and FF -- namely, , # , and . # # Whether these can occur in MIDI files is not clear specified from # the MIDI file spec. # # So, I'm going to assume that they CAN, in practice, occur. # I don't know whether it's proper for you to actually emit these # into a MIDI file. # ###################################################################### } elsif($first_byte == 0xF2) { # It's a Song Position ################ =item ('song_position', I) =cut # ::= F2 @E = ('song_position', $time, &read_14_bit(substr($$data_r,$Pointer+1,2) ) ); # DTime, Beats $Pointer += 3; # itself, and 2 data bytes ###################################################################### } elsif($first_byte == 0xF3) { # It's a Song Select ################## =item ('song_select', I, I) =cut # ::= F3 @E = ( 'song_select', $time, unpack('C', substr($$data_r,$Pointer+1,1) ) ); # DTime, Thing (?!) ... song number? whatever that is $Pointer += 2; # itself, and 1 data byte ###################################################################### } elsif($first_byte == 0xF6) { # It's a Tune Request! ################ =item ('tune_request', I) =cut # ::= F6 @E = ( 'tune_request', $time ); # DTime # What the Sam Scratch would a tune request be doing in a MIDI /file/? ++$Pointer; # itself ########################################################################### ## ADD MORE META-EVENTS HERE #Done: # f0 f7 -- sysexes # f2 -- song position # f3 -- song select # f6 -- tune request # ff -- metaevent ########################################################################### #TODO: # f1 -- MTC Quarter Frame Message. one data byte follows. # One data byte follows the Status. It's the time code value, a number # from 0 to 127. # f8 -- MIDI clock. no data. # fa -- MIDI start. no data. # fb -- MIDI continue. no data. # fc -- MIDI stop. no data. # fe -- Active sense. no data. # f4 f5 f9 fd -- unallocated ###################################################################### } elsif($first_byte > 0xF0) { # Some unknown kinda F-series event #### =item ('raw_data', I, I) =cut # Here we only produce a one-byte piece of raw data. # But the encoder for 'raw_data' accepts any length of it. @E = ( 'raw_data', $time, substr($$data_r,$Pointer,1) ); # DTime and the Data (in this case, the one Event-byte) ++$Pointer; # itself ###################################################################### } else { # Fallthru. How could we end up here? ###################### warn "Aborting track. Command-byte $first_byte at track offset $Pointer"; last Event; } # End of the big if-group ##################################################################### ###################################################################### ## # By the Power of Greyskull, I AM THE EVENT REGISTRAR! ## if( @E and $E[0] eq 'end_track' ) { # This's the code for exceptional handling of the EOT event. $eot = 1; unless( defined($options_r->{'no_eot_magic'}) and $options_r->{'no_eot_magic'} ) { if($E[1] > 0) { @E = ('text_event', $E[1], ''); # Make up a fictive 0-length text event as a carrier # for the non-zero delta-time. } else { # EOT with a delta-time of 0. Ignore it! @E = (); } } } if( @E and exists( $exclude{$E[0]} ) ) { if($Debug) { print " Excluding:\n"; &dump(@E); } } else { if($Debug) { print " Processing:\n"; &dump(@E); } if(@E){ if( $exclusive_event_callback ) { &{ $exclusive_event_callback }( @E ); } else { &{ $event_callback }( @E ) if $event_callback; push(@events, [ @E ]); } } } =back Three of the above events are represented a bit oddly from the point of view of the file spec: The parameter I for C<'pitch_wheel_change'> is a value -8192 to 8191, although the actual encoding of this is as a value 0 to 16,383, as per the spec. Sysex events are represented as either C<'sysex_f0'> or C<'sysex_f7'>, depending on the status byte they are encoded with. C<'end_track'> is a bit stranger, in that it is almost never actually found, or needed. When the MIDI decoder sees an EOT (i.e., an end-track status: FF 2F 00) with a delta time of 0, it is I! If in the unlikely event that it has a nonzero delta-time, it's decoded as a C<'text_event'> with whatever that delta-time is, and a zero-length text parameter. (This happens before the C<'event_callback'> or C<'exclusive_event_callback'> callbacks are given a crack at it.) On the encoding side, an EOT is added to the end of the track as a normal part of the encapsulation of track data. I chose to add this special behavior so that you could add events to the end of a track without having to work around any track-final C<'end_track'> event. However, if you set C as a decoding parameter, none of this magic happens on the decoding side -- C<'end_track'> is decoded just as it is. And if you set C as an encoding parameter, then a track-final 0-length C<'text_event'> with non-0 delta-times is left as is. Normally, such an event would be converted from a C<'text_event'> to an C<'end_track'> event with thath delta-time. Normally, no user needs to use the C option either in encoding or decoding. But it is provided in case you need your event LoL to be an absolutely literal representation of the binary data, and/or vice versa. =cut last Event if $eot; } # End of the bigass "Event" while-block return \@events; } ########################################################################### sub encode { # encode an event structure, presumably for writing to a file # Calling format: # $data_r = MIDI::Event::encode( \@event_lol, { options } ); # Takes a REFERENCE to an event structure (a LoL) # Returns an (unblessed) REFERENCE to track data. # If you want to use this to encode a /single/ event, # you still have to do it as a reference to an event structure (a LoL) # that just happens to have just one event. I.e., # encode( [ $event ] ) or encode( [ [ 'note_on', 100, 5, 42, 64] ] ) # If you're doing this, consider the never_add_eot track option, as in # print MIDI ${ encode( [ $event], { 'never_add_eot' => 1} ) }; my $events_r = $_[0]; my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; my @data = (); # what I'll store chunks of data in my $data = ''; # what I'll join @data all together into croak "MIDI::Event::encode's argument must be an array reference!" unless ref($events_r); # better be an array! my @events = @$events_r; # Yes, copy it. This is so my end_track magic won't corrupt the original my $unknown_callback = undef; $unknown_callback = $options_r->{'unknown_callback'} if ref($options_r->{'unknown_callback'}) eq 'CODE'; unless($options_r->{'never_add_eot'}) { # One way or another, tack on an 'end_track' if(@events) { # If there's any events... my $last = $events[ -1 ]; unless($last->[0] eq 'end_track') { # ...And there's no end_track already if($last->[0] eq 'text_event' and length($last->[2]) == 0) { # 0-length text event at track-end. if($options_r->{'no_eot_magic'}) { # Exceptional case: don't mess with track-final # 0-length text_events; just peg on an end_track push(@events, ['end_track', 0]); } else { # NORMAL CASE: replace it with an end_track, leaving the DTime $last->[0] = 'end_track'; } } else { # last event was neither a 0-length text_event nor an end_track push(@events, ['end_track', 0]); } } } else { # an eventless track! @events = ['end_track',0]; } } #print "--\n"; #foreach(@events){ MIDI::Event::dump($_) } #print "--\n"; my $maybe_running_status = not $options_r->{'no_running_status'}; my $last_status = -1; # Here so we don't have to re-my on every iteration my(@E, $event, $dtime, $event_data, $status, $parameters); Event_Encode: foreach my $event_r (@events) { next unless ref($event_r); # what'd such a thing ever be doing in here? @E = @$event_r; # Yes, copy it. Otherwise the shifting'd corrupt the original next unless @E; $event = shift @E; next unless length($event); $dtime = int shift @E; $event_data = ''; if( # MIDI events -- eligible for running status $event eq 'note_on' or $event eq 'note_off' or $event eq 'control_change' or $event eq 'key_after_touch' or $event eq 'patch_change' or $event eq 'channel_after_touch' or $event eq 'pitch_wheel_change' ) { #print "ziiz $event\n"; # $status = $parameters = ''; # This block is where we spend most of the time. Gotta be tight. if($event eq 'note_off'){ $status = 0x80 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'note_on'){ $status = 0x90 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'key_after_touch'){ $status = 0xA0 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0x7F, int($E[2]) & 0x7F); } elsif($event eq 'control_change'){ $status = 0xB0 | (int($E[0]) & 0x0F); $parameters = pack('C2', int($E[1]) & 0xFF, int($E[2]) & 0xFF); } elsif($event eq 'patch_change'){ $status = 0xC0 | (int($E[0]) & 0x0F); $parameters = pack('C', int($E[1]) & 0xFF); } elsif($event eq 'channel_after_touch'){ $status = 0xD0 | (int($E[0]) & 0x0F); $parameters = pack('C', int($E[1]) & 0xFF); } elsif($event eq 'pitch_wheel_change'){ $status = 0xE0 | (int($E[0]) & 0x0F); $parameters = &write_14_bit(int($E[1]) + 0x2000); } else { die "BADASS FREAKOUT ERROR 31415!"; } # And now the encoding push(@data, ($maybe_running_status and $status == $last_status) ? pack('wa*', $dtime, $parameters) : # If we can use running status. pack('wCa*', $dtime, $status, $parameters) # If we can't. ); $last_status = $status; next; } else { # Not a MIDI event. # All the code in this block could be more efficient, but frankly, # this is not where the code needs to be tight. # So we wade thru the cases and eventually hopefully fall thru # with $event_data set. #print "zaz $event\n"; $last_status = -1; if($event eq 'raw_meta_event') { $event_data = pack("CCwa*", 0xFF, int($E[0]), length($E[1]), $E[1]); # Text meta-events... } elsif($event eq 'text_event') { $event_data = pack("CCwa*", 0xFF, 0x01, length($E[0]), $E[0]); } elsif($event eq 'copyright_text_event') { $event_data = pack("CCwa*", 0xFF, 0x02, length($E[0]), $E[0]); } elsif($event eq 'track_name') { $event_data = pack("CCwa*", 0xFF, 0x03, length($E[0]), $E[0]); } elsif($event eq 'instrument_name') { $event_data = pack("CCwa*", 0xFF, 0x04, length($E[0]), $E[0]); } elsif($event eq 'lyric') { $event_data = pack("CCwa*", 0xFF, 0x05, length($E[0]), $E[0]); } elsif($event eq 'marker') { $event_data = pack("CCwa*", 0xFF, 0x06, length($E[0]), $E[0]); } elsif($event eq 'cue_point') { $event_data = pack("CCwa*", 0xFF, 0x07, length($E[0]), $E[0]); } elsif($event eq 'text_event_08') { $event_data = pack("CCwa*", 0xFF, 0x08, length($E[0]), $E[0]); } elsif($event eq 'text_event_09') { $event_data = pack("CCwa*", 0xFF, 0x09, length($E[0]), $E[0]); } elsif($event eq 'text_event_0a') { $event_data = pack("CCwa*", 0xFF, 0x0a, length($E[0]), $E[0]); } elsif($event eq 'text_event_0b') { $event_data = pack("CCwa*", 0xFF, 0x0b, length($E[0]), $E[0]); } elsif($event eq 'text_event_0c') { $event_data = pack("CCwa*", 0xFF, 0x0c, length($E[0]), $E[0]); } elsif($event eq 'text_event_0d') { $event_data = pack("CCwa*", 0xFF, 0x0d, length($E[0]), $E[0]); } elsif($event eq 'text_event_0e') { $event_data = pack("CCwa*", 0xFF, 0x0e, length($E[0]), $E[0]); } elsif($event eq 'text_event_0f') { $event_data = pack("CCwa*", 0xFF, 0x0f, length($E[0]), $E[0]); # End of text meta-events } elsif($event eq 'end_track') { $event_data = "\xFF\x2F\x00"; } elsif($event eq 'set_tempo') { $event_data = pack("CCwa*", 0xFF, 0x51, 3, substr( pack('N', $E[0]), 1, 3 )); } elsif($event eq 'smpte_offset') { $event_data = pack("CCwCCCCC", 0xFF, 0x54, 5, @E[0,1,2,3,4] ); } elsif($event eq 'time_signature') { $event_data = pack("CCwCCCC", 0xFF, 0x58, 4, @E[0,1,2,3] ); } elsif($event eq 'key_signature') { $event_data = pack("CCwcC", 0xFF, 0x59, 2, @E[0,1]); } elsif($event eq 'sequencer_specific') { $event_data = pack("CCwa*", 0xFF, 0x7F, length($E[0]), $E[0]); # End of Meta-events # Other Things... } elsif($event eq 'sysex_f0') { $event_data = pack("Cwa*", 0xF0, length($E[0]), $E[0]); } elsif($event eq 'sysex_f7') { $event_data = pack("Cwa*", 0xF7, length($E[0]), $E[0]); } elsif($event eq 'song_position') { $event_data = "\xF2" . &write_14_bit( $E[0] ); } elsif($event eq 'song_select') { $event_data = pack('CC', 0xF3, $E[0] ); } elsif($event eq 'tune_request') { $event_data = "\xF6"; } elsif($event eq 'raw_data') { $event_data = $E[0]; # End of Other Stuff } else { # The Big Fallthru if($unknown_callback) { push(@data, &{ $unknown_callback }( @$event_r )); } else { warn "Unknown event: \'$event\'\n"; # To surpress complaint here, just set # 'unknown_callback' => sub { return () } } next; } #print "Event $event encoded part 2\n"; push(@data, pack('wa*', $dtime, $event_data)) if length($event_data); # how could $event_data be empty } } $data = join('', @data); return \$data; } ########################################################################### ########################################################################### =head1 MIDI BNF For your reference (if you can make any sense of it), here is a copy of the MIDI BNF, as I found it in a text file that's been floating around the Net since the late 1980s. Note that this seems to describe MIDI events as they can occur in MIDI-on-the-wire. I I that realtime data insertion (i.e., the ability to have Erealtime byteEs popping up in the I of messages) is something that can't happen in MIDI files. In fact, this library, as written, I correctly parse MIDI data that has such realtime bytes inserted in messages. Nor does it support representing such insertion in a MIDI event structure that's encodable for writing to a file. (Although you could theoretically represent events with embedded Erealtime byteEs as just C events; but then, you can always stow anything at all in a C event.) 1. ::= < MIDI Stream> 2. ::= | 3. ::= | | 4. ::= 5. ::= 6. ::= 7. ::= 8. ::= C | D 9. ::= 8 | 9 | A | B | E 10. ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | | 8 | 9 | A | B | C | D | E | F 11. ::= 12. ::= | | 13. ::= | 14. ::= | | 15. ::= 16. ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 17. ::= F8 | FA | FB | FC | FE | FF 18. ::= | | | | 19. ::= 20. ::= 21. ::= F0 22. ::= F7 23. ::= | | | | 24. ::= F6 25. ::= 26. ::= 27. ::=F2 28. ::= F3 =head1 COPYRIGHT Copyright (c) 1998-2005 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Sean M. Burke C (Except the BNF -- who knows who's behind that.) =cut 1; __END__ MIDI-Perl-0.84/lib/MIDI/Track.pm000644 000765 000024 00000034043 14513434252 016570 0ustar00conklinstaff000000 000000 # 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.84'; =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 =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($_[0]) eq 'HASH' ? $_[0] : {}; 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