File Coverage

blib/lib/MIDI/Opus.pm
Criterion Covered Total %
statement 132 212 62.2
branch 57 136 41.9
condition 11 28 39.2
subroutine 14 19 73.6
pod 11 15 73.3
total 225 410 54.8


line stmt bran cond sub pod time code
1              
2             # Time-stamp: "2010-12-23 10:00:01 conklin"
3             require 5;
4             package MIDI::Opus;
5 11     11   421 use strict;
  11         27  
  11         1254  
6 11     11   58 use vars qw($Debug $VERSION);
  11         182  
  11         1103  
7 11     11   66 use Carp;
  11         20  
  11         44463  
8              
9             $Debug = 0;
10             $VERSION = 0.83;
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             MIDI::Events, such as 'include' => ['sysex_f0', 'sysex_f7'], just for
68             example.
69              
70             Finally, the option C can be used in conjuction 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 MIDI::Track, 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 11     11 1 2009088 my $class = shift;
85 11 50 33     150 my $options_r = (defined($_[0]) and ref($_[0]) eq 'HASH') ? $_[0] : {};
86              
87 11         41 my $this = bless( {}, $class );
88              
89 11 50       56 print "New object in class $class\n" if $Debug;
90              
91 11 50       64 return $this if $options_r->{'no_opus_init'}; # bypasses all init.
92 11         68 $this->_init( $options_r );
93              
94 11 100 66     145 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 9         50 $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 11         53 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 0         0 $new->{'tracks'} = # Now dupe the tracks.
129             [ map( $_->copy,
130 0 0       0 @{ $new->{'tracks'} }
131             )
132             ] 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 11     11   25 my $this = shift;
140 11 50       48 my $options_r = ref($_[0]) eq 'HASH' ? $_[0] : {};
141              
142 11 50       43 print "_init called against $this\n" if $Debug;
143 11 50       35 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 11 100       91 $this->{'format'} =
151             defined($options_r->{'format'}) ? $options_r->{'format'} : 1;
152 11 100       74 $this->{'ticks'} =
153             defined($options_r->{'ticks'}) ? $options_r->{'ticks'} : 96;
154              
155 11 50 33     69 $options_r->{'tracks'} = $options_r->{'tracks_r'}
156             if( exists( $options_r->{'tracks_r'} ) and not
157             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 11 100 66     141 $this->{'tracks'} =
164             ( defined($options_r->{'tracks'})
165             and ref($options_r->{'tracks'}) eq 'ARRAY' )
166             ? $options_r->{'tracks'} : []
167             ;
168 11         28 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 12     12 1 36 my $this = shift;
187 12 50       51 $this->{'tracks'} = [ @_ ] if @_;
188 12         21 return @{ $this->{'tracks'} };
  12         48  
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 43 my $this = shift;
215 25 100       185 $this->{'tracks'} = $_[0] if ref($_[0]);
216 25         119 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 4559 my $this = shift;
228 10 100       45 $this->{'ticks'} = $_[0] if defined($_[0]);
229 10         74 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 10     10 1 21 my $this = shift;
241 10 100       40 $this->{'format'} = $_[0] if defined($_[0]);
242 10         45 return $this->{'format'};
243             }
244              
245             sub info { # read-only
246             # Hm, do I really want this routine? For ANYTHING at all?
247 0     0 0 0 my $this = shift;
248             return (
249 0         0 'format' => $this->{'format'},# I want a scalar
250             'ticks' => $this->{'ticks'}, # I want a scalar
251             'tracks' => $this->{'tracks'} # I want a ref to a list
252             );
253             }
254              
255             =item the method $new_opus = $opus->quantize
256              
257             This grid quantizes an opus. It simply calls MIDI::Score::quantize on
258             every track. See docs for MIDI::Score::quantize. Original opus is
259             destroyed, use MIDI::Opus::copy if you want to take a copy first.
260              
261             =cut
262              
263             sub quantize {
264 1     1 1 10 my $this = $_[0];
265 1 50       12 my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};
266 1         2 my $grid = $options_r->{grid};
267 1 50       5 if ($grid < 1) {carp "bad grid $grid in MIDI::Opus::quantize!"; return;}
  0         0  
  0         0  
268 1 50       4 return if ($grid eq 1); # no quantizing to do
269 1         7 my $qd = $options_r->{durations}; # quantize durations?
270 1         2 my $new_tracks_r = [];
271 1         3 foreach my $track ($this->tracks) {
272 1         5 my $score_r = MIDI::Score::events_r_to_score_r($track->events_r);
273 1         7 my $new_score_r = MIDI::Score::quantize($score_r,{grid=>$grid,durations=>$qd});
274 1         13 my $events_r = MIDI::Score::score_r_to_events_r($new_score_r);
275 1         6 my $new_track = MIDI::Track->new({events_r=>$events_r});
276 1         2 push @{$new_tracks_r}, $new_track;
  1         13  
277             }
278 1         5 $this->tracks_r($new_tracks_r);
279             }
280              
281             ###########################################################################
282              
283             =item the method $opus->dump( { ...options...} )
284              
285             Dumps the opus object as a bunch of text, for your perusal. Options
286             include: C, if true, will have each event in the opus as a
287             tab-delimited line -- or as delimited with whatever you specify with
288             option C; I, dump the data as Perl code that, if
289             run, would/should reproduce the opus. For concision's sake, the track data
290             isn't dumped, unless you specify the option C as true.
291              
292             =cut
293              
294             sub dump { # method; read-only
295 0     0 1 0 my $this = $_[0];
296 0         0 my %info = $this->info();
297 0 0       0 my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};
298              
299 0 0       0 if($options_r->{'flat'}) { # Super-barebones dump mode
300 0   0     0 my $d = $options_r->{'delimiter'} || "\t";
301 0         0 foreach my $track ($this->tracks) {
302 0         0 foreach my $event (@{ $track->events_r }) {
  0         0  
303 0         0 print( join($d, @$event), "\n" );
304             }
305             }
306 0         0 return;
307             }
308              
309 0         0 print "MIDI::Opus->new({\n",
310             " 'format' => ", &MIDI::_dump_quote($this->{'format'}), ",\n",
311             " 'ticks' => ", &MIDI::_dump_quote($this->{'ticks'}), ",\n";
312              
313 0         0 my @tracks = $this->tracks;
314 0 0       0 if( $options_r->{'dump_tracks'} ) {
315 0         0 print " 'tracks' => [ # ", scalar(@tracks), " tracks...\n\n";
316 0         0 foreach my $x (0 .. $#tracks) {
317 0         0 my $track = $tracks[$x];
318 0         0 print " # Track \#$x ...\n";
319 0 0       0 if(ref($track)) {
320 0         0 $track->dump($options_r);
321             } else {
322 0         0 print " # \[$track\] is not a reference!!\n";
323             }
324             }
325 0         0 print " ]\n";
326             } else {
327 0         0 print " 'tracks' => [ ], # ", scalar(@tracks), " tracks (not dumped)\n";
328             }
329 0         0 print "});\n";
330 0         0 return 1;
331             }
332              
333             ###########################################################################
334             # And now the real fun...
335             ###########################################################################
336              
337             =item the method $opus->write_to_file('filespec', { ...options...} )
338              
339             Writes $opus as a MIDI file named by the given filespec.
340             The options hash is optional, and whatever you specify as options
341             percolates down to the calls to MIDI::Event::encode -- which see.
342             Currently this just opens the file, calls $opus->write_to_handle
343             on the resulting filehandle, and closes the file.
344              
345             =cut
346              
347             sub write_to_file { # method
348             # call as $opus->write_to_file("../../midis/stuff1.mid", { ..options..} );
349 2     2 1 211 my $opus = $_[0];
350 2         4 my $destination = $_[1];
351 2 50       10 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
352              
353 2 50       8 croak "No output file specified" unless length($destination);
354 2 50       347 unless(open(OUT_MIDI, ">$destination")) {
355 0         0 croak "Can't open $destination for writing\: \"$!\"\n";
356             }
357 2         15 $opus->write_to_handle( *OUT_MIDI{IO}, $options_r);
358 2 50       223 close(OUT_MIDI)
359             || croak "Can't close filehandle for $destination\: \"$!\"\n";
360 2         18 return; # nothing useful to return
361             }
362              
363             sub read_from_file { # method, surprisingly enough
364             # $opus->read_from_file("ziz1.mid", {'stuff' => 1}).
365             # Overwrites the contents of $opus with the contents of the file ziz1.mid
366             # $opus is presumably newly initted.
367             # The options hash is optional.
368             # This is currently meant to be called by only the
369             # MIDI::Opus->new() constructor.
370              
371 9     9 0 22 my $opus = $_[0];
372 9         20 my $source = $_[1];
373 9 50       60 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
374              
375 9 50       42 croak "No source file specified" unless length($source);
376 9 50       493 unless(open(IN_MIDI, "<$source")) {
377 0         0 croak "Can't open $source for reading\: \"$!\"\n";
378             }
379 9         109 my $size = -s $source;
380 9 50       35 $size = undef unless $size;
381              
382 9         71 $opus->read_from_handle(*IN_MIDI{IO}, $options_r, $size);
383             # Thanks to the EFNet #perl cabal for helping me puzzle out "*IN_MIDI{IO}"
384 9 50       218 close(IN_MIDI) ||
385             croak "error while closing filehandle for $source\: \"$!\"\n";
386              
387 9         42 return $opus;
388             }
389              
390             =item the method $opus->write_to_handle(IOREF, { ...options...} )
391              
392             Writes $opus as a MIDI file to the IO handle you pass a reference to
393             (example: C<*STDOUT{IO}>).
394             The options hash is optional, and whatever you specify as options
395             percolates down to the calls to MIDI::Event::encode -- which see.
396             Note that this is probably not what you'd want for sending music
397             to C, since MIDI files are not MIDI-on-the-wire.
398              
399             =cut
400              
401             ###########################################################################
402             sub write_to_handle { # method
403             # Call as $opus->write_to_handle( *FH{IO}, { ...options... });
404 2     2 1 6 my $opus = $_[0];
405 2         4 my $fh = $_[1];
406 2 50       18 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
407              
408 2         15 binmode($fh);
409              
410 2         13 my $tracks = scalar( $opus->tracks );
411 2 50       9 carp "Writing out an opus with no tracks!\n" if $tracks == 0;
412              
413 2         2 my $format;
414 2 50       9 if( defined($opus->{'format'}) ) {
415 2         15 $format = $opus->{'format'};
416             } else { # Defaults
417 0 0       0 if($tracks == 0) {
    0          
418 0         0 $format = 2; # hey, why not?
419             } elsif ($tracks == 1) {
420 0         0 $format = 0;
421             } else {
422 0         0 $format = 1;
423             }
424             }
425 2 50       8 my $ticks =
426             defined($opus->{'ticks'}) ? $opus->{'ticks'} : 96 ;
427             # Ninety-six ticks per quarter-note seems a pleasant enough default.
428              
429 2         48 print $fh (
430             "MThd\x00\x00\x00\x06", # header; 6 bytes follow
431             pack('nnn', $format, $tracks, $ticks)
432             );
433 2         7 foreach my $track (@{ $opus->{'tracks'} }) {
  2         7  
434 2         6 my $data = '';
435 2         10 my $type = substr($track->{'type'} . "\x00\x00\x00\x00", 0, 4);
436             # Force it to be 4 chars long.
437 2         4 $data = ${ $track->encode( $options_r ) };
  2         13  
438             # $track->encode will handle the issue of whether
439             # to use the track's data or its events
440 2         42 print $fh ($type, pack('N', length($data)), $data);
441             }
442 2         9 return;
443             }
444              
445             ############################################################################
446             sub read_from_handle { # a method, surprisingly enough
447             # $opus->read_from_handle(*STDIN{IO}, {'stuff' => 1}).
448             # Overwrites the contents of $opus with the contents of the MIDI file
449             # from the filehandle you're passing a reference to.
450             # $opus is presumably newly initted.
451             # The options hash is optional.
452              
453             # This is currently meant to be called by only the
454             # MIDI::Opus->new() constructor.
455              
456 9     9 0 21 my $opus = $_[0];
457 9         21 my $fh = $_[1];
458 9 50       45 my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {};
459 9         16 my $file_size_left;
460 9 50       77 $file_size_left = $_[3] if defined $_[3];
461              
462 9         51 binmode($fh);
463              
464 9         25 my $in = '';
465              
466 9         24 my $track_size_limit;
467 9 50       41 $track_size_limit = $options_r->{'track_size'}
468             if exists $options_r->{'track_size'};
469              
470 9 50       298 croak "Can't even read the first 14 bytes from filehandle $fh"
471             unless read($fh, $in, 14);
472             # 14 = The expected header length.
473              
474 9 50       38 if(defined $file_size_left) {
475 9         23 $file_size_left -= 14;
476             }
477              
478 9         80 my($id, $length, $format, $tracks_expected, $ticks) = unpack('A4Nnnn', $in);
479              
480 9 50       37 croak "data from handle $fh doesn't start with a MIDI file header"
481             unless $id eq 'MThd';
482 9 50       60 croak "Unexpected MTHd chunk length in data from handle $fh"
483             unless $length == 6;
484 9         23 $opus->{'format'} = $format;
485 9         23 $opus->{'ticks'} = $ticks; # ...which may be a munged 'negative' number
486 9         23 $opus->{'tracks'} = [];
487              
488 9 50       50 print "file header from handle $fh read and parsed fine.\n" if $Debug;
489 9         17 my $track_count = 0;
490              
491             Track_Chunk:
492 9         194 until( eof($fh) ) {
493 15         41 ++$track_count;
494 15 50       50 print "Reading Track \# $track_count into a new track\n" if $Debug;
495              
496 15 50       45 if(defined $file_size_left) {
497 15         24 $file_size_left -= 2;
498 15 50       48 croak "reading further would exceed file_size_limit"
499             if $file_size_left < 0;
500             }
501              
502 15         27 my($header, $data);
503 15 50       81 croak "Can't read header for track chunk \#$track_count"
504             unless read($fh, $header, 8);
505 15         59 my($type, $length) = unpack('A4N', $header);
506              
507 15 50 33     57 if(defined $track_size_limit and $track_size_limit > $length) {
508 0         0 croak "Track \#$track_count\'s length ($length) would"
509             . " exceed track_size_limit $track_size_limit";
510             }
511              
512 15 50       55 if(defined $file_size_left) {
513 15         22 $file_size_left -= $length;
514 15 50       43 croak "reading track \#$track_count (of length $length) "
515             . "would exceed file_size_limit"
516             if $file_size_left < 0;
517             }
518              
519 15         70 read($fh, $data, $length); # whooboy, actually read it now
520              
521 15 50       53 if($length == length($data)) {
522 15         101 push(
523 15         23 @{ $opus->{'tracks'} },
524             &MIDI::Track::decode( $type, \$data, $options_r )
525             );
526             } else {
527 0         0 croak
528             "Length of track \#$track_count is off in data from $fh; "
529             . "I wanted $length\, but got "
530             . length($data);
531             }
532             }
533              
534             carp
535 9 50       58 "Header in data from $fh says to expect $tracks_expected tracks, "
536             . "but $track_count were found\n"
537             unless $tracks_expected == $track_count;
538 9 50       832 carp "No tracks read in data from $fh\n" if $track_count == 0;
539              
540 9         33 return $opus;
541             }
542             ###########################################################################
543              
544             =item the method $opus->draw({ ...options...})
545              
546             This currently experimental method returns a new GD image object that's
547             a graphic representation of the notes in the given opus. Options include:
548             C -- the width of the image in pixels (defaults to 600);
549             C -- a six-digit hex RGB representation of the background color
550             for the image (defaults to $MIDI::Opus::BG_color, currently '000000');
551             C -- a reference to a list of colors (in six-digit hex RGB)
552             to use for representing notes on given channels.
553             Defaults to @MIDI::Opus::Channel_colors.
554             This list is a list of pairs of colors, such that:
555             the first of a pair (color N*2) is the color for the first pixel in a
556             note on channel N; and the second (color N*2 + 1) is the color for the
557             remaining pixels of that note. If you specify only enough colors for
558             channels 0 to M, notes on a channels above M will use 'recycled'
559             colors -- they will be plotted with the color for channel
560             "channel_number % M" (where C<%> = the MOD operator).
561              
562             This means that if you specify
563              
564             channel_colors => ['00ffff','0000ff']
565              
566             then all the channels' notes will be plotted with an aqua pixel followed
567             by blue ones; and if you specify
568              
569             channel_colors => ['00ffff','0000ff', 'ff00ff','ff0000']
570              
571             then all the I channels' notes will be plotted with an aqua
572             pixel followed by blue ones, and all the I channels' notes will
573             be plotted with a purple pixel followed by red ones.
574              
575             As to what to do with the object you get back, you probably want
576             something like:
577              
578             $im = $chachacha->draw;
579             open(OUT, ">$gif_out"); binmode(OUT);
580             print OUT $im->gif;
581             close(OUT);
582              
583             Using this method will cause a C if it can't successfully C.
584              
585             I emphasise that C is expermental, and, in any case, is only meant
586             to be a crude hack. Notably, it does not address well some basic problems:
587             neither volume nor patch-selection (nor any notable aspects of the
588             patch selected)
589             are represented; pitch-wheel changes are not represented;
590             percussion (whether on percussive patches or on channel 10) is not
591             specially represented, as it probably should be;
592             notes overlapping are not represented at all well.
593              
594             =cut
595              
596             sub draw { # method
597 0     0 1   my $opus = $_[0];
598 0 0         my $options_r = ref($_[1]) ? $_[1] : {};
599              
600 0           &use_GD(); # will die at runtime if we call this function but it can't use GD
601              
602 0           my $opus_time = 0;
603 0           my @scores = ();
604 0           foreach my $track ($opus->tracks) {
605 0           my($score_r, $track_time) = MIDI::Score::events_r_to_score_r(
606             $track->events_r );
607 0 0         push(@scores, $score_r) if @$score_r;
608 0 0         $opus_time = $track_time if $track_time > $opus_time;
609             }
610              
611 0   0       my $width = $options_r->{'width'} || 600;
612              
613 0 0         croak "opus can't be drawn because it takes no time" unless $opus_time;
614 0           my $pixtix = $opus_time / $width; # Number of ticks a pixel represents
615              
616 0           my $im = GD::Image->new($width,127);
617             # This doesn't handle pitch wheel, nor does it tread things on channel 10
618             # (percussion) as specially as it probably should.
619             # The problem faced here is how to map onto pixel color all the
620             # characteristics of a note (say, Channel, Note, Volume, and Patch).
621             # I'll just do it for channels. Rewrite this on your own if you want
622             # something different.
623              
624 0 0         my $bg_color =
625             $im->colorAllocate(unpack('C3', pack('H2H2H2',unpack('a2a2a2',
626             ( length($options_r->{'bg_color'}) ? $options_r->{'bg_color'}
627             : $MIDI::Opus::BG_color)
628             ))) );
629 0 0         @MIDI::Opus::Channel_colors = ( '00ffff' , '0000ff' )
630             unless @MIDI::Opus::Channel_colors;
631 0           my @colors =
632             map( $im->colorAllocate(
633             unpack('C3', pack('H2H2H2',unpack('a2a2a2',$_)))
634             ), # convert 6-digit hex to a scalar tuple
635             ref($options_r->{'channel_colors'}) ?
636 0 0         @{$options_r->{'channel_colors'}} : @MIDI::Opus::Channel_colors
637             );
638 0           my $channels_in_palette = int(@colors / 2);
639 0           $im->fill(0,0,$bg_color);
640 0           foreach my $score_r (@scores) {
641 0           foreach my $event_r (@$score_r) {
642 0 0         next unless $event_r->[0] eq 'note';
643 0           my($time, $duration, $channel, $note, $volume) = @{$event_r}[1,2,3,4,5];
  0            
644 0           my $y = 127 - $note;
645 0           my $start_x = $time / $pixtix;
646 0           $im->line($start_x, $y, ($time + $duration) / $pixtix, $y,
647             $colors[1 + ($channel % $channels_in_palette)] );
648 0           $im->setPixel($start_x , $y, $colors[$channel % $channels_in_palette] );
649             }
650             }
651 0           return $im; # Returns the GD object, which the user then dumps however
652             }
653              
654             #--------------------------------------------------------------------------
655             { # Closure so we can use this wonderful variable:
656             my $GD_used = 0;
657             sub use_GD {
658 0 0   0 0   return if $GD_used;
659 0 0         eval("use GD;"); croak "You don't seem to have GD installed." if $@;
  0            
660 0           $GD_used = 1; return;
  0            
661             }
662             # Why use GD at runtime like this, instead of at compile-time like normal?
663             # So we can still use everything in this module except &draw even if we
664             # don't have GD on this system.
665             }
666              
667             ######################################################################
668             # This maps channel number onto colors for draw(). It is quite unimaginative,
669             # and reuses colors two or three times. It's a package global. You can
670             # change it by assigning to @MIDI::Simple::Channel_colors.
671              
672             @MIDI::Opus::Channel_colors =
673             (
674             'c0c0ff', '6060ff', # start / sustain color, channel 0
675             'c0ffc0', '60ff60', # start / sustain color, channel 1, etc...
676             'ffc0c0', 'ff6060', 'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60',
677             'c0ffff', '60ffff',
678            
679             'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060',
680             'c0c0c0', '707070', # channel 10
681            
682             'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', 'c0ffff', '60ffff',
683             'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060',
684             );
685             $MIDI::Opus::BG_color = '000000'; # Black goes with everything, you know.
686              
687             ###########################################################################
688              
689             =back
690              
691             =head1 WHERE'S THE DESTRUCTOR?
692              
693             Because MIDI objects (whether opuses or tracks) do not contain any
694             circular data structures, you don't need to explicitly destroy them in
695             order to deallocate their memory. Consider this code snippet:
696              
697             use MIDI;
698             foreach $one (@ARGV) {
699             my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 });
700             print "$one has ", scalar( $opus->tracks ) " tracks\n";
701             }
702              
703             At the end of each iteration of the foreach loop, the variable $opus
704             goes away, along with its contents, a reference to the opus object.
705             Since no other references to it exist (i.e., you didn't do anything like
706             push(@All_opuses,$opus) where @All_opuses is a global), the object is
707             automagically destroyed and its memory marked for recovery.
708              
709             If you wanted to explicitly free up the memory used by a given opus
710             object (and its tracks, if those tracks aren't used anywhere else) without
711             having to wait for it to pass out of scope, just replace it with a new
712             empty object:
713              
714             $opus = MIDI::Opus->new;
715              
716             or replace it with anything at all -- or even just undef it:
717              
718             undef $opus;
719              
720             Of course, in the latter case, you can't then use $opus as an opus
721             object anymore, since it isn't one.
722              
723             =head1 NOTE ON TICKS
724              
725             If you want to use "negative" values for ticks (so says the spec: "If
726             division is negative, it represents the division of a second
727             represented by the delta-times in the file,[...]"), then it's up to
728             you to figure out how to represent that whole ball of wax so that when
729             it gets C'd as an "n", it comes out right. I think it'll involve
730             something like:
731              
732             $opus->ticks( (unpack('C', pack('c', -25)) << 8) & 80 );
733              
734             for bit resolution (80) at 25 f/s.
735              
736             But I've never tested this. Let me know if you get it working right,
737             OK? If anyone I get it working right, and tells me how, I'll
738             try to support it natively.
739              
740             =head1 NOTE ON WARN-ING AND DIE-ING
741              
742             In the case of trying to parse a malformed MIDI file (which is not a
743             common thing, in my experience), this module (or MIDI::Track or
744             MIDI::Event) may warn() or die() (Actually, carp() or croak(), but
745             it's all the same in the end). For this reason, you shouldn't use
746             this suite in a case where the script, well, can't warn or die -- such
747             as, for example, in a CGI that scans for text events in a uploaded
748             MIDI file that may or may not be well-formed. If this I the kind
749             of task you or someone you know may want to do, let me know and I'll
750             consider some kind of 'no_die' parameter in future releases.
751             (Or just trap the die in an eval { } around your call to anything you
752             think you could die.)
753              
754             =head1 COPYRIGHT
755              
756             Copyright (c) 1998-2002 Sean M. Burke. All rights reserved.
757              
758             This library is free software; you can redistribute it and/or
759             modify it under the same terms as Perl itself.
760              
761             =head1 AUTHORS
762              
763             Sean M. Burke C (until 2010)
764              
765             Darrell Conklin C (from 2010)
766              
767             =cut
768              
769             1;
770             __END__