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