home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Opus.pm < prev    next >
Encoding:
Perl POD Document  |  2002-11-16  |  24.4 KB  |  743 lines

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