File Coverage

blib/lib/MIDI/Opus.pm
Criterion Covered Total %
statement 150 230 65.2
branch 59 138 42.7
condition 11 28 39.2
subroutine 16 21 76.1
pod 13 17 76.4
total 249 434 57.3


line stmt bran cond sub pod time code
1              
2             # Time-stamp: "2023-10-11 11:08:32 conklin"
3             require 5;
4             package MIDI::Opus;
5 12     12   73 use strict;
  12         19  
  12         363  
6 12     12   66 use vars qw($Debug $VERSION);
  12         20  
  12         493  
7 12     12   58 use Carp;
  12         24  
  12         34394  
8              
9             $Debug = 0;
10             $VERSION = 0.84;
11              
12             =head1 NAME
13              
14             MIDI::Opus -- functions and methods for MIDI opuses
15              
16             =head1 SYNOPSIS
17              
18             use MIDI; # uses MIDI::Opus et al
19             foreach $one (@ARGV) {
20             my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 });
21             print "$one has ", scalar( $opus->tracks ) " tracks\n";
22             }
23             exit;
24              
25             =head1 DESCRIPTION
26              
27             MIDI::Opus provides a constructor and methods for objects
28             representing a MIDI opus (AKA "song"). It is part of the MIDI suite.
29              
30             An opus object has three attributes: a format (0 for MIDI Format 0), a
31             tick parameter (parameter "division" in L), and a list
32             of tracks objects that are the real content of that opus.
33              
34             Be aware that options specified for the encoding or decoding of an
35             opus may not be documented in I module's documentation, as they
36             may be (and, in fact, generally are) options just passed down to the
37             decoder/encoder in MIDI::Event -- so see L for an
38             explanation of most of them, actually.
39              
40             =head1 CONSTRUCTOR AND METHODS
41              
42             MIDI::Opus provides...
43              
44             =over
45              
46             =cut
47              
48             ###########################################################################
49              
50             =item the constructor MIDI::Opus->new({ ...options... })
51              
52             This returns a new opus object. The options, which are optional, is
53             an anonymous hash. By default, you get a new format-0 opus with no
54             tracks and a tick parameter of 96. There are six recognized options:
55             C, to set the MIDI format number (generally either 0 or 1) of
56             the new object; C, to set its ticks parameter; C, which
57             sets the tracks of the new opus to the contents of the list-reference
58             provided; C, which is an exact synonym of C;
59             C, which reads the opus from the given filespec; and
60             C, which reads the opus from the the given filehandle
61             reference (e.g., C<*STDIN{IO}>), after having called binmode() on that
62             handle, if that's a problem.
63              
64             If you specify either C or C, you probably
65             don't want to specify any of the other options -- altho you may well
66             want to specify options that'll get passed down to the decoder in
67             L, such as C<'include' => ['sysex_f0', 'sysex_f7']>, just for
68             example.
69              
70             Finally, the option C can be used in conjunction with either
71             C or C, and, if true, will block MTrk tracks'
72             data from being parsed into MIDI events, and will leave them as track
73             data (i.e., what you get from $track->data). This is useful if you
74             are just moving tracks around across files (or just counting them in
75             files, as in the code in the Synopsis, above), without having to deal
76             with any of the events in them. (Actually, this option is implemented
77             in code in L, but in a routine there that I've left
78             undocumented, as you should access it only thru here.)
79              
80             =cut
81              
82             sub new {
83             # Make a new MIDI opus object.
84 12     12 1 2004173 my $class = shift;
85 12 50 33     126 my $options_r = (defined($_[0]) and ref($_[0]) eq 'HASH') ? $_[0] : {};
86              
87 12         36 my $this = bless( {}, $class );
88              
89 12 50       42 print "New object in class $class\n" if $Debug;
90              
91 12 50       48 return $this if $options_r->{'no_opus_init'}; # bypasses all init.
92 12         58 $this->_init( $options_r );
93              
94 12 100 66     117 if(
    50 66        
      33        
      33        
95             exists( $options_r->{'from_file'} ) &&
96             defined( $options_r->{'from_file'} ) &&
97             length( $options_r->{'from_file'} )
98             ){
99 10         53 $this->read_from_file( $options_r->{'from_file'}, $options_r );
100             } elsif(
101             exists( $options_r->{'from_handle'} ) &&
102             defined( $options_r->{'from_handle'} ) &&
103             length( $options_r->{'from_handle'} )
104             ){
105 0         0 $this->read_from_handle( $options_r->{'from_handle'}, $options_r );
106             }
107 12         42 return $this;
108             }
109             ###########################################################################
110              
111             =item the method $new_opus = $opus->copy
112              
113             This duplicates the contents of the given opus, and returns
114             the duplicate. If you are unclear on why you may need this function,
115             read the documentation for the C method in L.
116              
117             =cut
118              
119             sub copy {
120             # Duplicate a given opus. Even dupes the tracks.
121             # Call as $new_one = $opus->copy
122 0     0 1 0 my $opus = shift;
123              
124 0         0 my $new = bless( { %{$opus} }, ref $opus );
  0         0  
125             # a first crude dupe.
126             # yes, bless it into whatever class the original came from
127              
128             $new->{'tracks'} = # Now dupe the tracks.
129             [ map( $_->copy,
130 0         0 @{ $new->{'tracks'} }
131             )
132 0 0       0 ] if $new->{'tracks'}; # (which should always be true anyhoo)
133              
134 0         0 return $new;
135             }
136              
137             sub _init {
138             # Init a MIDI object -- (re)set it with given parameters, or defaults
139 12     12   26 my $this = shift;
140 12 50       45 my $options_r = ref($_[0]) eq 'HASH' ? $_[0] : {};
141              
142 12 50       35 print "_init called against $this\n" if $Debug;
143 12 50       37 if($Debug) {
144 0 0       0 if(%$options_r) {
145 0         0 print "Parameters: ", map("<$_>", %$options_r), "\n";
146             } else {
147 0         0 print "Null parameters for opus init\n";
148             }
149             }
150             $this->{'format'} =
151 12 100       77 defined($options_r->{'format'}) ? $options_r->{'format'} : 1;
152             $this->{'ticks'} =
153 12 100       48 defined($options_r->{'ticks'}) ? $options_r->{'ticks'} : 96;
154              
155             $options_r->{'tracks'} = $options_r->{'tracks_r'}
156             if( exists( $options_r->{'tracks_r'} ) and not
157 12 50 33     68 exists( $options_r->{'tracks'} )
158             );
159             # so tracks_r => [ @tracks ] is a synonym for
160             # tracks => [ @tracks ]
161             # as on option for new()
162              
163             $this->{'tracks'} =
164             ( defined($options_r->{'tracks'})
165             and ref($options_r->{'tracks'}) eq 'ARRAY' )
166 12 100 66     91 ? $options_r->{'tracks'} : []
167             ;
168 12         29 return;
169             }
170             #########################################################################
171              
172             =item the method $opus->tracks( @tracks )
173              
174             Returns the list of tracks in the opus, possibly after having set it
175             to @tracks, if specified and not empty. (If you happen to want to set
176             the list of tracks to an empty list, for whatever reason, you have to
177             use "$opus->tracks_r([])".)
178              
179             In other words: $opus->tracks(@tracks) is how to set the list of
180             tracks (assuming @tracks is not empty), and @tracks = $opus->tracks is
181             how to read the list of tracks.
182              
183             =cut
184              
185             sub tracks {
186 18     18 1 65 my $this = shift;
187 18 100       70 $this->{'tracks'} = [ @_ ] if @_;
188 18         30 return @{ $this->{'tracks'} };
  18         295  
189             }
190              
191             =item the method $opus->tracks_r( $tracks_r )
192              
193             Returns a reference to the list of tracks in the opus, possibly after
194             having set it to $tracks_r, if specified. "$tracks_r" can actually be
195             any listref, whether it comes from a scalar as in C<$some_tracks_r>,
196             or from something like C<[@tracks]>, or just plain old C<\@tracks>
197              
198             Originally $opus->tracks was the only way to deal with tracks, but I
199             added $opus->tracks_r to make possible 1) setting the list of tracks
200             to (), for whatever that's worth, 2) parallel structure between
201             MIDI::Opus::tracks[_r] and MIDI::Tracks::events[_r] and 3) so you can
202             directly manipulate the opus's tracks, without having to I the
203             list of tracks back and forth. This way, you can say:
204              
205             $tracks_r = $opus->tracks_r();
206             @some_stuff = splice(@$tracks_r, 4, 6);
207              
208             But if you don't know how to deal with listrefs like that, that's OK,
209             just use $opus->tracks.
210              
211             =cut
212              
213             sub tracks_r {
214 25     25 1 51 my $this = shift;
215 25 100       79 $this->{'tracks'} = $_[0] if ref($_[0]);
216 25         108 return $this->{'tracks'};
217             }
218              
219             =item the method $opus->ticks( $tick_parameter )
220              
221             Returns the tick parameter from $opus, after having set it to
222             $tick_parameter, if provided.
223              
224             =cut
225              
226             sub ticks {
227 10     10 1 2288 my $this = shift;
228 10 100       33 $this->{'ticks'} = $_[0] if defined($_[0]);
229 10         36 return $this->{'ticks'};
230             }
231              
232             =item the method $opus->format( $format )
233              
234             Returns the MIDI format for $opus, after having set it to
235             $format, if provided.
236              
237             =cut
238              
239             sub format {
240 13     13 1 34 my $this = shift;
241 13 100       34 $this->{'format'} = $_[0] if defined($_[0]);
242 13         391 return $this->{'format'};
243             }
244              
245             =item the method $new_opus = $opus->skyline
246              
247             This skylines an $opus. It first converts the score to format 0 with
248             the skyline result as the track. See the documentation for
249             Score::skyline() and Track::skyline(). Original $opus is modified, use
250             MIDI::Opus::copy if you want to take a copy first. Appearance order
251             of concurrent events may not be preserved.
252              
253             =cut
254              
255             sub skyline {
256 1     1 1 11 my $this = $_[0];
257 1 50       5 my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};
258 1         3 $this->format0();
259 1         3 my ($track) = $this->tracks();
260 1         4 $track->skyline($options_r);
261             }
262              
263             =item the method $new_opus = $opus->format0
264              
265             This converts $opus to format 0 by collapsing all tracks into one.
266             Original $opus is modified, use MIDI::Opus::copy if you want to take a
267             copy first.
268              
269             =cut
270              
271             sub format0 {
272 1     1 1 2 my $this = shift;
273 1         3 my @events = ();
274 1         1 my $score_r;
275 1         2 foreach my $track ($this->tracks) { # build a long list of concatenated tracks
276 2         8 $score_r = MIDI::Score::events_r_to_score_r($track->events_r);
277 2         3 push(@events,@{$score_r});
  2         12  
278             }
279             # and now sort them
280 1         5 $score_r = MIDI::Score::sort_score_r(\@events);
281 1         5 my $events_r = MIDI::Score::score_r_to_events_r($score_r);
282 1         3 my $ztrack = MIDI::Track->new;
283 1         10 $ztrack->events_r($events_r);
284 1         3 $this->format(0);
285             # set the track list to just this single track
286 1         3 $this->tracks($ztrack);
287             }
288              
289              
290             sub info { # read-only
291             # Hm, do I really want this routine? For ANYTHING at all?
292 0     0 0 0 my $this = shift;
293             return (
294             'format' => $this->{'format'},# I want a scalar
295             'ticks' => $this->{'ticks'}, # I want a scalar
296 0         0 'tracks' => $this->{'tracks'} # I want a ref to a list
297             );
298             }
299              
300             =item the method $new_opus = $opus->quantize
301              
302             This grid quantizes an opus. It simply calls MIDI::Score::quantize on
303             every track. See docs for MIDI::Score::quantize. Original opus is
304             destroyed, use MIDI::Opus::copy if you want to take a copy first.
305              
306             =cut
307              
308             sub quantize {
309 1     1 1 8 my $this = $_[0];
310 1 50       4 my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};
311 1         3 my $grid = $options_r->{grid};
312 1 50       3 if ($grid < 1) {carp "bad grid $grid in MIDI::Opus::quantize!"; return;}
  0         0  
  0         0  
313 1 50       3 return if ($grid eq 1); # no quantizing to do
314 1         1 my $qd = $options_r->{durations}; # quantize durations?
315 1         2 my $new_tracks_r = [];
316 1         4 foreach my $track ($this->tracks) {
317 1         4 my $score_r = MIDI::Score::events_r_to_score_r($track->events_r);
318 1         5 my $new_score_r = MIDI::Score::quantize($score_r,{grid=>$grid,durations=>$qd});
319 1         5 my $events_r = MIDI::Score::score_r_to_events_r($new_score_r);
320 1         5 my $new_track = MIDI::Track->new({events_r=>$events_r});
321 1         2 push @{$new_tracks_r}, $new_track;
  1         9  
322             }
323 1         4 $this->tracks_r($new_tracks_r);
324             }
325              
326             ###########################################################################
327              
328             =item the method $opus->dump( { ...options...} )
329              
330             Dumps the opus object as a bunch of text, for your perusal. Options
331             include: C, if true, will have each event in the opus as a
332             tab-delimited line -- or as delimited with whatever you specify with
333             option C; I, dump the data as Perl code that, if
334             run, would/should reproduce the opus. For concision's sake, the track data
335             isn't dumped, unless you specify the option C as true.
336              
337             =cut
338              
339             sub dump { # method; read-only
340 0     0 1 0 my $this = $_[0];
341 0         0 my %info = $this->info();
342 0 0       0 my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};
343              
344 0 0       0 if($options_r->{'flat'}) { # Super-barebones dump mode
345 0   0     0 my $d = $options_r->{'delimiter'} || "\t";
346 0         0 foreach my $track ($this->tracks) {
347 0         0 foreach my $event (@{ $track->events_r }) {
  0         0  
348 0         0 print( join($d, @$event), "\n" );
349             }
350             }
351 0         0 return;
352             }
353              
354             print "MIDI::Opus->new({\n",
355             " 'format' => ", &MIDI::_dump_quote($this->{'format'}), ",\n",
356 0         0 " 'ticks' => ", &MIDI::_dump_quote($this->{'ticks'}), ",\n";
357              
358 0         0 my @tracks = $this->tracks;
359 0 0       0 if( $options_r->{'dump_tracks'} ) {
360 0         0 print " 'tracks' => [ # ", scalar(@tracks), " tracks...\n\n";
361 0         0 foreach my $x (0 .. $#tracks) {
362 0         0 my $track = $tracks[$x];
363 0         0 print " # Track \#$x ...\n";
364 0 0       0 if(ref($track)) {
365 0         0 $track->dump($options_r);
366             } else {
367 0         0 print " # \[$track\] is not a reference!!\n";
368             }
369             }
370 0         0 print " ]\n";
371             } else {
372 0         0 print " 'tracks' => [ ], # ", scalar(@tracks), " tracks (not dumped)\n";
373             }
374 0         0 print "});\n";
375 0         0 return 1;
376             }
377              
378             ###########################################################################
379             # And now the real fun...
380             ###########################################################################
381              
382             =item the method $opus->write_to_file('filespec', { ...options...} )
383              
384             Writes $opus as a MIDI file named by the given filespec.
385             The options hash is optional, and whatever you specify as options
386             percolates down to the calls to MIDI::Event::encode -- which see.
387             Currently this just opens the file, calls $opus->write_to_handle
388             on the resulting filehandle, and closes the file.
389              
390             =cut
391              
392             sub write_to_file { # method
393             # call as $opus->write_to_file("../../midis/stuff1.mid", { ..options..} );
394 2     2 1 78 my $opus = $_[0];
395 2         4 my $destination = $_[1];
396 2 50       9 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
397              
398 2 50       7 croak "No output file specified" unless length($destination);
399 2 50       171 unless(open(OUT_MIDI, ">$destination")) {
400 0         0 croak "Can't open $destination for writing\: \"$!\"\n";
401             }
402 2         17 $opus->write_to_handle( *OUT_MIDI{IO}, $options_r);
403 2 50       113 close(OUT_MIDI)
404             || croak "Can't close filehandle for $destination\: \"$!\"\n";
405 2         13 return; # nothing useful to return
406             }
407              
408             sub read_from_file { # method, surprisingly enough
409             # $opus->read_from_file("ziz1.mid", {'stuff' => 1}).
410             # Overwrites the contents of $opus with the contents of the file ziz1.mid
411             # $opus is presumably newly initted.
412             # The options hash is optional.
413             # This is currently meant to be called by only the
414             # MIDI::Opus->new() constructor.
415              
416 10     10 0 23 my $opus = $_[0];
417 10         18 my $source = $_[1];
418 10 50       38 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
419              
420 10 50       34 croak "No source file specified" unless length($source);
421 10 50       360 unless(open(IN_MIDI, "<$source")) {
422 0         0 croak "Can't open $source for reading\: \"$!\"\n";
423             }
424 10         113 my $size = -s $source;
425 10 50       43 $size = undef unless $size;
426              
427 10         69 $opus->read_from_handle(*IN_MIDI{IO}, $options_r, $size);
428             # Thanks to the EFNet #perl cabal for helping me puzzle out "*IN_MIDI{IO}"
429 10 50       134 close(IN_MIDI) ||
430             croak "error while closing filehandle for $source\: \"$!\"\n";
431              
432 10         36 return $opus;
433             }
434              
435             =item the method $opus->write_to_handle(IOREF, { ...options...} )
436              
437             Writes $opus as a MIDI file to the IO handle you pass a reference to
438             (example: C<*STDOUT{IO}>).
439             The options hash is optional, and whatever you specify as options
440             percolates down to the calls to MIDI::Event::encode -- which see.
441             Note that this is probably not what you'd want for sending music
442             to C, since MIDI files are not MIDI-on-the-wire.
443              
444             =cut
445              
446             ###########################################################################
447             sub write_to_handle { # method
448             # Call as $opus->write_to_handle( *FH{IO}, { ...options... });
449 2     2 1 4 my $opus = $_[0];
450 2         4 my $fh = $_[1];
451 2 50       10 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
452              
453 2         9 binmode($fh);
454              
455 2         26 my $tracks = scalar( $opus->tracks );
456 2 50       15 carp "Writing out an opus with no tracks!\n" if $tracks == 0;
457              
458 2         5 my $format;
459 2 50       8 if( defined($opus->{'format'}) ) {
460 2         5 $format = $opus->{'format'};
461             } else { # Defaults
462 0 0       0 if($tracks == 0) {
    0          
463 0         0 $format = 2; # hey, why not?
464             } elsif ($tracks == 1) {
465 0         0 $format = 0;
466             } else {
467 0         0 $format = 1;
468             }
469             }
470             my $ticks =
471 2 50       7 defined($opus->{'ticks'}) ? $opus->{'ticks'} : 96 ;
472             # Ninety-six ticks per quarter-note seems a pleasant enough default.
473              
474 2         41 print $fh (
475             "MThd\x00\x00\x00\x06", # header; 6 bytes follow
476             pack('nnn', $format, $tracks, $ticks)
477             );
478 2         9 foreach my $track (@{ $opus->{'tracks'} }) {
  2         7  
479 2         5 my $data = '';
480 2         8 my $type = substr($track->{'type'} . "\x00\x00\x00\x00", 0, 4);
481             # Force it to be 4 chars long.
482 2         13 $data = ${ $track->encode( $options_r ) };
  2         10  
483             # $track->encode will handle the issue of whether
484             # to use the track's data or its events
485 2         16 print $fh ($type, pack('N', length($data)), $data);
486             }
487 2         6 return;
488             }
489              
490             ############################################################################
491             sub read_from_handle { # a method, surprisingly enough
492             # $opus->read_from_handle(*STDIN{IO}, {'stuff' => 1}).
493             # Overwrites the contents of $opus with the contents of the MIDI file
494             # from the filehandle you're passing a reference to.
495             # $opus is presumably newly initted.
496             # The options hash is optional.
497              
498             # This is currently meant to be called by only the
499             # MIDI::Opus->new() constructor.
500              
501 10     10 0 21 my $opus = $_[0];
502 10         20 my $fh = $_[1];
503 10 50       49 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
504 10         18 my $file_size_left;
505 10 50       40 $file_size_left = $_[3] if defined $_[3];
506              
507 10         45 binmode($fh);
508              
509 10         40 my $in = '';
510              
511 10         33 my $track_size_limit;
512             $track_size_limit = $options_r->{'track_size'}
513 10 50       34 if exists $options_r->{'track_size'};
514              
515 10 50       358 croak "Can't even read the first 14 bytes from filehandle $fh"
516             unless read($fh, $in, 14);
517             # 14 = The expected header length.
518              
519 10 50       50 if(defined $file_size_left) {
520 10         30 $file_size_left -= 14;
521             }
522              
523 10         92 my($id, $length, $format, $tracks_expected, $ticks) = unpack('A4Nnnn', $in);
524              
525 10 50       54 croak "data from handle $fh doesn't start with a MIDI file header"
526             unless $id eq 'MThd';
527 10 50       32 croak "Unexpected MTHd chunk length in data from handle $fh"
528             unless $length == 6;
529 10         26 $opus->{'format'} = $format;
530 10         21 $opus->{'ticks'} = $ticks; # ...which may be a munged 'negative' number
531 10         38 $opus->{'tracks'} = [];
532              
533 10 50       30 print "file header from handle $fh read and parsed fine.\n" if $Debug;
534 10         21 my $track_count = 0;
535              
536             Track_Chunk:
537 10         139 until( eof($fh) ) {
538 17         37 ++$track_count;
539 17 50       53 print "Reading Track \# $track_count into a new track\n" if $Debug;
540              
541 17 50       70 if(defined $file_size_left) {
542 17         31 $file_size_left -= 2;
543 17 50       54 croak "reading further would exceed file_size_limit"
544             if $file_size_left < 0;
545             }
546              
547 17         56 my($header, $data);
548 17 50       93 croak "Can't read header for track chunk \#$track_count"
549             unless read($fh, $header, 8);
550 17         73 my($type, $length) = unpack('A4N', $header);
551              
552 17 50 33     68 if(defined $track_size_limit and $track_size_limit > $length) {
553 0         0 croak "Track \#$track_count\'s length ($length) would"
554             . " exceed track_size_limit $track_size_limit";
555             }
556              
557 17 50       67 if(defined $file_size_left) {
558 17         27 $file_size_left -= $length;
559 17 50       42 croak "reading track \#$track_count (of length $length) "
560             . "would exceed file_size_limit"
561             if $file_size_left < 0;
562             }
563              
564 17         64 read($fh, $data, $length); # whooboy, actually read it now
565              
566 17 50       56 if($length == length($data)) {
567             push(
568 17         23 @{ $opus->{'tracks'} },
  17         100  
569             &MIDI::Track::decode( $type, \$data, $options_r )
570             );
571             } else {
572 0         0 croak
573             "Length of track \#$track_count is off in data from $fh; "
574             . "I wanted $length\, but got "
575             . length($data);
576             }
577             }
578              
579             carp
580 10 50       58 "Header in data from $fh says to expect $tracks_expected tracks, "
581             . "but $track_count were found\n"
582             unless $tracks_expected == $track_count;
583 10 50       63 carp "No tracks read in data from $fh\n" if $track_count == 0;
584              
585 10         30 return $opus;
586             }
587             ###########################################################################
588              
589             =item the method $opus->draw({ ...options...})
590              
591             This currently experimental method returns a new GD image object that's
592             a graphic representation of the notes in the given opus. Options include:
593             C -- the width of the image in pixels (defaults to 600);
594             C -- a six-digit hex RGB representation of the background color
595             for the image (defaults to $MIDI::Opus::BG_color, currently '000000');
596             C -- a reference to a list of colors (in six-digit hex RGB)
597             to use for representing notes on given channels.
598             Defaults to @MIDI::Opus::Channel_colors.
599             This list is a list of pairs of colors, such that:
600             the first of a pair (color N*2) is the color for the first pixel in a
601             note on channel N; and the second (color N*2 + 1) is the color for the
602             remaining pixels of that note. If you specify only enough colors for
603             channels 0 to M, notes on a channels above M will use 'recycled'
604             colors -- they will be plotted with the color for channel
605             "channel_number % M" (where C<%> = the MOD operator).
606              
607             This means that if you specify
608              
609             channel_colors => ['00ffff','0000ff']
610              
611             then all the channels' notes will be plotted with an aqua pixel followed
612             by blue ones; and if you specify
613              
614             channel_colors => ['00ffff','0000ff', 'ff00ff','ff0000']
615              
616             then all the I channels' notes will be plotted with an aqua
617             pixel followed by blue ones, and all the I channels' notes will
618             be plotted with a purple pixel followed by red ones.
619              
620             As to what to do with the object you get back, you probably want
621             something like:
622              
623             $im = $chachacha->draw;
624             open(OUT, ">$gif_out"); binmode(OUT);
625             print OUT $im->gif;
626             close(OUT);
627              
628             Using this method will cause a C if it can't successfully C.
629              
630             I emphasise that C is expermental, and, in any case, is only meant
631             to be a crude hack. Notably, it does not address well some basic problems:
632             neither volume nor patch-selection (nor any notable aspects of the
633             patch selected)
634             are represented; pitch-wheel changes are not represented;
635             percussion (whether on percussive patches or on channel 10) is not
636             specially represented, as it probably should be;
637             notes overlapping are not represented at all well.
638              
639             =cut
640              
641             sub draw { # method
642 0     0 1   my $opus = $_[0];
643 0 0         my $options_r = ref($_[1]) ? $_[1] : {};
644              
645 0           &use_GD(); # will die at runtime if we call this function but it can't use GD
646              
647 0           my $opus_time = 0;
648 0           my @scores = ();
649 0           foreach my $track ($opus->tracks) {
650 0           my($score_r, $track_time) = MIDI::Score::events_r_to_score_r(
651             $track->events_r );
652 0 0         push(@scores, $score_r) if @$score_r;
653 0 0         $opus_time = $track_time if $track_time > $opus_time;
654             }
655              
656 0   0       my $width = $options_r->{'width'} || 600;
657              
658 0 0         croak "opus can't be drawn because it takes no time" unless $opus_time;
659 0           my $pixtix = $opus_time / $width; # Number of ticks a pixel represents
660              
661 0           my $im = GD::Image->new($width,127);
662             # This doesn't handle pitch wheel, nor does it tread things on channel 10
663             # (percussion) as specially as it probably should.
664             # The problem faced here is how to map onto pixel color all the
665             # characteristics of a note (say, Channel, Note, Volume, and Patch).
666             # I'll just do it for channels. Rewrite this on your own if you want
667             # something different.
668              
669             my $bg_color =
670             $im->colorAllocate(unpack('C3', pack('H2H2H2',unpack('a2a2a2',
671 0 0         ( length($options_r->{'bg_color'}) ? $options_r->{'bg_color'}
672             : $MIDI::Opus::BG_color)
673             ))) );
674 0 0         @MIDI::Opus::Channel_colors = ( '00ffff' , '0000ff' )
675             unless @MIDI::Opus::Channel_colors;
676             my @colors =
677             map( $im->colorAllocate(
678             unpack('C3', pack('H2H2H2',unpack('a2a2a2',$_)))
679             ), # convert 6-digit hex to a scalar tuple
680             ref($options_r->{'channel_colors'}) ?
681 0 0         @{$options_r->{'channel_colors'}} : @MIDI::Opus::Channel_colors
  0            
682             );
683 0           my $channels_in_palette = int(@colors / 2);
684 0           $im->fill(0,0,$bg_color);
685 0           foreach my $score_r (@scores) {
686 0           foreach my $event_r (@$score_r) {
687 0 0         next unless $event_r->[0] eq 'note';
688 0           my($time, $duration, $channel, $note, $volume) = @{$event_r}[1,2,3,4,5];
  0            
689 0           my $y = 127 - $note;
690 0           my $start_x = $time / $pixtix;
691 0           $im->line($start_x, $y, ($time + $duration) / $pixtix, $y,
692             $colors[1 + ($channel % $channels_in_palette)] );
693 0           $im->setPixel($start_x , $y, $colors[$channel % $channels_in_palette] );
694             }
695             }
696 0           return $im; # Returns the GD object, which the user then dumps however
697             }
698              
699             #--------------------------------------------------------------------------
700             { # Closure so we can use this wonderful variable:
701             my $GD_used = 0;
702             sub use_GD {
703 0 0   0 0   return if $GD_used;
704 0 0         eval("use GD;"); croak "You don't seem to have GD installed." if $@;
  0            
705 0           $GD_used = 1; return;
  0            
706             }
707             # Why use GD at runtime like this, instead of at compile-time like normal?
708             # So we can still use everything in this module except &draw even if we
709             # don't have GD on this system.
710             }
711              
712             ######################################################################
713             # This maps channel number onto colors for draw(). It is quite unimaginative,
714             # and reuses colors two or three times. It's a package global. You can
715             # change it by assigning to @MIDI::Simple::Channel_colors.
716              
717             @MIDI::Opus::Channel_colors =
718             (
719             'c0c0ff', '6060ff', # start / sustain color, channel 0
720             'c0ffc0', '60ff60', # start / sustain color, channel 1, etc...
721             'ffc0c0', 'ff6060', 'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60',
722             'c0ffff', '60ffff',
723            
724             'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060',
725             'c0c0c0', '707070', # channel 10
726            
727             'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', 'c0ffff', '60ffff',
728             'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060',
729             );
730             $MIDI::Opus::BG_color = '000000'; # Black goes with everything, you know.
731              
732             ###########################################################################
733              
734             =back
735              
736             =head1 WHERE'S THE DESTRUCTOR?
737              
738             Because MIDI objects (whether opuses or tracks) do not contain any
739             circular data structures, you don't need to explicitly destroy them in
740             order to deallocate their memory. Consider this code snippet:
741              
742             use MIDI;
743             foreach $one (@ARGV) {
744             my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 });
745             print "$one has ", scalar( $opus->tracks ) " tracks\n";
746             }
747              
748             At the end of each iteration of the foreach loop, the variable $opus
749             goes away, along with its contents, a reference to the opus object.
750             Since no other references to it exist (i.e., you didn't do anything like
751             push(@All_opuses,$opus) where @All_opuses is a global), the object is
752             automagically destroyed and its memory marked for recovery.
753              
754             If you wanted to explicitly free up the memory used by a given opus
755             object (and its tracks, if those tracks aren't used anywhere else) without
756             having to wait for it to pass out of scope, just replace it with a new
757             empty object:
758              
759             $opus = MIDI::Opus->new;
760              
761             or replace it with anything at all -- or even just undef it:
762              
763             undef $opus;
764              
765             Of course, in the latter case, you can't then use $opus as an opus
766             object anymore, since it isn't one.
767              
768             =head1 NOTE ON TICKS
769              
770             If you want to use "negative" values for ticks (so says the spec: "If
771             division is negative, it represents the division of a second
772             represented by the delta-times in the file,[...]"), then you'll want to use
773             something like this syntax:
774              
775             $opus->ticks( ( -25 << 8 ) | 80 );
776              
777             for bit resolution (80) at 25 f/s.
778              
779             This is tested to work properly and produce the right header values in the
780             resulting output file. However, it should be noted that many MIDI synthesizers
781             don't support this header format at last check, such as VLC/Fluidsynth and wildmidi.
782             Some do, such as Windows Media Player and Timidity++.
783              
784             =head1 NOTE ON WARN-ING AND DIE-ING
785              
786             In the case of trying to parse a malformed MIDI file (which is not a
787             common thing, in my experience), this module (or MIDI::Track or
788             MIDI::Event) may warn() or die() (Actually, carp() or croak(), but
789             it's all the same in the end). For this reason, you shouldn't use
790             this suite in a case where the script, well, can't warn or die -- such
791             as, for example, in a CGI that scans for text events in a uploaded
792             MIDI file that may or may not be well-formed. If this I the kind
793             of task you or someone you know may want to do, let me know and I'll
794             consider some kind of 'no_die' parameter in future releases.
795             (Or just trap the die in an eval { } around your call to anything you
796             think could die.)
797              
798             =head1 COPYRIGHT
799              
800             Copyright (c) 1998-2002 Sean M. Burke. All rights reserved.
801              
802             This library is free software; you can redistribute it and/or
803             modify it under the same terms as Perl itself.
804              
805             =head1 AUTHORS
806              
807             Sean M. Burke C (until 2010)
808              
809             Darrell Conklin C (from 2010)
810              
811             =cut
812              
813             1;
814             __END__