File Coverage

blib/lib/MIDI/Simple.pm
Criterion Covered Total %
statement 145 428 33.8
branch 46 252 18.2
condition 11 118 9.3
subroutine 19 81 23.4
pod 60 69 86.9
total 281 948 29.6


line stmt bran cond sub pod time code
1              
2             # Time-stamp: "2023-10-17 09:28:16 conklin"
3             require 5;
4             package MIDI::Simple;
5 2     2   5823 use MIDI;
  2         5  
  2         57  
6 2     2   25 use Carp;
  2         4  
  2         99  
7 2     2   9 use strict 'vars';
  2         4  
  2         47  
8 2     2   8 use strict 'subs';
  2         3  
  2         49  
9 2         159 use vars qw(@ISA @EXPORT $VERSION $Debug
10             %package
11 2     2   8 %Volume @Note %Note %Length);
  2         3  
12 2         9 use subs qw(&make_opus($\@) &write_score($$\@)
13             &read_score($) &dump_score(\@)
14 2     2   960 );
  2         42  
15             require Exporter;
16             @ISA = qw(Exporter);
17             $VERSION = '0.84';
18             $Debug = 0;
19              
20             @EXPORT = qw(
21             new_score n r noop interval note_map
22             Score Time Duration Channel Octave Tempo Notes Volume
23             Score_r Time_r Duration_r Channel_r Octave_r Tempo_r Notes_r Volume_r
24             Cookies Cookies_r Self
25             write_score read_score dump_score make_opus synch
26             is_note_spec is_relative_note_spec is_absolute_note_spec
27             number_to_absolute number_to_relative
28              
29             key_after_touch control_change patch_change channel_after_touch
30             pitch_wheel_change set_sequence_number text_event copyright_text_event
31             track_name instrument_name lyric marker cue_point
32              
33             text_event_08 text_event_09 text_event_0a text_event_0b text_event_0c
34             text_event_0d text_event_0e text_event_0f
35              
36             end_track set_tempo smpte_offset time_signature key_signature
37             sequencer_specific raw_meta_event
38              
39             sysex_f0 sysex_f7
40             song_position song_select tune_request raw_data
41             ); # _test_proc
42              
43             local %package = ();
44             # hash of package-scores: accessible as $MIDI::Simple::package{"packagename"}
45             # but REALLY think twice about writing to it, OK?
46             # To get at the current package's package-score object, just call
47             # $my_object = Self;
48              
49             # /
50             #| 'Alchemical machinery runs smoothest in the imagination.'
51             #| -- Terence McKenna
52             # \
53              
54             =head1 NAME
55              
56             MIDI::Simple - procedural/OOP interface for MIDI composition
57              
58             =head1 SYNOPSIS
59              
60             use strict;
61             use MIDI::Simple;
62             new_score;
63             text_event 'http://www.ely.anglican.org/parishes/camgsm/bells/chimes.html';
64             text_event 'Lord through this hour/ be Thou our guide';
65             text_event 'so, by Thy power/ no foot shall slide';
66             set_tempo 500000; # 1 qn => .5 seconds (500,000 microseconds)
67             patch_change 1, 8; # Patch 8 = Celesta
68              
69             noop c1, f, o5; # Setup
70             # Now play
71             n 'qn', 'Cs'; n 'F'; n 'Ds'; n 'hn', 'Gs_d1';
72             n 'qn', 'Cs'; n 'Ds'; n 'F'; n 'hn', 'Cs';
73             n 'qn', 'F'; n 'Cs'; n 'Ds'; n 'hn', 'Gs_d1';
74             n 'qn', 'Gs_d1'; n 'Ds'; n 'F'; n 'hn', 'Cs';
75              
76             write_score 'westminster_chimes.mid';
77              
78             =head1 DESCRIPTION
79              
80             This module sits on top of all the MIDI modules -- notably MIDI::Score
81             (so you should skim L) -- and is meant to serve as a
82             basic interface to them, for composition. By composition, I mean
83             composing anew; you can use this module to add to or modify existing
84             MIDI files, but that functionality is to be considered a bit experimental.
85              
86             This module provides two related but distinct bits of functionality:
87             1) a mini-language (implemented as procedures that can double as
88             methods) for composing by adding notes to a score structure; and 2)
89             simple functions for reading and writing scores, specifically the
90             scores you make with the composition language.
91              
92             The fact that this module's interface is both procedural and
93             object-oriented makes it a definite two-headed beast. The parts of
94             the guts of the source code are not for the faint of heart.
95              
96              
97             =head1 NOTE ON VERSION CHANGES
98              
99             This module is somewhat incompatible with the MIDI::Simple versions
100             before .700 (but that was a I time ago).
101              
102              
103             =cut
104              
105             %Volume = ( # I've simply made up these values from more or less nowhere.
106             # You no like? Change 'em at runtime, or just use "v64" or whatever,
107             # to specify the volume as a number 1-127.
108             'ppp' => 1, # pianississimo
109             'pp' => 12, # pianissimo
110             'p' => 24, # piano
111             'mp' => 48, # mezzopiano
112             'm' => 64, # mezzo / medio / meta` / middle / whatever
113             'mezzo' => 64,
114             'mf' => 80, # mezzoforte
115             'f' => 96, # forte
116             'ff' => 112, # fortissimo
117             'fff' => 127, # fortississimo
118             );
119              
120             %Length = ( # this list should be rather uncontroversial.
121             # The numbers here are multiples of a quarter note's length
122             # The abbreviations are:
123             # qn for "quarter note",
124             # dqn for "dotted quarter note",
125             # ddqn for "double-dotten quarter note",
126             # tqn for "triplet quarter note"
127             'wn' => 4, 'dwn' => 6, 'ddwn' => 7, 'twn' => (8/3),
128             'hn' => 2, 'dhn' => 3, 'ddhn' => 3.5, 'thn' => (4/3),
129             'qn' => 1, 'dqn' => 1.5, 'ddqn' => 1.75, 'tqn' => (2/3),
130             'en' => .5, 'den' => .75, 'dden' => .875, 'ten' => (1/3),
131             'sn' => .25, 'dsn' => .375, 'ddsn' => .4375, 'tsn' => (1/6),
132             # Yes, these fractions could lead to round-off errors, I suppose.
133             # But note that 96 * all of these == a WHOLE NUMBER!!!!!
134              
135             # Dangit, tsn for "thirty-second note" clashes with pre-existing tsn for
136             # "triplet sixteenth note"
137             #For 32nd notes, tha values'd be:
138             # .125 .1875 .21875 (1/12)
139             #But hell, just access 'em as:
140             # d12 d18 d21 d8
141             #(assuming Tempo = 96)
142              
143             );
144              
145             %Note = (
146             'C' => 0,
147             'Cs' => 1, 'Df' => 1, 'Csharp' => 1, 'Dflat' => 1,
148             'D' => 2,
149             'Ds' => 3, 'Ef' => 3, 'Dsharp' => 3, 'Eflat' => 3,
150             'E' => 4,
151             'F' => 5,
152             'Fs' => 6, 'Gf' => 6, 'Fsharp' => 6, 'Gflat' => 6,
153             'G' => 7,
154             'Gs' => 8, 'Af' => 8, 'Gsharp' => 8, 'Aflat' => 8,
155             'A' => 9,
156             'As' => 10, 'Bf' => 10, 'Asharp' => 10, 'Bflat' => 10,
157             'B' => 11,
158             );
159              
160             @Note = qw(C Df D Ef E F Gf G Af A Bf B);
161             # These are for converting note numbers to names, via, e.g., $Note[2]
162             # These must be a subset of the keys to %Note.
163             # You may choose to have these be your /favorite/ names for the particular
164             # notes. I've taken a stab at that myself.
165             ###########################################################################
166              
167             =head2 OBJECT STRUCTURE
168              
169             A MIDI::Simple object is a data structure with the following
170             attributes:
171              
172             =over
173              
174             =item Score
175              
176             This is a list of all the notes (each a listref) that constitute this
177             one-track musical piece. Scores are explained in L.
178             You probably don't need to access the Score attribute directly, but be
179             aware that this is where all the notes you make with C events go.
180              
181             =item Time
182              
183             This is a non-negative integer expressing the start-time, in ticks
184             from the start-time of the MIDI piece, that the next note pushed to
185             the Score will have.
186              
187             =item Channel
188              
189             This is a number in the range [0-15] that specifies the current default
190             channel for note events.
191              
192             =item Duration
193              
194             This is a non-negative (presumably nonzero) number expressing, in
195             ticks, the current default length of note events, or rests.
196              
197             =item Octave
198              
199             This is a number in the range [0-10], expressing what the current
200             default octave number is. This is used for figuring out exactly
201             what note-pitch is meant by a relative note-pitch specification
202             like "A".
203              
204             =item Notes
205              
206             This is a list (presumably non-empty) of note-pitch specifications,
207             I in the range [0-127].
208              
209             =item Volume
210              
211             This is an integer in the range [0-127] expressing the current default
212             volume for note events.
213              
214             =item Tempo
215              
216             This is an integer expressing the number of ticks a quarter note
217             occupies. It's currently 96, and you shouldn't alter it unless you
218             I know what you're doing. If you want to control the tempo of
219             a piece, use the C routine, instead.
220              
221             =item Cookies
222              
223             This is a hash that can be used by user-defined object-methods for
224             storing whatever they want.
225              
226             =back
227              
228             Each package that you call the procedure C from, has a
229             default MIDI::Simple object associated with it, and all the above
230             attributes are accessible as:
231              
232             @Score $Time $Channel $Duration $Octave
233             @Notes $Volume $Tempo %Cookies
234              
235             (Although I doubt you'll use these from any package other than
236             "main".) If you don't know what a package is, don't worry about it.
237             Just consider these attributes synonymous with the above-listed
238             variables. Just start your programs with
239              
240             use MIDI::Simple;
241             new_score;
242              
243             and you'll be fine.
244              
245             =head2 Routine/Method/Procedure
246              
247             MIDI::Simple provides some pure functions (i.e., things that take
248             input, and give a return value, and that's all they do), but what
249             you're mostly interested in its routines. By "routine" I mean a
250             subroutine that you call, whether as a procedure or as a method, and
251             that affects data structures other than the return value.
252              
253             Here I'm using "procedure" to mean a routine you call like this:
254              
255             name(parameters...);
256             # or, just maybe:
257             name;
258              
259             (In technical terms, I mean a non-method subroutine that can have side
260             effects, and which may not even provide a useful return value.) And
261             I'm using "method" to mean a routine you call like this:
262              
263             $object->name(parameters);
264              
265             So bear these terms in mind when you see routines below that act
266             like one, or the other, or both.
267              
268             =head2 MAIN ROUTINES
269              
270             These are the most important routines:
271              
272             =over
273              
274             =item new_score() or $obj = MIDI::Simple->new_score()
275              
276             As a procedure, this initializes the package's default object (Score,
277             etc.). As a method, this is a constructor, returning a new
278             MIDI::Simple object. Neither form takes any parameters.
279              
280             =cut
281              
282             =item n(...parameters...) or $obj->n(...parameters...)
283              
284             This uses the parameters given (and/or the state variables like
285             Volume, Channel, Notes, etc) to add a new note to the Score -- or
286             several notes to the Score, if Notes has more than one element in it
287             -- or no notes at all, if Notes is empty list.
288              
289             Then it moves Time ahead as appropriate. See the section "Parameters
290             For n/r/noop", below.
291              
292             =cut
293              
294             sub n { # a note
295             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
296             ? (1, shift @_)
297 16 50 33 16 1 99 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
298 16         51 &MIDI::Simple::_parse_options($it, @_);
299 16         21 foreach my $note_val (@{$it->{"Notes"}}) {
  16         27  
300             # which should presumably not be a null list
301 16 50       56 unless($note_val =~ /^\d+$/) {
302 0         0 carp "note value \"$note_val\" from Notes is non-numeric! Skipping.";
303 0         0 next;
304             }
305 16         25 push @{$it->{"Score"}},
306             ['note',
307 16         25 int(${$it->{"Time"}}),
308 16         22 int(${$it->{"Duration"}}),
309 16         23 int(${$it->{"Channel"}}),
310             int($note_val),
311 16         22 int(${$it->{"Volume"}}),
  16         63  
312             ];
313             }
314 16         22 ${$it->{"Time"}} += ${$it->{"Duration"}};
  16         23  
  16         22  
315 16         29 return;
316             }
317             ###########################################################################
318              
319             =item r(...parameters...) or $obj->r(...parameters...)
320              
321             This is exactly like C, except it never pushes anything to Score,
322             but moves ahead Time. (In other words, there is no such thing as a
323             rest-event; it's just a item during which there are no note-events
324             playing.)
325              
326             =cut
327              
328             sub r { # a rest
329             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
330             ? (1, shift @_)
331 0 0 0 0 1 0 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
332 0         0 &MIDI::Simple::_parse_options($it, @_);
333 0         0 ${$it->{"Time"}} += ${$it->{"Duration"}};
  0         0  
  0         0  
334 0         0 return;
335             }
336             ###########################################################################
337              
338             =item noop(...parameters...) or $obj->noop(...parameters...)
339              
340             This is exactly like C and C, except it never alters Score,
341             I never changes Time. It is meant to be used for setting the
342             other state variables, i.e.: Channel, Duration, Octave, Volume, Notes.
343              
344             =cut
345              
346             sub noop { # no operation
347             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
348             ? (1, shift @_)
349 1 50 33 1 1 11 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
350 1         5 &MIDI::Simple::_parse_options($it, @_);
351 1         2 return;
352             }
353              
354             #--------------------------------------------------------------------------
355              
356             =back
357              
358             =cut
359              
360             =head2 Parameters for n/r/noop
361              
362             A parameter in an C, C, or C call is meant to change an
363             attribute (AKA state variable), namely Channel, Duration, Octave,
364             Volume, or Notes.
365              
366             Here are the kinds of parameters you can use in calls to n/r/noop:
367              
368             * A numeric B parameter. This has the form "V" followed by a
369             positive integer in the range 0 (completely inaudible?) to 127 (AS
370             LOUD AS POSSIBLE). Example: "V90" sets Volume to 90.
371              
372             * An alphanumeric B parameter. This is a key from the hash
373             C<%MIDI::Simple::Volume>. Current legal values are "ppp", "pp", "p",
374             "mp", "mezzo" (or "m"), "mf", "f", "ff", and "fff". Example: "ff"
375             sets Volume to 112. (Note that "m" isn't a good bareword, so use
376             "mezzo" instead, or just always remember to use quotes around "m".)
377              
378             * A numeric B parameter. This has the form "c" followed by a
379             positive integer 0 to 15. Example: "c2", to set Channel to 2.
380              
381             * A numeric B parameter. This has the form "d" followed by
382             a positive (presumably nonzero) integer. Example: "d48", to set
383             Duration to 48.
384              
385             * An alphabetic (or in theory, possibly alphanumeric) B
386             parameter. This is a key from the hash C<%MIDI::Simple::Length>.
387             Current legal values start with "wn", "hn", "qn", "en", "sn" for
388             whole, half, quarter, eighth, or sixteenth notes. Add "d" to the
389             beginning of any of these to get "dotted..." (e.g., "dqn" for a dotted
390             quarter note). Add "dd" to the beginning of any of that first list to
391             get "double-dotted..." (e.g., "ddqn" for a double-dotted quarter
392             note). Add "t" to the beginning of any of that first list to get
393             "triplet..." (e.g., "tsn" for a triplet sixteenth note -- i.e. a note
394             such that 3 of them add up to something as long as one eighth note).
395             You may add to the contents of C<%MIDI::Simple::Length> to support
396             whatever abbreviations you want, as long as the parser can't mistake
397             them for any other kind of n/r/noop parameter.
398              
399             * A numeric, absolute B specification. This has the form: an
400             "o" (lowercase oh), and then an integer in the range 0 to 10,
401             representing an octave 0 to 10. The Octave attribute is used only in
402             resolving relative note specifications, as explained further below in
403             this section. (All absolute note specifications also set Octave to
404             whatever octave they occur in.)
405              
406             * A numeric, relative B specification. This has the form:
407             "o_d" ("d" for down) or "o_u" ("u" for down), and then an integer.
408             This increments, or decrements, Octave. E.g., if Octave is 6, "o_d2"
409             will decrement Octave by 2, making it 4. If this moves Octave below
410             0, it is forced to 0. Or if it moves Octave above 10, it is forced to
411             10. (For more information, see the section "Invalid or Out-of-Range
412             Parameters to n/r/noop", below.)
413              
414             * A numeric, absolute B specification. This has the form: an
415             optional "n", and then an integer in the range 0 to 127, representing
416             a note ranging from C0 to G10. The source to L has a useful
417             reference table showing the meanings of given note numbers. Examples:
418             "n60", or "60", which each add a 60 to the list Notes.
419              
420             Since this is a kind of absolute note specification, it sets Octave to
421             whatever octave the given numeric note occurs in. E.g., "n60" is
422             "C5", and therefore sets Octave to 5.
423              
424             The setting of the Notes list is a bit special, compared to how
425             setting the other attributes works. If there are any note
426             specifications in a given parameter list for n, r, or noop, then all
427             those specifications together are assigned to Notes.
428              
429             If there are no note specifications in the parameter list for n, r, or
430             noop, then Notes isn't changed. (But see the description of "rest",
431             at the end of this section.)
432              
433             So this:
434              
435             n 'mf', 'n40', 'n47', 'n50';
436              
437             sets Volume to 80, and Notes to (40, 47, 50). And it sets Octave,
438             first to 3 (since n40 is in octave 3), then to 3 again (since n47 =
439             B3), and then finally to 4 (since n50 = D4).
440              
441             Note that this is the same as:
442              
443             n 'n40', 'n47', 'n50', 'mf';
444              
445             The relative orders of parameters is B irrelevant; but see
446             the section "Order of Parameters in a Call to n/r/noop", below.
447              
448             * An alphanumeric, absolute B specification.
449              
450             These have the form: a string denoting a note within the octave (as
451             determined by C<%MIDI::Simple::Note> -- see below, in the description of
452             alphanumeric, relative note specifications), and then a number
453             denoting the octave number (in the range 0-10). Examples: "C3",
454             "As4" or "Asharp4", "Bf9" or "Bflat9".
455              
456             Since this is a kind of absolute note specification, it sets Octave to
457             whatever octave the given numeric note occurs in. E.g., "C3" sets
458             Octave to 3, "As4" sets Octave to 4, and "Bflat9" sets Octave to 9.
459              
460             This:
461              
462             n 'E3', 'B3', 'D4', 'mf';
463              
464             does the same as this example of ours from before:
465              
466             n 'n40', 'n47', 'n50', 'mf';
467              
468             * An alphanumeric, relative B specification.
469              
470             These have the form: a string denoting a note within the octave (as
471             determined by C<%MIDI::Simple::Note>), and then an optional parameter
472             "_u[number]" meaning "so many octaves up from the current octave" or
473             "_d[parameter]" meaning "so many octaves down from the current
474             octave".
475              
476             Examples: "C", "As" or "Asharp", "Bflat" or "Bf", "C_d3", "As_d1" or
477             "Asharp_d1", "Bflat_u3" or "Bf_u3".
478              
479             In resolving what actual notes these kinds of specifications denote,
480             the current value of Octave is used.
481              
482             What's a legal for the first bit (before any optional octave up/down
483             specification) comes from the keys to the hash C<%MIDI::Simple::Note>.
484             The current acceptable values are:
485              
486             C (maps to the value 0)
487             Cs or Df or Csharp or Dflat (maps to the value 1)
488             D (maps to the value 2)
489             Ds or Ef or Dsharp or Eflat (maps to the value 3)
490             E (maps to the value 4)
491             F (maps to the value 5)
492             Fs or Gf or Fsharp or Gflat (maps to the value 6)
493             G (maps to the value 7)
494             Gs or Af or Gsharp or Aflat (maps to the value 8)
495             A (maps to the value 9)
496             As or Bf or Asharp or Bflat (maps to the value 10)
497             B (maps to the value 11)
498              
499             (Note that these are based on the English names for these notes. If
500             you prefer to add values to accommodate other strings denoting notes in
501             the octave, you may do so by adding to the hash C<%MIDI::Simple::Note>
502             like so:
503              
504             use MIDI::Simple;
505             %MIDI::Simple::Note =
506             (%MIDI::Simple::Note, # keep all the old values
507             'H' => 10,
508             'Do' => 0,
509             # ...etc...
510             );
511              
512             But the values you add must not contain any characters outside the
513             range [A-Za-z\x80-\xFF]; and your new values must not look like
514             anything that could be any other kind of specification. E.g., don't
515             add "mf" or "o3" to C<%MIDI::Simple::Note>.)
516              
517             Consider that these bits of code all do the same thing:
518              
519             n 'E3', 'B3', 'D4', 'mf'; # way 1
520            
521             n 'E3', 'B', 'D_u1', 'mf'; # way 2
522            
523             n 'o3', 'E', 'B', 'D_u1', 'mf'; # way 3
524            
525             noop 'o3', 'mf'; # way 4
526             n 'E', 'B', 'D_u1';
527              
528             or even
529              
530             n 'o3', 'E', 'B', 'o4', 'D', 'mf'; # way 5!
531            
532             n 'o6', 'E_d3', 'B_d3', 'D_d2', 'mf'; # way 6!
533              
534             If a "_d[number]" would refer to a note in an octave below 0, it is
535             forced into octave 0. If a "_u[number]" would refer to a note in an
536             octave above 10, it is forced into octave 10. E.g., if Octave is 8,
537             "G_u4" would resolve to the same as "G10" (not "G12" -- as that's out
538             of range); if Octave is 2, "G_d4" would resolve to the same as "G0".
539             (For more information, see the section "Invalid or Out-of-Range
540             Parameters to n/r/noop", below.)
541              
542             * The string "C" acts as a sort of note specification -- it sets
543             Notes to empty-list. That way you can make a call to C actually
544             make a rest:
545              
546             n 'qn', 'G'; # makes a G quarter-note
547             n 'hn', 'rest'; # half-rest -- alters Notes, making it ()
548             n 'C', 'G'; # half-note chord: simultaneous C and G
549             r; # half-rest -- DOESN'T alter Notes.
550             n 'qn'; # quarter-note chord: simultaneous C and G
551             n 'rest'; # quarter-rest
552             n; # another quarter-rest
553              
554             (If you can follow the above code, then you understand.)
555              
556             A "C" that occurs in a parameter list with other note specs
557             (e.g., "n 'qn', 'A', 'rest', 'G'") has B, so don't do that.
558              
559             =head2 Order of Parameters in a Call to n/r/noop
560              
561             The order of parameters in calls to n/r/noop is not important except
562             insofar as the parameters change the Octave parameter, which may change
563             how some relative note specifications are resolved. For example:
564              
565             noop 'o4', 'mf';
566             n 'G', 'B', 'A3', 'C';
567              
568             is the same as "n 'mf', 'G4', 'B4', 'A3', 'C3'". But just move that "C" to the
569             start of the list:
570              
571             noop 'o4', 'mf';
572             n 'C', 'G', 'B', 'A3';
573              
574             and you something different, equivalent to "n 'mf', 'C4', 'G4', 'B4', 'A3'".
575              
576             But note that you can put the "mf" anywhere without changing anything.
577              
578             But B, I strongly advise putting note parameters at the
579             B of the parameter list:
580              
581             n 'mf', 'c10', 'C', 'B'; # 1. good
582             n 'C', 'B', 'mf', 'c10'; # 2. bad
583             n 'C', 'mf', 'c10', 'B'; # 3. so bad!
584              
585             3 is particularly bad because an uninformed/inattentive reader may get
586             the impression that the C may be at a different volume and on a
587             different channel than the B.
588              
589             (Incidentally, "n 'C5', 'G5'" and "n 'G5', 'C5'" are the same for most purposes,
590             since the C and the G are played at the same time, and with the same
591             parameters (channel and volume); but actually they differ in which
592             note gets put in the Score first, and therefore which gets encoded
593             first in the MIDI file -- but this makes no difference at all, unless
594             you're manipulating the note-items in Score or the MIDI events in a
595             track.)
596              
597             =head2 Invalid or Out-of-Range Parameters to n/r/noop
598              
599             If a parameter in a call to n/r/noop is uninterpretable, Perl dies
600             with an error message to that effect.
601              
602             If a parameter in a call to n/r/noop has an out-of-range value (like
603             "o12" or "c19"), Perl dies with an error message to that effect.
604              
605             As somewhat of a merciful exception to this rule, if a parameter in a
606             call to n/r/noop is a relative specification (whether like "o_d3" or
607             "o_u3", or like "G_d3" or "G_u3") which happens to resolve to an
608             out-of-range value (like "G_d3" given an Octave value of 2), then Perl
609             will B die, but instead will silently try to bring that note back
610             into range, by forcing it up to octave 0 (if it would have been
611             lower), or down into 9 or 10 (if it would have been an octave higher
612             than 10, or a note higher than G10), as appropriate.
613              
614             (This becomes strange in that, given an Octave of 8, "G_u4" is forced
615             down to G10, but "A_u4" is forced down to an A9. But that boundary
616             has to pop up someplace -- it's just unfortunate that it's in the
617             middle of octave 10.)
618              
619             =cut
620              
621             sub _parse_options { # common parser for n/r/noop options
622             # This is the guts of the whole module. Understand this and you'll
623             # understand everything.
624 17     17   41 my( $it, @args ) = @_;
625 17         21 my @new_notes = ();
626 17 50       32 print "options for _parse_options: ", map("<$_>", @args), "\n" if $Debug > 3;
627 17 50       30 croak "no target for _parse_options" unless ref $it;
628 17         26 foreach my $arg (@args) {
629 27 50       49 next unless length($arg); # sanity check
630              
631 27 50 33     225 if($arg =~ m<^d(\d+)$>s) { # numeric duration spec
    50          
    50          
    100          
    100          
    50          
    100          
    100          
    50          
    50          
    50          
632 0         0 ${$it->{"Duration"}} = $1;
  0         0  
633             } elsif($arg =~ m<^[vV](\d+)$>s) { # numeric volume spec
634 0 0       0 croak "Volume out of range: $1" if $1 > 127;
635 0         0 ${$it->{"Volume"}} = $1;
  0         0  
636             } elsif($arg eq 'rest') { # 'rest' clears the note list
637 0         0 @{$it->{"Notes"}} = ();
  0         0  
638             } elsif($arg =~ m<^c(\d+)$>s) { # channel spec
639 1 50       5 croak "Channel out of range: $1" if $1 > 15;
640 1         2 ${$it->{"Channel"}} = $1;
  1         4  
641             } elsif($arg =~ m<^o(\d+)$>s) { # absolute octave spec
642 1 50       4 croak "Octave out of range: \"$1\" in \"$arg\"" if $1 > 10;
643 1         3 ${$it->{"Octave"}} = int($1);
  1         3  
644              
645             } elsif($arg =~ m<^n?(\d+)$>s) { # numeric note spec
646             # note that the "n" is optional
647 0 0       0 croak "Note out of range: $1" if $1 > 127;
648 0         0 push @new_notes, $1;
649 0         0 ${$it->{"Octave"}} = int($1 / 12);
  0         0  
650              
651             # The more complex ones follow...
652              
653             } elsif( exists( $MIDI::Simple::Volume{$arg} )) { # volume spec
654 1         3 ${$it->{"Volume"}} = $MIDI::Simple::Volume{$arg};
  1         3  
655              
656             } elsif( exists( $MIDI::Simple::Length{$arg} )) { # length spec
657 8         15 ${$it->{"Duration"}} =
658 8         11 ${$it->{"Tempo"}} * $MIDI::Simple::Length{$arg};
  8         14  
659              
660             } elsif($arg =~ m<^o_d(\d+)$>s) { # rel (down) octave spec
661 0         0 ${$it->{"Octave"}} -= int($1);
  0         0  
662 0 0       0 ${$it->{"Octave"}} = 0 if ${$it->{"Octave"}} < 0;
  0         0  
  0         0  
663 0 0       0 ${$it->{"Octave"}} = 10 if ${$it->{"Octave"}} > 10;
  0         0  
  0         0  
664              
665             } elsif($arg =~ m<^o_u(\d+)$>s) { # rel (up) octave spec
666 0         0 ${$it->{"Octave"}} += int($1);
  0         0  
667 0 0       0 ${$it->{"Octave"}} = 0 if ${$it->{"Octave"}} < 0;
  0         0  
  0         0  
668 0 0       0 ${$it->{"Octave"}} = 10 if ${$it->{"Octave"}} > 10;
  0         0  
  0         0  
669              
670             } elsif( $arg =~ m<^([A-Za-z\x80-\xFF]+)((?:_[du])?\d+)?$>s
671             and exists( $MIDI::Simple::Note{$1})
672             )
673             {
674 16         32 my $note = $MIDI::Simple::Note{$1};
675 16         17 my $octave = ${$it->{"Octave"}};
  16         71  
676 16         28 my $o_spec = $2;
677 16 50       42 print "note<$1> => <$note> ; octave_spec<$2> Octave<$octave>\n"
678             if $Debug;
679              
680 16 100 66     51 if(! (defined($o_spec) && length($o_spec))){
    50          
    50          
    0          
681             # it's a bare note like "C" or "Bflat"
682             # noop
683             } elsif ($o_spec =~ m<^(\d+)$>s) { # absolute! (alphanumeric)
684 0         0 ${$it->{"Octave"}} = $octave = $1;
  0         0  
685 0 0       0 croak "Octave out of range: \"$1\" in \"$arg\"" if $1 > 10;
686             } elsif ($o_spec =~ m<^_d(\d+)$>s) { # relative with _dN
687 3         7 $octave -= $1;
688 3 50       7 $octave = 0 if $octave < 0;
689             } elsif ($o_spec =~ m<^_u(\d+)$>s) { # relative with _uN
690 0         0 $octave += $1;
691 0 0       0 $octave = 10 if $octave > 10;
692             } else {
693 0         0 die "Unexpected error 5176123";
694             }
695              
696 16         23 my $note_value = int($note + $octave * 12);
697              
698             # Enforce sanity...
699 16         39 while($note_value < 0) { $note_value += 12 } # bump up an octave
  0         0  
700 16         26 while($note_value > 127) { $note_value -= 12 } # drop down an octave
  0         0  
701              
702 16         30 push @new_notes, $note_value;
703             # 12 = number of MIDI notes in an octive
704              
705             } else {
706 0 0       0 croak "Unknown note/rest option: \"$arg\"" if length($arg);
707             }
708             }
709 17 100       33 @{$it->{"Notes"}} = @new_notes if @new_notes; # otherwise inherit last list
  16         30  
710              
711 17         30 return;
712             }
713              
714             # Internal-use proc: create a package object for the package named.
715             sub _package_object {
716 1   50 1   5 my $package = $_[0] || die "no package!!!";
717 2     2   3105 no strict;
  2         3  
  2         9455  
718 1 50       3 print "Linking to package $package\n" if $Debug;
719             $package{$package} = bless {
720             # note that these are all refs, not values
721 1         5 "Score" => \@{"$package\::Score"},
722 1         5 "Time" => \${"$package\::Time"},
723 1         3 "Duration" => \${"$package\::Duration"},
724 1         3 "Channel" => \${"$package\::Channel"},
725 1         3 "Octave" => \${"$package\::Octave"},
726 1         3 "Tempo" => \${"$package\::Tempo"},
727 1         4 "Notes" => \@{"$package\::Notes"},
728 1         3 "Volume" => \${"$package\::Volume"},
729 1         2 "Cookies" => \%{"$package\::Cookies"},
  1         8  
730             };
731              
732 1         5 &_init_score($package{$package});
733 1         4 return $package{$package};
734             }
735              
736             ###########################################################################
737              
738             sub new_score {
739 1     1 1 137 my $p1 = $_[0];
740 1         2 my $it;
741              
742 1 50 0     6 if(
      33        
743             defined($p1) &&
744             ($p1 eq 'MIDI::Simple' or ref($p1) eq 'MIDI::Simple')
745             ) { # I'm a method!
746 0 0       0 print "~ new_score as a MIDI::Simple constructor\n" if $Debug;
747 0         0 $it = bless {};
748 0         0 &_init_score($it);
749             } else { # I'm a proc!
750 1         5 my $cpackage = (caller)[0];
751 1 50       4 print "~ new_score as a proc for package $cpackage\n" if $Debug;
752 1 50       3 if( ref($package{ $cpackage }) ) { # Already exists in %package
753 0 0       0 print "~ reinitting pobj $cpackage\n" if $Debug;
754 0         0 &_init_score( $it = $package{ $cpackage } );
755             # no need to call _package_object
756             } else { # Doesn't exist in %package
757 1 50       4 print "~ new pobj $cpackage\n" if $Debug;
758 1         4 $package{ $cpackage } = $it = &_package_object( $cpackage );
759             # no need to call _init_score
760             }
761             }
762 1         3 return $it; # for object use, we'll be capturing this
763             }
764              
765             sub _init_score { # Set some default initial values for the object
766 1     1   2 my $it = $_[0];
767 1 50       3 print "Initting score $it\n" if $Debug;
768 1         38 @{$it->{"Score"}} = (['text_event', 0, "$0 at " . scalar(localtime) ]);
  1         10  
769 1         2 ${$it->{"Time"}} = 0;
  1         3  
770 1         2 ${$it->{"Duration"}} = 96; # a whole note
  1         3  
771 1         1 ${$it->{"Channel"}} = 0;
  1         11  
772 1         2 ${$it->{"Octave"}} = 5;
  1         2  
773 1         2 ${$it->{"Tempo"}} = 96; # ticks per qn
  1         2  
774 1         3 @{$it->{"Notes"}} = (60); # middle C. why not.
  1         2  
775 1         1 ${$it->{"Volume"}} = 64; # normal
  1         2  
776 1         2 %{$it->{"Cookies"}} = (); # empty
  1         2  
777 1         2 return;
778             }
779              
780             ###########################################################################
781             ###########################################################################
782              
783             =head2 ATTRIBUTE METHODS
784              
785             The object attributes discussed above are readable and writeable with
786             object methods. For each attribute there is a read/write method, and a
787             read-only method that returns a reference to the attribute's value:
788              
789             Attribute || R/W-Method || RO-R-Method
790             ----------++-------------++--------------------------------------
791             Score || Score || Score_r (returns a listref)
792             Notes || Notes || Notes_r (returns a listref)
793             Time || Time || Time_r (returns a scalar ref)
794             Duration || Duration || Duration_r (returns a scalar ref)
795             Channel || Channel || Channel_r (returns a scalar ref)
796             Octave || Octave || Octave_r (returns a scalar ref)
797             Volume || Volume || Volume_r (returns a scalar ref)
798             Tempo || Tempo || Tempo_r (returns a scalar ref)
799             Cookies || Cookies || Cookies_r (returns a hashref)
800              
801             To read any of the above via a R/W-method, call with no parameters,
802             e.g.:
803              
804             $notes = $obj->Notes; # same as $obj->Notes()
805              
806             The above is the read-attribute ("get") form.
807              
808             To set the value, call with parameters:
809              
810             $obj->Notes(13,17,22);
811              
812             The above is the write-attribute ("put") form. Incidentally, when
813             used in write-attribute form, the return value is the same as the
814             parameters, except for Score or Cookies. (In those two cases, I've
815             suppressed it for efficiency's sake.)
816              
817             Alternately (and much more efficiently), you can use the read-only
818             reference methods to read or alter the above values;
819              
820             $notes_r = $obj->Notes_r;
821             # to read:
822             @old_notes = @$notes_r;
823             # to write:
824             @$notes_r = (13,17,22);
825              
826             And this is the only way to set Cookies, Notes, or Score to a (),
827             like so:
828              
829             $notes_r = $obj->Notes_r;
830             @$notes_r = ();
831              
832             Since this:
833              
834             $obj->Notes;
835              
836             is just the read-format call, remember?
837              
838             Like all methods in this class, all the above-named attribute methods
839             double as procedures that act on the default object -- in other words,
840             you can say:
841              
842             Volume 10; # same as: $Volume = 10;
843             @score_copy = Score; # same as: @score_copy = @Score
844             Score @new_score; # same as: @Score = @new_score;
845             $score_ref = Score_r; # same as: $score_ref = \@Score
846             Volume(Volume + 10) # same as: $Volume += 10
847              
848             But, stylistically, I suggest not using these procedures -- just
849             directly access the variables instead.
850              
851             =cut
852              
853             #--------------------------------------------------------------------------
854             # read-or-write methods
855              
856             sub Score (;\@) { # yes, a prototype!
857             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
858             ? (1, shift @_)
859 0 0 0 0 1 0 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
860 0 0       0 if(@_) {
861 0 0       0 if($am_method){
862 0         0 @{$it->{'Score'}} = @_;
  0         0  
863             } else {
864 0         0 @{$it->{'Score'}} = @{$_[0]}; # sneaky, huh!
  0         0  
  0         0  
865             }
866 0         0 return; # special case -- return nothing if this is a PUT
867             } else {
868 0         0 return @{$it->{'Score'}}; # you asked for it
  0         0  
869             }
870             }
871              
872             sub Cookies {
873             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
874 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
875 0 0       0 %{$it->{'Cookies'}} = @_ if @_; # Better have an even number of elements!
  0         0  
876 0         0 return %{$it->{'Cookies'}};
  0         0  
877             }
878              
879             sub Time {
880             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
881 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
882 0 0       0 ${$it->{'Time'}} = $_[0] if @_;
  0         0  
883 0         0 return ${$it->{'Time'}};
  0         0  
884             }
885              
886             sub Duration {
887             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
888 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
889 0 0       0 ${$it->{'Duration'}} = $_[0] if @_;
  0         0  
890 0         0 return ${$it->{'Duration'}};
  0         0  
891             }
892              
893             sub Channel {
894             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
895 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
896 0 0       0 ${$it->{'Channel'}} = $_[0] if @_;
  0         0  
897 0         0 return ${$it->{'Channel'}};
  0         0  
898             }
899              
900             sub Octave {
901             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
902 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
903 0 0       0 ${$it->{'Octave'}} = $_[0] if @_;
  0         0  
904 0         0 return ${$it->{'Octave'}};
  0         0  
905             }
906              
907             sub Tempo {
908             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
909 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
910 0 0       0 ${$it->{'Tempo'}} = $_[0] if @_;
  0         0  
911 0         0 return ${$it->{'Tempo'}};
  0         0  
912             }
913              
914             sub Notes {
915             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
916 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
917 0 0       0 @{$it->{'Notes'}} = @_ if @_;
  0         0  
918 0         0 return @{$it->{'Notes'}};
  0         0  
919             }
920              
921             sub Volume {
922             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
923 0 0 0 0 1 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
924 0 0       0 ${$it->{'Volume'}} = $_[0] if @_;
  0         0  
925 0         0 return ${$it->{'Volume'}};
  0         0  
926             }
927              
928             #-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-##-#-#-#-#-#-#-#-
929             # read-only methods that return references
930              
931             sub Score_r {
932             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
933 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
934 0         0 return $it->{'Score'};
935             }
936              
937             sub Time_r {
938             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
939 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
940 0         0 return $it->{'Time'};
941             }
942              
943             sub Duration_r {
944             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
945 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
946 0         0 return $it->{'Duration'};
947             }
948              
949             sub Channel_r {
950             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
951 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
952 0         0 return $it->{'Channel'};
953             }
954              
955             sub Octave_r {
956             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
957 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
958 0         0 return $it->{'Octave'};
959             }
960              
961             sub Tempo_r {
962             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
963 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
964 0         0 return $it->{'Tempo'};
965             }
966              
967             sub Notes_r {
968             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
969 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
970 0         0 return $it->{'Notes'};
971             }
972              
973             sub Volume_r {
974             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
975 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
976 0         0 return $it->{'Volume'};
977             }
978              
979             sub Cookies_r {
980             my($it) = (ref($_[0]) eq "MIDI::Simple") ? (shift @_)
981 0 0 0 0 0 0 : ($package{ (caller)[0] } ||= &_package_object( (caller)[0] ));
982 0         0 return $it->{'Cookies'};
983             }
984              
985             ###########################################################################
986             ###########################################################################
987              
988             =head2 MIDI EVENT ROUTINES
989              
990             These routines, below, add a MIDI event to the Score, with a
991             start-time of Time. Example:
992              
993             text_event "And now the bongos!"; # procedure use
994            
995             $obj->text_event "And now the bongos!"; # method use
996              
997             These are named after the MIDI events they add to the score, so see
998             L for an explanation of what the data types (like
999             "velocity" or "pitch_wheel") mean. I've reordered this list so that
1000             what I guess are the most important ones are toward the top:
1001              
1002              
1003             =over
1004              
1005             =item patch_change I, I;
1006              
1007             =item key_after_touch I, I, I;
1008              
1009             =item channel_after_touch I, I;
1010              
1011             =item control_change I, I, I;
1012              
1013             =item pitch_wheel_change I, I;
1014              
1015             =item set_tempo I; (See the section on tempo, below.)
1016              
1017             =item smpte_offset I
, I, I, I, I;
1018              
1019             =item time_signature I, I
, I, I;
1020              
1021             =item key_signature I, I;
1022              
1023             =item text_event I;
1024              
1025             =item copyright_text_event I;
1026              
1027             =item track_name I;
1028              
1029             =item instrument_name I;
1030              
1031             =item lyric I;
1032              
1033             =item set_sequence_number I;
1034              
1035             =item marker I;
1036              
1037             =item cue_point I;
1038              
1039             =item sequencer_specific I;
1040              
1041             =item sysex_f0 I;
1042              
1043             =item sysex_f7 I;
1044              
1045             =back
1046              
1047              
1048             And here's the ones I'll be surprised if anyone ever uses:
1049              
1050             =over
1051              
1052             =item text_event_08 I;
1053              
1054             =item text_event_09 I;
1055              
1056             =item text_event_0a I;
1057              
1058             =item text_event_0b I;
1059              
1060             =item text_event_0c I;
1061              
1062             =item text_event_0d I;
1063              
1064             =item text_event_0e I;
1065              
1066             =item text_event_0f I;
1067              
1068             =item raw_meta_event I(0-255), I;
1069              
1070             =item song_position I;
1071              
1072             =item song_select I;
1073              
1074             =item tune_request I;
1075              
1076             =item raw_data I;
1077              
1078             =item end_track I;
1079              
1080             =item note I, I, I, I;
1081              
1082             =back
1083              
1084             =cut
1085              
1086 0     0 1 0 sub key_after_touch ($$$) { &_common_push('key_after_touch', @_) }
1087 0     0 1 0 sub control_change ($$$) { &_common_push('control_change', @_) }
1088 1     1 1 7 sub patch_change ($$) { &_common_push('patch_change', @_) }
1089 0     0 1 0 sub channel_after_touch ($$) { &_common_push('channel_after_touch', @_) }
1090 0     0 1 0 sub pitch_wheel_change ($$) { &_common_push('pitch_wheel_change', @_) }
1091 0     0 1 0 sub set_sequence_number ($) { &_common_push('set_sequence_number', @_) }
1092 1     1 1 36 sub text_event ($) { &_common_push('text_event', @_) }
1093 0     0 1 0 sub copyright_text_event ($) { &_common_push('copyright_text_event', @_) }
1094 0     0 1 0 sub track_name ($) { &_common_push('track_name', @_) }
1095 0     0 1 0 sub instrument_name ($) { &_common_push('instrument_name', @_) }
1096 0     0 1 0 sub lyric ($) { &_common_push('lyric', @_) }
1097 0     0 1 0 sub marker ($) { &_common_push('marker', @_) }
1098 0     0 1 0 sub cue_point ($) { &_common_push('cue_point', @_) }
1099 0     0 1 0 sub text_event_08 ($) { &_common_push('text_event_08', @_) }
1100 0     0 1 0 sub text_event_09 ($) { &_common_push('text_event_09', @_) }
1101 0     0 1 0 sub text_event_0a ($) { &_common_push('text_event_0a', @_) }
1102 0     0 1 0 sub text_event_0b ($) { &_common_push('text_event_0b', @_) }
1103 0     0 1 0 sub text_event_0c ($) { &_common_push('text_event_0c', @_) }
1104 0     0 1 0 sub text_event_0d ($) { &_common_push('text_event_0d', @_) }
1105 0     0 1 0 sub text_event_0e ($) { &_common_push('text_event_0e', @_) }
1106 0     0 1 0 sub text_event_0f ($) { &_common_push('text_event_0f', @_) }
1107 0     0 1 0 sub end_track ($) { &_common_push('end_track', @_) }
1108 1     1 1 6 sub set_tempo ($) { &_common_push('set_tempo', @_) }
1109 0     0 1 0 sub smpte_offset ($$$$$) { &_common_push('smpte_offset', @_) }
1110 0     0 1 0 sub time_signature ($$$$) { &_common_push('time_signature', @_) }
1111 0     0 1 0 sub key_signature ($$) { &_common_push('key_signature', @_) }
1112 0     0 1 0 sub sequencer_specific ($) { &_common_push('sequencer_specific', @_) }
1113 0     0 1 0 sub raw_meta_event ($$) { &_common_push('raw_meta_event', @_) }
1114 0     0 1 0 sub sysex_f0 ($) { &_common_push('sysex_f0', @_) }
1115 0     0 1 0 sub sysex_f7 ($) { &_common_push('sysex_f7', @_) }
1116 0     0 1 0 sub song_position () { &_common_push('song_position', @_) }
1117 0     0 1 0 sub song_select ($) { &_common_push('song_select', @_) }
1118 0     0 1 0 sub tune_request () { &_common_push('tune_request', @_) }
1119 0     0 1 0 sub raw_data ($) { &_common_push('raw_data', @_) }
1120              
1121             sub _common_push {
1122             # I'm your doctor when you need / Have some coke
1123             # / Want some weed / I'm Your Pusher Man
1124             #print "*", map("<$_>", @_), "\n";
1125 3     3   8 my(@p) = @_;
1126 3         4 my $event = shift @p;
1127 3         6 my $it;
1128 3 50       7 if(ref($p[0]) eq "MIDI::Simple") {
1129 0         0 $it = shift @p;
1130             } else {
1131 3   33     18 $it = ($package{ (caller(1))[0] } ||= &_package_object( (caller(1))[0] ) );
1132             }
1133             #print "**", map("<$_>", @p), " from ", ()[0], "\n";
1134              
1135             #printf "Pushee to %s 's %s: e<%s>, t<%s>, p<%s>\n",
1136             # $it, $it->{'Score'}, $event, ${$it->{'Time'}}, join("~", @p);
1137 3         7 push @{$it->{'Score'}},
1138 3         6 [ $event, ${$it->{'Time'}}, @p ];
  3         6  
1139 3         7 return;
1140             }
1141              
1142             =head2 About Tempo
1143              
1144             The chart above shows that tempo is set with a method/procedure that
1145             takes the form set_tempo(I), and L says that
1146             I is "microseconds, a value 0 to 16,777,215 (0x00FFFFFF)".
1147             But at the same time, you see that there's an attribute of the
1148             MIDI::Simple object called "Tempo", which I've warned you to leave at
1149             the default value of 96. So you may wonder what the deal is.
1150              
1151             The "Tempo" attribute (AKA "Divisions") is an integer that specifies
1152             the number of "ticks" per MIDI quarter note. Ticks is just the
1153             notional timing unit all MIDI events are expressed in terms of.
1154             Calling it "Tempo" is misleading, really; what you want to change to
1155             make your music go faster or slower isn't that parameter, but instead
1156             the mapping of ticks to actual time -- and that is what C
1157             does. Its one parameter is the number of microseconds each quarter
1158             note should get.
1159              
1160             Suppose you wanted a tempo of 120 quarter notes per minute. In terms
1161             of microseconds per quarter note:
1162              
1163             set_tempo 500_000; # you can use _ like a thousands-separator comma
1164              
1165             In other words, this says to make each quarter note take up 500,000
1166             microseconds, namely .5 seconds. And there's 120 of those
1167             half-seconds to the minute; so, 120 quarter notes to the minute.
1168              
1169             If you see a "[quarter note symbol] = 160" in a piece of sheet music,
1170             and you want to figure out what number you need for the C,
1171             do:
1172              
1173             60_000_000 / 160 ... and you get: 375_000
1174              
1175             Therefore, you should call:
1176              
1177             set_tempo 375_000;
1178              
1179             So in other words, this general formula:
1180              
1181             set_tempo int(60_000_000 / $quarter_notes_per_minute);
1182              
1183             should do you fine.
1184              
1185             As to the Tempo/Duration parameter, leave it alone and just assume
1186             that 96 ticks-per-quarter-note is a universal constant, and you'll be
1187             happy.
1188              
1189             (You may wonder: Why 96? As far as I've worked out, all permutations
1190             of the normal note lengths (whole, half, quarter, eighth, sixteenth,
1191             and even thirty-second notes) and tripletting, dotting, or
1192             double-dotting, times 96, all produce integers. For example, if a
1193             quarter note is 96 ticks, then a double-dotted thirty-second note is
1194             21 ticks (i.e., 1.75 * 1/8 * 96). But that'd be a messy 10.5 if there
1195             were only 48 ticks to a quarter note. Now, if you wanted a quintuplet
1196             anywhere, you'd be out of luck, since 96 isn't a factor of five. It's
1197             actually 3 * (2 ** 5), i.e., three times two to the fifth. If you
1198             really need quintuplets, then you have my very special permission to
1199             mess with the Tempo attribute -- I suggest multiples of 96, e.g., 5 *
1200             96.)
1201              
1202             (You may also have read in L that C
1203             allows you to define an arbitrary mapping of your concept of quarter
1204             note, to MIDI's concept of quarter note. For your sanity and mine,
1205             leave them the same, at a 1:1 mapping -- i.e., with an '8' for
1206             C's last parameter, for "eight notated 32nd-notes per
1207             MIDI quarter note". And this is relevant only if you're calling
1208             C anyway, which is not necessarily a given.)
1209              
1210             =cut
1211              
1212             ###########################################################################
1213             ###########################################################################
1214              
1215             =head2 MORE ROUTINES
1216              
1217             =over
1218              
1219             =cut
1220              
1221             sub _test_proc {
1222             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1223             ? (1, shift @_)
1224 0 0 0 0   0 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1225 0         0 print " am method: $am_method\n it: $it\n params: <", join(',',@_), ">\n";
1226             }
1227              
1228             ###########################################################################
1229              
1230             =item $opus = write_score I
1231              
1232             =item $opus = $obj->write_score(I)
1233              
1234             Writes the score to the filespec (e.g, "../../samples/funk2.midi", or
1235             a variable containing that value), with the score's Ticks as its tick
1236             parameters (AKA "divisions"). Among other things, this function calls
1237             the function C, below, and if you capture the output of
1238             write_score, you'll get the opus created, if you want it for anything.
1239             (Also: you can also use a filehandle-reference instead of the
1240             filespec: C.)
1241              
1242             =cut
1243              
1244             sub write_score {
1245             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1246             ? (1, shift @_)
1247 1 50 33 1 1 15 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1248             my($out, $ticks, $score_r) =
1249 1   50     4 ( $_[0], (${$it->{'Tempo'}} || 96), $it->{'Score'} );
1250              
1251 1 50 33     7 croak "First parameter to MIDI::Simple::write_score can't be null\n"
1252             unless( ref($out) || length($out) );
1253 1 50       3 croak "Ticks can't be 0" unless $ticks;
1254              
1255 1 50       4 carp "Writing a score with no notes!" unless @$score_r;
1256 1         6 my $opus = $it->make_opus;
1257             # $opus->dump( { 'dump_tracks' => 1 } );
1258              
1259 1 50       11 if(ref($out)) {
1260 0         0 $opus->write_to_handle($out);
1261             } else {
1262 1         11 $opus->write_to_file($out);
1263             }
1264 1         17 return $opus; # capture it if you want it.
1265             }
1266              
1267             ###########################################################################
1268              
1269             =item read_score I
1270              
1271             =item $obj = MIDI::Simple->read_score('foo.mid'))
1272              
1273             In the first case (a procedure call), does C to erase and
1274             initialize the object attributes (Score, Octave, etc), then reads from
1275             the file named. The file named has to be a MIDI file with exactly one
1276             eventful track, or Perl dies. And in the second case, C
1277             acts as a constructor method, returning a new object read from the
1278             file.
1279              
1280             Score, Ticks, and Time are all affected:
1281              
1282             Score is the event form of all the MIDI events in the MIDI file.
1283             (Note: I deformed MIDI files may confuse the routine that
1284             turns MIDI events into a Score.)
1285              
1286             Ticks is set from the ticks setting (AKA "divisions") of the file.
1287              
1288             Time is set to the end time of the latest event in the file.
1289              
1290             (Also: you can also use a filehandle-reference instead of the
1291             filespec: C.)
1292              
1293             If ever you have to make a Score out of a single track from a
1294             I file, read the file into an $opus, and then consider
1295             something like:
1296              
1297             new_score;
1298             $opus = MIDI::Opus->new({ 'from_file' => "foo2.mid" });
1299             $track = ($opus->tracks)[2]; # get the third track
1300            
1301             ($score_r, $end_time) =
1302             MIDI::Score::events_r_to_score_r($track->events_r);
1303              
1304             $Ticks = $opus->ticks;
1305             @Score = @$score_r;
1306             $Time = $end_time;
1307              
1308             =cut
1309              
1310             sub read_score {
1311 0     0 1 0 my $am_cons = ($_[0] eq "MIDI::Simple");
1312 0 0       0 shift @_ if $am_cons;
1313              
1314 0         0 my $in = $_[0];
1315              
1316 0         0 my($track, @eventful_tracks);
1317 0 0 0     0 croak "First parameter to MIDI::Simple::read_score can't be null\n"
1318             unless( ref($in) || length($in) );
1319              
1320 0 0       0 my $in_switch = ref($in) ? 'from_handle' : 'from_file';
1321 0         0 my $opus = MIDI::Opus->new({ $in_switch => $in });
1322              
1323 0         0 @eventful_tracks = grep( scalar(@{$_->events_r}), $opus->tracks );
  0         0  
1324 0 0       0 if(@eventful_tracks == 0) {
    0          
1325 0         0 croak "Opus from $in has NO eventful tracks to consider as a score!\n";
1326             } elsif (@eventful_tracks > 1) {
1327 0         0 croak
1328             "Opus from $in has too many (" .
1329             scalar(@eventful_tracks) . ") tracks to be a score.\n";
1330             } # else OK...
1331 0         0 $track = $eventful_tracks[0];
1332             #print scalar($track->events), " events in track\n";
1333              
1334             # If ever you want just a single track as a score, here's how:
1335             #my $score_r = ( MIDI::Score::events_r_to_score_r($track->events_r) )[0];
1336 0         0 my( $score_r, $time) = MIDI::Score::events_r_to_score_r($track->events_r);
1337             #print scalar(@$score_r), " notes in score\n";
1338              
1339 0         0 my $it;
1340 0 0       0 if($am_cons) { # just make a new object and return it.
1341 0         0 $it = MIDI::Simple->new_score;
1342 0         0 $it->{'Score'} = $score_r;
1343             } else { # need to fudge it back into the pobj
1344 0         0 my $cpackage = (caller)[0];
1345             #print "~ read_score as a proc for package $cpackage\n";
1346 0 0       0 if( ref($package{ $cpackage }) ) { # Already exists in %package
1347 0 0       0 print "~ reinitting pobj $cpackage\n" if $Debug;
1348 0         0 &_init_score( $it = $package{ $cpackage } );
1349             # no need to call _package_object
1350             } else { # Doesn't exist in %package
1351 0 0       0 print "~ new pobj $cpackage\n" if $Debug;
1352 0         0 $package{ $cpackage } = $it = &_package_object( $cpackage );
1353             # no need to call _init_score
1354             }
1355 0         0 @{$it->{'Score'}} = @$score_r;
  0         0  
1356             }
1357 0         0 ${$it->{'Tempo'}} = $opus->ticks;
  0         0  
1358 0         0 ${$it->{'Time'}} = $time;
  0         0  
1359              
1360 0         0 return $it;
1361             }
1362             ###########################################################################
1363              
1364             =item synch( LIST of coderefs )
1365              
1366             =item $obj->synch( LIST of coderefs )
1367              
1368             LIST is a list of coderefs (whether as a series of anonymous subs, or
1369             as a list of items like C<(\&foo, \&bar, \&baz)>, or a mixture of
1370             both) that C calls in order to add to the given object -- which
1371             in the first form is the package's default object, and which in the
1372             second case is C<$obj>. What C does is:
1373              
1374             * remember the initial value of Time, before calling any of the
1375             routines;
1376              
1377             * for each routine given, reset Time to what it was initially, call
1378             the routine, and then note what the value of Time is, after each call;
1379              
1380             * then, after having called all of the routines, set Time to whatever
1381             was the greatest (equals latest) value of Time that resulted from any
1382             of the calls to the routines.
1383              
1384             The coderefs are all called with one argument in C<@_> -- the object
1385             they are supposed to affect. All these routines should/must therefore
1386             use method calls instead of procedure calls. Here's an example usage
1387             of synch:
1388              
1389             my $measure = 0;
1390             my @phrases =(
1391             [ 'Cs', 'F', 'Ds', 'Gs_d1' ], ['Cs', 'Ds', 'F', 'Cs'],
1392             [ 'F', 'Cs', 'Ds', 'Gs_d1' ], ['Gs_d1', 'Ds', 'F', 'Cs']
1393             );
1394            
1395             for(1 .. 20) { synch(\&count, \&lalala); }
1396            
1397             sub count {
1398             my $it = $_[0];
1399             $it->r('wn'); # whole rest
1400             # not just "r('wn')" -- we want a method, not a procedure!
1401             ++$measure;
1402             }
1403            
1404             sub lalala {
1405             my $it = $_[0];
1406             $it->noop('c1','mf','o3','qn'); # setup
1407             my $phrase_number = ($measure + -1) % 4;
1408             my @phrase = @{$phrases[$phrase_number]};
1409             foreach my $note (@phrase) { $it->n($note); }
1410             }
1411              
1412             =cut
1413              
1414             sub synch {
1415             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1416             ? (1, shift @_)
1417 0 0 0 0 1 0 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1418              
1419 0         0 my @subs = grep(ref($_) eq 'CODE', @_);
1420              
1421 0 0       0 print " My subs: ", map("<$_> ", @subs), ".\n"
1422             if $Debug;
1423 0 0       0 return unless @subs;
1424             # my @end_times = (); # I am the Lone Array of the Apocalypse!
1425 0         0 my $orig_time = ${$it->{'Time'}};
  0         0  
1426 0         0 my $max_time = $orig_time;
1427 0         0 foreach my $sub (@subs) {
1428             printf " Before %s\: Entry time: %s Score items: %s\n",
1429 0 0       0 $sub, $orig_time, scalar(@{$it->{'Score'}}) if $Debug;
  0         0  
1430 0         0 ${$it->{'Time'}} = $orig_time; # reset Time
  0         0  
1431              
1432 0         0 &{$sub}($it); # now call it
  0         0  
1433              
1434             printf " %s items ending at %s\n",
1435 0 0       0 scalar( @{$it->{'Score'}} ), ${$it->{'Time'}} if $Debug;
  0         0  
  0         0  
1436 0 0       0 $max_time = ${$it->{'Time'}} if ${$it->{'Time'}} > $max_time;
  0         0  
  0         0  
1437             }
1438 0 0       0 print " max end-time of subs: $max_time\n" if $Debug;
1439              
1440             # now update and get out
1441 0         0 ${$it->{'Time'}} = $max_time;
  0         0  
1442             }
1443              
1444             ###########################################################################
1445              
1446             =item $opus = make_opus or $opus = $obj->make_opus
1447              
1448             Makes an opus (a MIDI::Opus object) out of Score, setting the opus's
1449             tick parameter (AKA "divisions") to $ticks. The opus is,
1450             incidentally, format 0, with one track.
1451              
1452             =cut
1453              
1454             sub make_opus {
1455             # Make a format-0 one-track MIDI out of this score.
1456              
1457             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1458             ? (1, shift @_)
1459 1 50 0 1 1 6 : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1460              
1461 1         2 my($ticks, $score_r) = (${$it->{'Tempo'}}, $it->{'Score'});
  1         3  
1462 1 50       9 carp "Encoding a score with no notes!" unless @$score_r;
1463 1         28 my $events_r = ( MIDI::Score::score_r_to_events_r($score_r) )[0];
1464 1 50       4 carp "Creating a track with no events!" unless @$events_r;
1465              
1466 1         11 my $opus =
1467             MIDI::Opus->new({ 'ticks' => $ticks,
1468             'format' => 0,
1469             'tracks' => [ MIDI::Track->new({
1470             'events' => $events_r
1471             }) ]
1472             });
1473 1         4 return $opus;
1474             }
1475              
1476             ###########################################################################
1477              
1478             =item dump_score or $obj->dump_score
1479              
1480             Dumps Score's contents, via C (so you can C an output
1481             handle for it). Currently this is in this somewhat uninspiring format:
1482              
1483             ['note', 0, 96, 1, 25, 96],
1484             ['note', 96, 96, 1, 29, 96],
1485              
1486             as it is (currently) just a call to C<&MIDI::Score::dump_score>; but in
1487             the future I may (should?) make it output in C/C notation. In
1488             the meantime I assume you'll use this, if at all, only for debugging
1489             purposes.
1490              
1491             =cut
1492              
1493             sub dump_score {
1494             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1495             ? (1, shift @_)
1496 0 0 0 0 1   : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1497 0           return &MIDI::Score::dump_score( $it->{'Score'} );
1498             }
1499              
1500             ###########################################################################
1501             ###########################################################################
1502              
1503             =back
1504              
1505             =head2 FUNCTIONS
1506              
1507             These are subroutines that aren't methods and don't affect anything
1508             (i.e., don't have "side effects") -- they just take input and/or give
1509             output.
1510              
1511             =over
1512              
1513             =item interval LISTREF, LIST
1514              
1515             This takes a reference to a list of integers, and a list of note-pitch
1516             specifications (whether relative or absolute), and returns a list
1517             consisting of the given note specifications transposed by that many
1518             half-steps. E.g.,
1519              
1520             @majors = interval [0,4,7], 'C', 'Bflat3';
1521              
1522             which returns the list C<(C,E,G,Bf3,D4,F4)>.
1523              
1524             Items in LIST which aren't note specifications are passed thru
1525             unaltered.
1526              
1527             =cut
1528              
1529             sub interval { # apply an interval to a list of notes.
1530 0     0 1   my(@out);
1531             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1532             ? (1, shift @_)
1533 0 0 0       : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1534 0           my($interval_r, @notes) = @_;
1535              
1536 0 0         croak "first argument to &MIDI::Simple::interval must be a listref\n"
1537             unless ref($interval_r);
1538             # or a valid key into a hash %Interval?
1539              
1540 0           foreach my $note (@notes) {
1541 0           my(@them, @status, $a_flag, $note_number);
1542 0           @status = &is_note_spec($note);
1543 0 0         unless(@status) { # not a note spec
1544 0           push @out, $note;
1545             }
1546              
1547 0           ($a_flag, $note_number) = @status;
1548 0           @them = map { $note_number + $_ } @$interval_r;
  0            
1549              
1550 0 0         if($a_flag) { # If based on an absolute note spec.
1551 0 0         if($note =~ m<^\d+$>s) { # "12"
    0          
1552             # no-op -- leave as is
1553             } elsif ($note =~ m<^n\d+$>s) { # "n12"
1554 0           @them = map("n$_", @them);
1555             } else { # "C4"
1556 0           @them = map(&number_to_absolute($_), @them);
1557             }
1558             } else { # If based on a relative note spec.
1559 0           @them = map(&number_to_relative($_), @them);
1560             }
1561 0           push @out, @them;
1562             }
1563 0           return @out;
1564             }
1565             #--------------------------------------------------------------------------
1566              
1567             =item note_map { BLOCK } LIST
1568              
1569             This is pretty much based on (or at least inspired by) the normal Perl
1570             C function, altho the syntax is a bit more restrictive (i.e.,
1571             C can take the form C or C --
1572             the latter won't work with C).
1573              
1574             C evaluates the BLOCK for each element of
1575             LIST (locally setting $_ to each element's note-number value) and
1576             returns the list value composed of the results of each such
1577             evaluation. Evaluates BLOCK in a list context, so each element of
1578             LIST may produce zero, one, or more elements in the returned value.
1579             Moreover, besides setting $_, C feeds BLOCK (which it sees
1580             as an anonymous subroutine) three parameters, which BLOCK can access
1581             in @_ :
1582              
1583             $_[0] : Same as $_. I.e., The current note-specification,
1584             as a note number.
1585             This is the result of having fed the original note spec
1586             (which you can see in $_[2]) to is_note_spec.
1587              
1588             $_[1] : The absoluteness flag for this note, from the
1589             above-mentioned call to is_note_spec.
1590             0 = it was relative (like 'C')
1591             1 = it was absolute (whether as 'C4' or 'n41' or '41')
1592              
1593             $_[2] : the actual note specification from LIST, if you want
1594             to access it for any reason.
1595              
1596             Incidentally, any items in LIST that aren't a note specification are
1597             passed thru unchanged -- BLOCK isn't called on it.
1598              
1599             So, in other words, what C does, for each item in LIST, is:
1600              
1601             * It calls C on it to test whether it's a note
1602             specification at all. If it isn't, just passes it thru. If it is,
1603             then C stores the note number and the absoluteness flag that
1604             C returned, and...
1605              
1606             * It calls BLOCK, providing the note number in $_ and $_[0], the
1607             absoluteness flag in $_[1], and the original note specification in
1608             $_[2]. Stores the return value of calling BLOCK (in a list context of
1609             course) -- this should be a list of note numbers.
1610              
1611             * For each element of the return value (which is actually free to be
1612             an empty list), converts it from a note number to whatever B of
1613             specification the original note value was. So, for each element, if
1614             the original was relative, C interprets the return value as
1615             a relative note number, and calls C on it; if it
1616             was absolute, C will try to restore it to the
1617             correspondingly formatted absolute specification type.
1618              
1619             An example is, I hope, helpful:
1620              
1621             This:
1622              
1623             note_map { $_ - 3, $_ + 2 } qw(Cs3 n42 50 Bf)
1624              
1625             returns this:
1626              
1627             ('Bf2', 'Ef3', 'n39', 'n44', '47', '52', 'G', 'C_u1')
1628              
1629             Or, to line things up:
1630              
1631             Cs3 n42 50 Bf
1632             | | | |
1633             /-----\ /-----\ /---\ /----\
1634             Bf2 Ef3 n39 n44 47 52 G C_u1
1635              
1636             Now, of course, this is the same as what this:
1637              
1638             interval [-3, 2], qw(Cs3 n42 50 Bf)
1639              
1640             returns. This is fitting, as C, internally, is basically a
1641             simplified version of C. But C only lets you do
1642             unconditional transposition, whereas C lets you do anything
1643             at all. For example:
1644              
1645             @note_specs = note_map { $funky_lookup_table{$_} }
1646             'C', 'Gf';
1647              
1648             or
1649              
1650             @note_specs = note_map { $_ + int(rand(2)) }
1651             @stuff;
1652              
1653             C, like C, can seem confusing to beginning programmers
1654             (and many intermediate ones, too), but it is quite powerful.
1655              
1656             =cut
1657              
1658             sub note_map (&@) { # map a function to a list of notes
1659 0     0 1   my($sub, @notes) = @_;
1660 0 0         return() unless @notes;
1661              
1662             return
1663             map {
1664             # For each input note...
1665 0           my $note = $_;
  0            
1666 0           my @status = &is_note_spec($note);
1667 0 0         if(@status) {
1668 0           my($a_flag, $note_number) = @status;
1669 0           my $orig_note = $note; # Just in case BLOCK changes it!
1670 0           my $orig_a_flag = $a_flag; # Ditto!
1671 0           my @them = map { &{$sub}($note_number, $a_flag, $note ) }
  0            
  0            
1672             $note_number;
1673              
1674 0 0         if($orig_a_flag) { # If based on an absolute note spec.
1675             # try to duplicate the original format
1676 0 0         if($orig_note =~ m<^\d+$>s) { # "12"
    0          
1677             # no-op -- leave as is
1678             } elsif ($orig_note =~ m<^n\d+$>s) { # "n12"
1679 0           @them = map("n$_", @them);
1680             } else { # "C4"
1681 0           @them = map(&number_to_absolute($_), @them);
1682             }
1683             } else { # If based on a relative note spec.
1684 0           @them = map(&number_to_relative($_), @them);
1685             }
1686 0           @them;
1687             } else { # it wasn't a real notespec
1688 0           $note;
1689             }
1690             }
1691             @notes
1692             ;
1693             }
1694              
1695             ###########################################################################
1696              
1697             =item number_to_absolute NUMBER
1698              
1699             This returns the absolute note specification (in the form "C5") that
1700             the MIDI note number in NUMBER represents.
1701              
1702             This is like looking up the note number in C<%MIDI::number2note> -- not
1703             exactly the same, but effectively the same. See the source for more
1704             details.
1705              
1706             =cut
1707              
1708             sub number_to_absolute ($) {
1709 0     0 1   my $in = int($_[0]);
1710             # Look for @Note at the top of this document.
1711 0           return( $MIDI::Simple::Note[ $in % 12 ] . int($in / 12) );
1712             }
1713              
1714             =item the function number_to_relative NUMBER
1715              
1716             This returns the relative note specification that NUMBER represents.
1717             The idea of a numerical representation for C note
1718             specifications was necessitated by C and C --
1719             since without this, you couldn't meaningfully say, for example,
1720             C. This should illustrate the concept:
1721              
1722             number_to_relative(-10) => "D_d1"
1723             number_to_relative( -3) => "A_d1"
1724             number_to_relative( 0) => "C"
1725             number_to_relative( 5) => "F"
1726             number_to_relative( 10) => "Bf"
1727             number_to_relative( 19) => "G_u1"
1728             number_to_relative( 40) => "E_u3"
1729              
1730             =cut
1731              
1732             sub number_to_relative ($) {
1733 0     0 1   my $o_spec;
1734 0           my $in = int($_[0]);
1735              
1736 0 0         if($in < 0) { # Negative, so 'octave(s) down'
    0          
1737 0           $o_spec = '_d' . (1 + abs(int(($in + 1) / 12))); # Crufty, but it works.
1738             } elsif($in < 12) { # so 'same octave'
1739 0           $o_spec = '';
1740             } else { # Positive, greater than 12, so 'N octave(s) up'
1741 0           $o_spec = '_u' . int($in / 12);
1742             }
1743 0           return( $MIDI::Simple::Note[ $in % 12 ] . $o_spec );
1744             }
1745              
1746             ###########################################################################
1747              
1748             =item is_note_spec STRING
1749              
1750             If STRING is a note specification, C returns a
1751             list of two elements: first, a flag of whether the note specification
1752             is absolute (flag value 1) or relative (flag value 0); and second, a
1753             note number corresponding to that note specification. If STRING is
1754             not a note specification, C returns an empty
1755             list (which in a boolean context is FALSE).
1756              
1757             Implementationally, C just uses C
1758             and C.
1759              
1760             Example usage:
1761              
1762             @note_details = is_note_spec($thing);
1763             if(@note_details) {
1764             ($absoluteness_flag, $note_num) = @note_details;
1765             ...stuff...
1766             } else {
1767             push @other_stuff, $thing; # or whatever
1768             }
1769              
1770             =cut
1771              
1772             sub is_note_spec ($) {
1773             # if false, return()
1774             # if true, return(absoluteness_flag, $note_number)
1775 0     0 1   my($in, @ret) = ($_[0]);
1776 0 0         return() unless length $in;
1777 0 0         @ret = &is_absolute_note_spec($in); return(1, @ret) if @ret;
  0            
1778 0 0         @ret = &is_relative_note_spec($in); return(0, @ret) if @ret;
  0            
1779 0           return();
1780             }
1781              
1782             =item is_relative_note_spec STRING
1783              
1784             If STRING is an relative note specification, returns the note number
1785             for that specification as a one-element list (which in a boolean
1786             context is TRUE). Returns empty-list (which in a boolean context is
1787             FALSE) if STRING is NOT a relative note specification.
1788              
1789             To just get the boolean value:
1790              
1791             print "Snorf!\n" unless is_relative_note_spec($note);
1792              
1793             But to actually get the note value:
1794              
1795             ($note_number) = is_relative_note_spec($note);
1796              
1797             Or consider this:
1798              
1799             @is_rel = is_relative_note_spec($note);
1800             if(@is_rel) {
1801             $note_number = $is_rel[0];
1802             } else {
1803             print "Snorf!\n";
1804             }
1805              
1806             (Author's note, two years later: all this business of returning lists
1807             of various sizes, with this and other functions in here, is basically
1808             a workaround for the fact that there's not really any such thing as a
1809             boolean context in Perl -- at least, not as far as user-defined
1810             functions can see. I now think I should have done this with just
1811             returning a single scalar value: a number (which could be 0!) if the
1812             input is a number, and undef/emptylist (C) if not -- then,
1813             the user could test:
1814              
1815             # Hypothetical --
1816             # This function doesn't actually work this way:
1817             if(defined(my $note_val = is_relative_note_spec($string))) {
1818             ...do things with $note_val...
1819             } else {
1820             print "Hey, that's no note!\n";
1821             }
1822              
1823             However, I don't anticipate users actually using these messy functions
1824             often at all -- I basically wrote these for internal use by
1825             MIDI::Simple, then I documented them on the off chance they I
1826             be of use to anyone else.)
1827              
1828             =cut
1829              
1830             sub is_relative_note_spec ($) {
1831             # if false, return()
1832             # if true, return($note_number)
1833 0     0 1   my($note_number, $octave_number, $in, @ret) = (-1, 0, $_[0]);
1834 0 0         return() unless length $in;
1835              
1836 0 0 0       if($in =~ m<^([A-Za-z]+)$>s # Cs
    0 0        
1837             and exists( $MIDI::Simple::Note{$1} )
1838             ){
1839 0           $note_number = $MIDI::Simple::Note{$1};
1840             } elsif($in =~ m<^([A-Za-z]+)_([du])(\d+)$>s # Cs_d4, Cs_u1
1841             and exists( $MIDI::Simple::Note{$1} )
1842             ){
1843 0           $note_number = $MIDI::Simple::Note{$1};
1844 0           $octave_number = $3;
1845 0 0         $octave_number *= -1 if $2 eq "d";
1846             } else {
1847 0           @ret = ();
1848             }
1849 0 0         unless($note_number == -1) {
1850 0           @ret = ( $note_number + $octave_number * 12 );
1851             }
1852 0           return @ret;
1853             }
1854              
1855             =item is_absolute_note_spec STRING
1856              
1857             Just like C, but for absolute note
1858             specifications instead of relative ones.
1859              
1860             =cut
1861              
1862             sub is_absolute_note_spec ($) {
1863             # if false, return()
1864             # if true, return($note_number)
1865 0     0 1   my($note_number, $in, @ret) = (-1, $_[0]);
1866 0 0         return() unless length $in;
1867 0 0         if( $in =~ /^n?(\d+)$/s ) { # E.g., "29", "n38"
    0          
1868 0           $note_number = 0 + $1;
1869             } elsif( $in =~ /^([A-Za-z]+)(\d+)/s ) { # E.g., "C3", "As4"
1870             $note_number = $MIDI::Simple::Note{$1} + $2 * 12
1871 0 0         if exists($MIDI::Simple::Note{$1});
1872             }
1873 0 0 0       @ret = ($note_number) if( $note_number >= 0 and $note_number < 128);
1874 0           return @ret;
1875             }
1876              
1877             #--------------------------------------------------------------------------
1878              
1879             =item Self() or $obj->Self();
1880              
1881             Presumably the second syntax is useless -- it just returns $obj. But
1882             the first syntax returns the current package's default object.
1883              
1884             Suppose you write a routine, C, that does something-or-other
1885             to a given MIDI::Simple object. You could write it so that acts on
1886             the current package's default object, which is fine -- but, among
1887             other things, that means you can't call C from a sub you have
1888             C call, since such routines should/must use only method calls.
1889             So let's say that, instead, you write C so that the first
1890             argument to it is the object to act on. If the MIDI::Simple object
1891             you want it to act on is it C<$sonata>, you just say
1892              
1893             funkify($sonata)
1894              
1895             However, if you want it to act on the current package's default
1896             MIDI::Simple object, what to say? Simply,
1897              
1898             $package_opus = Self;
1899             funkify($package_opus);
1900              
1901             =cut
1902              
1903             sub Self { # pointless as a method -- but as a sub, useful if
1904             # you want to access your current package's object.
1905             # Juuuuuust in case you need it.
1906             my($am_method, $it) = (ref($_[0]) eq "MIDI::Simple")
1907             ? (1, shift @_)
1908 0 0 0 0 1   : (0, ($package{ (caller)[0] } ||= &_package_object( (caller)[0] )) );
1909 0           return $it;
1910             }
1911              
1912             =back
1913              
1914             =cut
1915              
1916             ###########################################################################
1917              
1918             =head1 COPYRIGHT
1919              
1920             Copyright (c) 1998-2005 Sean M. Burke. All rights reserved.
1921              
1922             This library is free software; you can redistribute it and/or
1923             modify it under the same terms as Perl itself.
1924              
1925             =head1 AUTHOR
1926              
1927             Sean M. Burke C
1928              
1929             =cut
1930              
1931             1;
1932              
1933             __END__