package MIDI::Tweaks;

use warnings;
use strict;

=head1 NAME

MIDI::Tweaks - Enhancements to MIDI.pm.

=cut

our $VERSION = '0.07';

use MIDI;
use Carp;

# These are valid for all events.
use constant EV_TYPE	     => 0;
use constant EV_TIME	     => 1;
# These are for events that apply to a channel only.
use constant EV_CHAN	     => 2;
# These are for note events.
use constant EV_NOTE_PITCH   => 3;
use constant EV_NOTE_VELO    => 4;
# These if for track_name events.
use constant EV_MARKER_NAME  => 2;

# Drum channel
use constant MIDI_CHAN_PERCUSSION => 10;

use base qw(Exporter);

our @EXPORT;
our @EXPORT_OK;

BEGIN {
    @EXPORT = qw(EV_TYPE EV_TIME EV_CHAN EV_NOTE_PITCH EV_NOTE_VELO EV_MARKER_NAME);
    @EXPORT_OK = qw(is_note_event is_note_on is_note_off is_channel_event);
}

=head1 SYNOPSIS

This module implements a number of MIDI tweaks using the Sean Burke's
MIDI module.

    # Read midi data.
    my $op = new MIDI::Tweaks::Opus ({ from_file => "orig.mid" });

    # Reset all volume controls.
    $_->change_volume({ value => 100 }) foreach $op->tracks;

    # Slowdown a bit.
    $op->change_tempo({ ratio => 0.9 });

    # Prepare the individual tracks.
    my $track0  = $op->tracks_r->[0];
    my $acc	= $op->tracks_r->[1]->change_velocity({ value =>  30 });
    my $solo    = $op->tracks_r->[2]->change_velocity({ value => 110 });
    my $high    = $op->tracks_r->[3]->change_velocity({ value => 100 });
    my $low	= $op->tracks_r->[4]->change_velocity({ value => 100 });

    # $low contains the middle + lower parts. Split.
    (my $mid, $low) = $low->split_hilo;

    # Produce a midi for low voice only.
    $op->tracks($track0, $acc, $low);
    $op->write_to_file("low.mid");


Warning: This module is still under development. The interface to the
methods may change when new features are added.

Two scripts are provided when installing this module:

  midi-tweak: applies some tweaks to MIDI files

  midi-dump: dumps contents of a MIDI file in an understandable format

=head1 CONSTANTS

The following constants will be exported by default.

=head2 EV_TYPE

The offset in an event (array ref) of the type information.

=head2 EV_TIME

The offset in an event (array ref) of the delta time.

=head2 EV_CHAN

The offset in an event (array ref) of the channel.

=head2 EV_NOTE_PITCH

The offset in a note event of the pitch.

=head2 EV_NOTE_VELO

The offset in a note event of the velocity.

=head2 EV_MARKER_NAME

The offset in a marker event of the name.

=head1 FUNCTIONS

The following functions can be exported on demand.

=head2 MIDI::Tweaks::is_note_event

Function. Takes an event (array reference) as argument.
Returns true if the event is a 'note on' or 'note off' event.

=cut

sub is_note_event {
    my ($e) = shift;
    $e->[EV_TYPE] =~ /^note_o(n|ff)$/;
}

=head2 MIDI::Tweaks::is_note_on

Function. Takes an event (array reference) as argument.
Returns true if the event is a 'note on' event with a non-zero velocity.

=cut

sub is_note_on {
    my ($e) = shift;
    $e->[EV_TYPE] eq 'note_on' && $e->[EV_NOTE_VELO];
}

=head2 MIDI::Tweaks::is_note_off

Function. Takes an event (array reference) as argument.
Returns true if the event is a 'note off' event, or a 'note on' event
with zero velocity.

=cut

sub is_note_off {
    my ($e) = shift;
    $e->[EV_TYPE] eq 'note_off'
      || $e->[EV_TYPE] eq 'note_on' && !$e->[EV_NOTE_VELO];
}

=head2 MIDI::Tweaks::is_channel_event

Function. Takes an event (array reference) as argument.
Returns true if the event aqpplies to specific channel.

=cut

my $evpat;
INIT {
    $evpat = qr/^
		  note_off
		| note_on
		| key_after_touch
		| control_change
		| patch_change
		| channel_after_touch
		| pitch_wheel_change
		$/x;
}

sub is_channel_event {
    my ($e) = shift;
    $e->[EV_TYPE] =~ $evpat;
}

=head1 OPUS METHODS

=cut

package MIDI::Tweaks::Opus;

use strict;
use warnings;
use base qw(MIDI::Opus);
use MIDI::Tweaks;
use Carp;

=head2 MIDI::Tweaks::Opus::new

Method. Does whatever MIDI::Opus::new does, but checks for sanity and
produces an Opus with absolute time stamps.

The options hash may contain a key C<require_sanity> that controls the
level of sanity checking:

  0:    no checking
  1:    normal checking
  warn: normal checking, but warn instead of die

=cut

sub new {
    my $pkg = shift;

    my $args = $_[0] ? { %{$_[0]} } : {};
    my $require_sanity = delete($args->{require_sanity});
    $require_sanity = 1 unless defined $require_sanity;

    my $op = $pkg->SUPER::new($args);

    $op->delta2time;
    $op->check_sanity({ strict => $require_sanity }) if $require_sanity;

    return $op;
}

=head2 MIDI::Tweaks::Opus::write_to_handle

Method. Copies the Opus, converts the time stamps to delta times and
passes the result to MIDI::Opus::write_to_handle.

Note that this method is used internally by write_to_file.

=cut

sub write_to_handle {
    my $op = shift->copy;
    $op->time2delta;
    $op->SUPER::write_to_handle(@_);
}

=head2 MIDI::Tweaks::Opus::dump

Method. Copies the Opus, converts the time stamps to delta times and
passes the result to MIDI::Opus::dump.

=cut

sub dump {
    my $op = shift->copy;
    $op->time2delta;
    $op->SUPER::dump(@_);
}

=head2 MIDI::Tweaks::Opus::check_sanity

Method, internal. Verifies that the MIDI data obeys certain criteria
that make it suitable for tweaking. In particular, there must be a
one-to-one relationship between tracks and channels.

This method is called internally by the MIDI::Tweaks::Opus::new method.

=cut

sub check_sanity {
    my ($self, $args) = @_;
    $args ||= {};

    my $strict = 1;
    if ( $args->{strict} ) {
	$strict = delete $args->{strict};	# 1, or 'warn'
    }

    my @channel_seen;
    my $fail;
    my $tn = 1;
    foreach my $track ( $self->tracks ) {
	my $chan;
	my $noteon;
	foreach ( $track->events ) {
	    next unless MIDI::Tweaks::is_channel_event($_);
	    if ( defined $chan ) {
		if ( $_->[EV_CHAN] != $chan ) {
		    carp("Sanity failure: track $tn controls channels ",
			 $chan+1,
			 " and ",
			 $_->[EV_CHAN]+1);
		    $fail++;
		}
	    }
	    else {
		$chan = $_->[EV_CHAN];
		if ( $channel_seen[$chan] ) {
		    carp("Sanity failure: channel ",
			 $chan+1,
			 " is controlled by tracks ",
			 $channel_seen[$chan],
			 " and $tn");
		    $fail++;
		}
		$channel_seen[$chan] = $tn;
	    }
	    if ( MIDI::Tweaks::is_note_on($_) ) {
		if ( defined $noteon->[$_->[EV_NOTE_PITCH]] ) {
		    carp("Sanity warning: track $tn, time $_->[EV_TIME], "
			 . "note $_->[EV_NOTE_PITCH] already on (since "
			 . $noteon->[$_->[EV_NOTE_PITCH]] . ")");
		}
		else {
		    $noteon->[$_->[EV_NOTE_PITCH]] = $_->[EV_TIME];
		}
	    }
	    elsif ( MIDI::Tweaks::is_note_off($_) ) {
		if ( defined $noteon->[$_->[EV_NOTE_PITCH]] ) {
		    $noteon->[$_->[EV_NOTE_PITCH]] = undef;
		}
		else {
		    carp("Sanity warning: track $tn, time $_->[EV_TIME], "
			 . "note $_->[EV_NOTE_PITCH] not on");
		}
	    }
	}
	foreach my $i ( 0 .. $#{$noteon} ) {
	    next unless defined $noteon->[$i];
	    carp("Sanity failure: track $tn, "
			 . "unfinished note $i (on since $noteon->[$i])");
	    $fail++;
	}
	$tn++;
    }
    if ( $fail ) {
	return if $strict eq 'warn';
	croak("Sanity check failed");
    }
    return 1;
}

=head2 MIDI::Tweaks::Opus::delta2time

Method, internal. Modifies the Opus by changing the delta times of all
events of all tracks to an absolute time value.

This method is called internally by the MIDI::Tweaks::Opus::new method.

THIS MAKES THE OPUS NO LONGER DIRECTLY VALID FOR MIDI. When this
method has been applied to an Opus it should be undone later by a call
to time2delta. This is handled transparently by the
MIDI::Tweaks::Opus::write_to_file and MIDI::Tweaks::Opus::dump
methods.

=cut

sub delta2time {
    my ($self) = @_;
    foreach my $track ( $self->tracks ) {
	$track->delta2time;
    }
}

=head2 MIDI::Tweaks::Opus::time2delta

Method, internal. Modifies the Opus by making all time events relative
(delta times).

This method undoes the effect of a previous delta2time, making the
Opus valid MIDI data again.

This method is called internally by MIDI::Tweaks::Opus::write_to_file and
MIDI::Tweaks::Opus::dump methods.

=cut

sub time2delta {
    my ($self) = @_;
    foreach my $track ( $self->tracks ) {
	$track->time2delta;
    }
}

=head2 MIDI::Tweaks::Opus::change_pitch

Method. One argument, the options hash.

Modifies the pitch of the Opus.

This method just calls MIDI::Track::change_pitch on all tracks. See
L<MIDI::Track::change_pitch> for details. It skips the track
associated with channel 9 which is typically associated with
percussion.

=cut

sub change_pitch {
    my $self = shift;
    foreach my $track ( $self->tracks ) {
	next if $track->channel == MIDI::Tweaks::MIDI_CHAN_PERCUSSION; # skip drums
	$track->change_pitch(@_);
    }
}

=head2 MIDI::Tweaks::Opus::change_tempo

Method. One argument, the options hash.

Modifies the tempo settings of the Opus.

The options has must contain either C<< value => number >> or C<<
ratio => number >>. In the first case, the tempo is set to the
specified value (beats per minute). In the second case, the tempo is
changed according to the ratio.

=cut

sub change_tempo {
    my $self = shift;
    foreach my $track ( $self->tracks ) {
	$track->change_tempo(@_);
    }
}

# We need to override MIDI::Opus::dump for this to work...

no warnings qw(redefine once);

sub MIDI::Opus::dump { # method; read-only
  my $this = $_[0];
  my %info = $this->info();
  my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {};

  if($options_r->{'flat'}) { # Super-barebones dump mode
    my $d = $options_r->{'delimiter'} || "\t";
    foreach my $track ($this->tracks) {
      foreach my $event (@{ $track->events_r }) {
	print( join($d, @$event), "\n" );
      }
    }
    return;
  }

  # This is the only change to the original code: replace the
  # hard-wired class name MIDI::Opus with ref($this), so derived
  # classes work.
  # WAS: print "MIDI::Opus->new({\n",
  # IS NOW:
  print ref($this), "->new({\n",
  # End of change.
    "  'format' => ", &MIDI::_dump_quote($this->{'format'}), ",\n",
    "  'ticks'  => ", &MIDI::_dump_quote($this->{'ticks'}), ",\n";

  my @tracks = $this->tracks;
  if( $options_r->{'dump_tracks'} ) {
    print "  'tracks' => [   # ", scalar(@tracks), " tracks...\n\n";
    foreach my $x (0 .. $#tracks) {
      my $track = $tracks[$x];
      print "    # Track \#$x ...\n";
      if(ref($track)) {
        $track->dump($options_r);
      } else {
        print "    # \[$track\] is not a reference!!\n";
      }
    }
    print "  ]\n";
  } else {
    print "  'tracks' => [ ],  # ", scalar(@tracks), " tracks (not dumped)\n";
  }
  print "});\n";
  return 1;
}

=head1 TRACK METHODS

=cut

# We cannot use package MIDI::Track, since that is owbed by MIDI.pm.
package MIDI::Tweaks;

use strict;
use warnings;
use Carp;

=head2 MIDI::Track::name

Method. Returns the first track name as designated by an 'track name' event.
If none was found, returns undef.

=cut

sub MIDI::Track::name {
    my $track = shift;
    foreach my $e ( $track->events ) {
	return $e->[EV_MARKER_NAME]
	  if $e->[EV_TYPE] eq 'track_name';
    }
    return;
}

=head2 MIDI::Track::channel

Method. Returns the channel controlled by this track.
If none was found, returns zero.

Note that channels are numbered from one, as per MIDI standard.

=cut

sub MIDI::Track::channel {
    my $track = shift;
    foreach my $e ( $track->events ) {
	next unless MIDI::Tweaks::is_channel_event($e);
	return $e->[EV_CHAN] + 1;
    }
    return 0;
}

=head2 MIDI::Track::delta2time

Method, internal. Modifies the track by changing the delta times of
all events to an absolute time value.

THIS MAKES THE TRACK NO LONGER VALID FOR MIDI. When this method has
been applied to a track it should be undone later by a call to
time2delta.

=cut

sub MIDI::Track::delta2time {
    my ($self, $force) = @_;

    if ( $self->{_tweaky_abstime} ) {
	croak("MIDI::Track::delta2time: Already abstime")
	  unless $force;
    }

    my $time = 0;		# time until now
    foreach my $e ( $self->events ) {
	$time = $e->[EV_TIME] += $time;
    }

    $self->{_tweaky_abstime} = 1;

    # For convenience:
    return $self;
}

=head2 MIDI::Track::time2delta

Method, internal. Modifies the track by making all time events
relative (delta times).

This method undoes the effect of a previous delta2time, making the
track valid MIDI data again.

=cut

sub MIDI::Track::time2delta {
    my ($self, $force) = @_;

    unless ( $self->{_tweaky_abstime} ) {
	croak("MIDI::Track::delta2time: Already delta time")
	  unless $force;
    }

    my $time = 0;		# time until now
    foreach my $e ( $self->events ) {
	carp("NEGATIVE DELTA \@ $time: @{[$e->[EV_TIME]-$time]}\n")
	  if $e->[EV_TIME] < $time;
	# Make time relative.
	($time, $e->[EV_TIME]) = ($e->[EV_TIME], $e->[EV_TIME]-$time);
    }

    delete $self->{_tweaky_abstime};

    # For convenience:
    return $self;
}

=head2 MIDI::Track::has_deltatime

Method, internal. Returns true if the track events have delta time
stamps.

This method is not fail safe, i.e., it can return thw wrong result if
a track does not have sensible events.

=cut

sub MIDI::Track::has_deltatime {
    my ($self) = @_;
    my $time = 0;
    foreach my $e ( $self->events ) {
	return 1 if $e->[EV_TIME] < $time;
	$time = $e->[EV_TIME];
    }
    return;
}

=head2 MIDI::Track::mapper

Method. One or two arguments.
First argument is optional: an options hash.
Second, or only, argument must be a code ref.

Applies to code ref to all events of
the track. Returns the track (for convenience);

Note that if the code ref modifies the event, this actually modifies
the track. If this is not desired, copy it first, or use
C<< copy => 1 >> in the options hash.

The code ref gets two arguments, the event (an array ref), and the
remainder of the options hash.

Examples:

   $track->mapper(sub { print $_->[0] });
   $new = $track->mapper({ copy => 1 },
                         sub { $_->[1] += 10 });

=cut

sub MIDI::Track::mapper {
    my $track = shift;

    my $opts = {};
    $opts = {%{shift()}} if ref($_[0]) eq 'HASH';

    my $mapper = shift;
    croak("MIDI::Track::mapper requires a CODE argument")
      unless ref($mapper) eq 'CODE';

    $track = $track->copy if delete $opts->{copy};

    foreach ( $track->events ) {
	$mapper->($_, $opts);
    }

    $track;
}

=head2 MIDI::Track::change_pitch

Method. One argument, the options hash.

Changes the pitch of each 'note on' event according to the options.

The options has must contain C<< int => number >>. The number
indicates the number of half-tones the pitch should be raised. A
negative number will lower the pitch.
Any remaining options are passed to the mapper function.

Note that key signatures will be changed as well.

=cut

sub MIDI::Track::change_pitch {
    my ($track, $args) = @_;
    croak("MIDI::Track::change_pitch requires a HASH argument")
      unless ref($args) eq 'HASH';
    $args = {%$args};

    my $mapper_func;
    #         C   Db  D   Es  E   F   Gb  G   As  A   Bb  B
    my @k = ( 0, -5,  2, -3,  4, -1, -6,  1, -4,  3, -2,  5);
    my %k; $k{$k[$_]} = $_ for 0 .. $#k;

    if ( $args->{int} ) {
	my $value = int(delete $args->{int});

	$mapper_func = sub {
	    if ( MIDI::Tweaks::is_note_event($_[0]) ) {
		$_[0]->[EV_NOTE_PITCH] += $value;
		croak("MIDI::Track::change_pitch: transposed pitch out of range")
		  unless $_[0]->[EV_NOTE_PITCH] >= 0 && $_[0]->[EV_NOTE_PITCH] <= 127;
		return;
	    }
	    if ( $_[0]->[0] eq 'key_signature' ) {
		# Warning: ugly code ahead.
		# This is expected to be run only a few times.
		# Don't spent much effort on elegance and optimizing.
		my $f = $_[0]->[2];	 # current #sharps
		$f -= 12 if $f >= 6;	 # normalize
		$f += 12 if $f < -6;
		$f = $k{$f};		 # get note
		$f += $value;		 # transpose
		$f -= 12 while $f >= 12; # normalize
		$f += 12 while $f < 0;
		$_[0]->[2] = $k[$f];	 # get #sharps
		return;
	    }
	};
    }

    croak("MIDI::Track::change_pitch: Missing 'value' or 'ratio' option")
      unless $mapper_func;

    $track->mapper($args, $mapper_func);
}

=head2 MIDI::Track::change_velocity

Method. One argument, the options hash.

Changes the velocity of each 'note on' event according to the options.

The options has must contain either C<< value => number >> or
C<< ratio => number >>. In the first case, the velocity is set to the
specified value (which must be a number between 0 and 127). In the
second case, the velocity is changed according to the ratio.

Any remaining options are passed to the mapper function.

Note that setting the velocity to zero effectively turns the 'note on'
events into 'note off' events.

Also note that tracks usually have an initial 'control_change' event
that controls the overall volume for a channel. Use change_volume to
change this setting.

=cut

sub MIDI::Track::change_velocity {
    my ($track, $args) = @_;
    croak("MIDI::Track::change_velocity requires a HASH argument")
      unless ref($args) eq 'HASH';
    $args = {%$args};

    my $mapper_func;

    if ( $args->{value} ) {
	my $value = int(delete $args->{value});
	croak("MIDI::Track::change_velocity: value should be between 0 and 127")
	  unless $value >= 0 && $value <= 127;

	$mapper_func = sub {
	    return unless MIDI::Tweaks::is_note_on($_[0]);
	    $_[0]->[EV_NOTE_VELO] = $value;
	};
    }
    elsif ( $args->{ratio} ) {
	my $ratio = delete $args->{ratio};
	$mapper_func = sub {
	    return unless MIDI::Tweaks::is_note_on($_[0]);
	    $_[0]->[EV_NOTE_VELO] = int($_[0]->[EV_NOTE_VELO] * $ratio);
	    $_[0]->[EV_NOTE_VELO] = 127 if $_[0]->[EV_NOTE_VELO] > 127;
	};
    }

    croak("MIDI::Track::change_velocity: Missing 'value' or 'ratio' option")
      unless $mapper_func;

    $track->mapper($args, $mapper_func);
}

=head2 MIDI::Track::change_tempo

Method. One argument, the options hash.

Changes the tempo of a trackaccording to the options.

The options has must contain either C<< value => number >> or C<<
ratio => number >>. In the first case, each occurence of a tempo event
is changed to the specified value. In the second case, the tempo is
changed according to the ratio.

Any remaining options are passed to the mapper function.

Note that usually track 0 controls the tempi for an opus.

=cut

sub MIDI::Track::change_tempo {
    my ($track, $args) = @_;
    croak("MIDI::Track::change_tempo requires a HASH argument")
      unless ref($args) eq 'HASH';
    $args = {%$args};

    my $mapper_func;

    if ( $args->{value} ) {
	my $value = int(60000000 / int(delete $args->{value}));

	$mapper_func = sub {
	    return unless $_[0]->[0] eq 'set_tempo';
	    $_[0]->[2] = $value;
	};
    }
    elsif ( $args->{ratio} ) {
	my $ratio = delete $args->{ratio};
	$mapper_func = sub {
	    return unless $_[0]->[0] eq 'set_tempo';
	    $_[0]->[2] = int($_[0]->[2] / $ratio);
	};
    }

    croak("MIDI::Track::change_tempo: Missing 'value' or 'ratio' option")
      unless $mapper_func;

    $track->mapper($args, $mapper_func);
}

=head2 MIDI::Track::change_volume

Method. One argument, the options hash.

Changes the volume of the channel.

The options has must contain either C<< value => number >> or
C<< ratio => number >>. In the first case, the volume is set to the
specified value (which must be a number between 0 and 127). In the
second case, the volume is changed according to the ratio.

Any remaining options are passed to the mapper function.

=cut

sub MIDI::Track::change_volume {
    my ($track, $args) = @_;
    croak("MIDI::Track::change_volume requires a HASH argument")
      unless ref($args) eq 'HASH';
    $args = {%$args};

    my $mapper_func;

    if ( $args->{value} ) {
	my $value = int(delete $args->{value});
	croak("MIDI::Track::change_volume: value should be between 0 and 127")
	  unless $value >= 0 && $value <= 127;

	$mapper_func = sub {
	    return unless
	      $_[0]->[0] eq 'control_change'
	      && $_[0]->[3] == 7;
	    $_[0]->[4] = $value;
	};
    }
    elsif ( $args->{ratio} ) {
	my $ratio = delete $args->{ratio};
	$mapper_func = sub {
	    return unless
	      $_[0]->[0] eq 'control_change'
	      && $_[0]->[3] == 7;
	    $_[0]->[4] = int($_[0]->[4] * $ratio);
	    $_[0]->[4] = 127 if $_[0]->[4] > 127;
	};
    }

    croak("MIDI::Track::change_volume: Missing 'value' or 'ratio' option")
      unless $mapper_func;

    $track->mapper($args, $mapper_func);
}

=head2 MIDI::Track::split_pitch

Method. One argument, the options hash.

The track is split into two tracks, depending on whether the pitch of
a note event is lower than a preset value. Non-note events are copied
to both tracks.

The options hash may contain C<< pitch => number >> to specify the
pitch value to split on. All notes whose pitches are less than the
split value are copied to the lower track, all other notes are copied
to the upper track.

Default value is 56. This is a suitable value to split a single MIDI
track containing a piano part into left hand and right hand tracks.

All events are copied, and the track is not modified.

This method returns a list, the higher track and the lower track.

=cut

sub MIDI::Track::split_pitch {
    my ($track, $args) = @_;
    $args ||= {};
    croak("MIDI::Track::split_pitch requires a HASH argument")
      unless ref($args) eq 'HASH';
    $args = {%$args};

    my $split ||= 56;

    if ( $args->{pitch} ) {
	$split = delete $args->{pitch};
	croak("MIDI::Track::split_pitch: split value should be between 0 and 127")
	  unless $split >= 0 && $split <= 127;
    }

    croak("MIDI::Track::split_pitch: unknown options: ".
	  join(" ", sort keys %$args)) if %$args;

    croak("MIDI::Track::split_pitch: FATAL: track has delta times")
      unless $track->{_tweaky_abstime};

    my @hi;
    my @lo;

    foreach ( $track->events ) {
	unless ( MIDI::Tweaks::is_note_event($_) ) {
	    # Copy.
	    push(@hi, [@$_]);
	    push(@lo, [@$_]);
	    next;
	}

	if ( $_->[EV_NOTE_PITCH] >= $split ) {
	    push(@hi, [@$_]);
	}
	else {
	    push(@lo, [@$_]);
	}
    }

    my $hi = MIDI::Track->new;
    $hi->type($track->type);
    $hi->events(@hi);
    $hi->{_tweaky_abstime} = 1;

    my $lo = MIDI::Track->new;
    $lo->type($track->type);
    $lo->events(@lo);
    $lo->{_tweaky_abstime} = 1;

    return ( $hi, $lo );
}

=head2 MIDI::Track::split_hilo

Method. No arguments.

The track is split into two tracks, high and low.

If there are two 'note on' (or 'note off') events at the same time,
the event with the highest pitch gets copied to the high track and the
other to the low track. If there's only one note, or if it is not a
note event, it gets copied to both tracks.

All events are copied, and the track is not modified.

This method returns a list (high track, low track).

NOTE: This process assumes that if there are two notes, they start and
end at the same time.

NOTE: This process discards all non-note events from the resultant
tracks. Sorry.

=cut

sub MIDI::Track::split_hilo {
    my ($track) = @_;

    croak("MIDI::Track::split_hilo: FATAL: track has delta times")
      unless $track->{_tweaky_abstime};

    my @hi;
    my @lo;
    my $eqtimes = sub { $_[0]->[EV_TIME] == $_[1]->[EV_TIME] };

    my @events = $track->events;
    while ( @events ) {
	my $this_event = shift(@events);
	my $next_event = $events[0];

	# Skip lyrics.
	next if $this_event->[EV_TYPE] =~ /^lyric$/;

	# Assert we're still in phase.
	unless ( @hi == @lo ) {
	    croak("!t1 = ", scalar(@hi), " events\n",
		  "!t2 = ", scalar(@lo), " events\n");
	}

	unless ( MIDI::Tweaks::is_note_event($this_event)
		 && @events && $eqtimes->($this_event, $next_event) ) {
	    # Copy.
	    push(@hi, [@$this_event]);
	    push(@lo, [@$this_event]);
	    next;
	}

	if ( MIDI::Tweaks::is_note_on($this_event)
	     && MIDI::Tweaks::is_note_on($next_event)
	     or
	     MIDI::Tweaks::is_note_off($this_event)
	     && MIDI::Tweaks::is_note_off($next_event) ) {

	    # Remove from events.
	    shift(@events);

	    if ( $this_event->[EV_NOTE_PITCH] > $next_event->[EV_NOTE_PITCH] ) {
		push(@hi, [@$this_event]);
		push(@lo, [@$next_event]);
	    }
	    else {
		push(@hi, [@$next_event]);
		push(@lo, [@$this_event]);
	    }
	}
	else {
	    # Not a multi-note, copy.
	    push(@hi, [@$this_event]);
	    push(@lo, [@$this_event]);
	}
    }

    my $hi = MIDI::Track->new;
    $hi->type($track->type);
    $hi->events(@hi);
    $hi->{_tweaky_abstime} = 1;

    my $lo = MIDI::Track->new;
    $lo->type($track->type);
    $lo->events(@lo);
    $lo->{_tweaky_abstime} = 1;

    return ( $hi, $lo );
}

=head2 MIDI::Track::split_hml

Method. No arguments.

The track is split into three tracks, high, middle and low.

If there are three 'note on' (or 'note off') events at the same time,
the event with the highest pitch gets copied to the high track, the
event with the lowest pitch gets copied to the low track, and the
other to the middle track.

If there are two 'note on' (or 'note off') events at the same time,
the event with the highest pitch gets copied to the high track and the
other to the middle and low tracks.

If there's only one note event at that time, or if it is not a note
event, it gets copied to all tracks.

All events are copied, and the track is not modified.

This method returns a list (high track, middle track, low track).

NOTE: This process assumes that if there are two or three notes, they
start and end at the same time.

NOTE: This process discards all non-note events from the resultant
tracks. Sorry.

=cut

sub MIDI::Track::split_hml {
    my ($track) = @_;

    croak("MIDI::Track::split_hml: FATAL: track has delta times")
      unless $track->{_tweaky_abstime};

    my @hi;
    my @md;
    my @lo;
    my $eqtimes = sub { $_[0]->[EV_TIME] == $_[1]->[EV_TIME] };

    my @events = $track->events;
    my $time = 0;

    while ( @events ) {
	my $this_event = shift(@events);
	my $next_event = $events[0];
	next if $this_event->[EV_TYPE] =~ /^lyric$/;

	unless ( @hi == @md && @md == @lo ) {
	    croak("!t1 = ", scalar(@hi), " events\n",
		  "!t2 = ", scalar(@md), " events\n",
		  "!t3 = ", scalar(@lo), " events\n");
	}

	$time = $this_event->[EV_TIME];

	if ( MIDI::Tweaks::is_note_event($this_event) ) {
	    # Check if there's a note already at this time.
	    if ( MIDI::Tweaks::is_note_on($this_event)
		 && @events && MIDI::Tweaks::is_note_on($next_event)
		 && $eqtimes->($this_event, $next_event) ) {
		if ( MIDI::Tweaks::is_note_on($events[1])
		     && $eqtimes->($this_event, $events[1]) ) {
		    # Remove next from events.
		    shift(@events);
		    # Store higher in hi, lower in md, etc.
		    # (also removes afternext from events)
		    my @a = sort {
			$b->[EV_NOTE_PITCH] <=> $a->[EV_NOTE_PITCH]
		    } ( [@$this_event], [@$next_event], [@{shift(@events)}] );
		    push(@hi, $a[0]);
		    push(@md, $a[1]);
		    push(@lo, $a[2]);
		}
		else {
		    # Remove next from events.
		    shift(@events);
		    my @a = sort {
			$b->[EV_NOTE_PITCH] <=> $a->[EV_NOTE_PITCH]
		    } ( [@$this_event], [@$next_event] );
		    push(@hi, $a[0]);
		    push(@md, $a[1]);
		    push(@lo, $a[1]);
		}
		$hi[-1]->[EV_TIME] = $time;
		$md[-1]->[EV_TIME] = $time;
		$lo[-1]->[EV_TIME] = $time;
	    }
	    elsif ( MIDI::Tweaks::is_note_off($this_event)
		    && @events && MIDI::Tweaks::is_note_off($next_event)
		    && $eqtimes->($this_event, $next_event) ) {
		if ( MIDI::Tweaks::is_note_off($events[1])
		     && $eqtimes->($this_event, $events[1]) ) {
		    # Remove next from events.
		    shift(@events);
		    # Store higher in hi, lower in md, etc.
		    # (also removes afternext from events)
		    my @a = sort {
			$b->[EV_NOTE_PITCH] <=> $a->[EV_NOTE_PITCH]
		    } ( [@$this_event], [@$next_event], [@{shift(@events)}] );
		    push(@hi, $a[0]);
		    push(@md, $a[1]);
		    push(@lo, $a[2]);
		}
		else {
		    # Remove next from events.
		    shift(@events);
		    my @a = sort {
			$b->[EV_NOTE_PITCH] <=> $a->[EV_NOTE_PITCH]
		    } ( [@$this_event], [@$next_event] );
		    push(@hi, $a[0]);
		    push(@md, $a[1]);
		    push(@lo, $a[1]);
		}
		$hi[-1]->[EV_TIME] = $time;
		$md[-1]->[EV_TIME] = $time;
		$lo[-1]->[EV_TIME] = $time;
	    }
	    else {
		# Not a multi-note, copy.
		push(@hi, [@$this_event]);
		push(@md, [@$this_event]);
		push(@lo, [@$this_event]);
	    }
	}
	else {
	    # Not a note, copy.
	    push(@hi, [@$this_event]);
	    push(@md, [@$this_event]);
	    push(@lo, [@$this_event]);
	}
    }

    my $hi = MIDI::Track->new;
    $hi->type($track->type);
    $hi->events(@hi);
    $hi->{_tweaky_abstime} = 1;

    my $md = MIDI::Track->new;
    $md->type($track->type);
    $md->events(@md);
    $md->{_tweaky_abstime} = 1;

    my $lo = MIDI::Track->new;
    $lo->type($track->type);
    $lo->events(@lo);
    $lo->{_tweaky_abstime} = 1;

    return ( $hi, $md, $lo );
}

package main;

=head1 AUTHOR

Johan Vromans, C<< <jvromans at squirrel.nl> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-midi-tweaks at
rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MIDI-Tweaks>. I will
be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SEE ALSO

L<MIDI>, L<MIDI::Opus>, L<midi-dump>, L<midi-tweak>.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc MIDI::Tweaks


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MIDI-Tweaks>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/MIDI-Tweaks>

=item * Search CPAN

L<http://search.cpan.org/dist/MIDI-Tweaks>

=back


=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2008 Johan Vromans, Squirrel Consultancy. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;