File Coverage

blib/lib/Music/MelodicDevice/Ornamentation.pm

Criterion	Covered	Total	%
statement	142	142	100.0
branch	38	50	76.0
condition	7	13	53.8
subroutine	19	19	100.0
pod	5	5	100.0
total	211	229	92.1

package Music::MelodicDevice::Ornamentation;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Chromatic and diatonic melodic ornamentation

our $VERSION = '0.0702';

use strictures 2;
use Carp qw(croak);
use Data::Dumper::Compact qw(ddc);
use List::SomeUtils qw(first_index);
use MIDI::Simple ();
use Moo;
use Music::Duration ();
use Music::Scales qw(get_scale_MIDI is_scale);
use namespace::clean;

with('Music::PitchNum');

use constant TICKS => 96;
use constant OCTAVES => 10;


has scale_note => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a valid note" unless $_[0] =~ /^[A-G][#b]?$/ },
    default => sub { 'C' },
);


has scale_name => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a valid scale name" unless is_scale($_[0]) },
    default => sub { 'chromatic' },
);

has _scale => (
    is        => 'lazy',
    init_args => undef,
);

sub _build__scale {
    my ($self) = @_;

    my @scale = map { get_scale_MIDI($self->scale_note, $_, $self->scale_name) } -1 .. OCTAVES - 1;
    print 'Scale: ', ddc(\@scale) if $self->verbose;

    return \@scale;
}


has verbose => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a valid boolean" unless $_[0] =~ /^[01]$/ },
    default => sub { 0 },
);



sub grace_note {
    my ($self, $duration, $pitch, $offset) = @_;

    $offset //= 1; # Default one note above

    my $named = $pitch =~ /[A-G]/ ? 1 : 0;

    (my $i, $pitch) = $self->_find_pitch($pitch);
    my $grace_note = $self->_scale->[ $i + $offset ];

    if ($named) {
        $pitch = $self->pitchname($pitch);
        $grace_note = $self->pitchname($grace_note);
    }

    # Compute the ornament durations
    my $x = $MIDI::Simple::Length{$duration} * TICKS;
    my $y = $MIDI::Simple::Length{xn} * TICKS; # Thirty-second note
    my $z = sprintf '%0.f', $x - $y;
    print "Durations: $x, $y, $z\n" if $self->verbose;
    $y = 'd' . $y;
    $z = 'd' . $z;

    my @grace_note = ([$y, $grace_note], [$z, $pitch]);
    print 'Grace note: ', ddc(\@grace_note) if $self->verbose;

    return \@grace_note;
}


sub turn {
    my ($self, $duration, $pitch, $offset) = @_;

    my $number = 4; # Number of notes in the ornament
    $offset //= 1; # Default one note above

    my $named = $pitch =~ /[A-G]/ ? 1 : 0;

    (my $i, $pitch) = $self->_find_pitch($pitch);
    my $above = $self->_scale->[ $i + $offset ];
    my $below = $self->_scale->[ $i - $offset ];

    if ($named) {
        $pitch = $self->pitchname($pitch);
        $above = $self->pitchname($above);
        $below = $self->pitchname($below);
    }

    # Compute the ornament durations
    my $x = $MIDI::Simple::Length{$duration} * TICKS;
    my $z = sprintf '%0.f', $x / $number;
    print "Durations: $x, $z\n" if $self->verbose;
    $z = 'd' . $z;

    my @turn = ([$z, $above], [$z, $pitch], [$z, $below], [$z, $pitch]);
    print 'Turn: ', ddc(\@turn) if $self->verbose;

    return \@turn;
}


sub trill {
    my ($self, $duration, $pitch, $number, $offset) = @_;

    $number ||= 2; # Number of notes in the ornament
    $offset //= 1; # Default one note above

    my $named = $pitch =~ /[A-G]/ ? 1 : 0;

    (my $i, $pitch) = $self->_find_pitch($pitch);
    my $alt = $self->_scale->[ $i + $offset ];

    if ($named) {
        $pitch = $self->pitchname($pitch);
        $alt = $self->pitchname($alt);
    }

    # Compute the ornament durations
    my $x = $MIDI::Simple::Length{$duration} * TICKS;
    my $z = sprintf '%0.f', ($x / $number / 2);
    print "Durations: $x, $z\n" if $self->verbose;
    $z = 'd' . $z;

    my @trill;

    push @trill, [$z, $pitch], [$z, $alt] for 1 .. $number;
    print 'Trill: ', ddc(\@trill) if $self->verbose;

    return \@trill;
}


sub mordent {
    my ($self, $duration, $pitch, $offset) = @_;

    my $number = 4; # Finest division needed
    $offset //= 1; # Default one note above

    my $named = $pitch =~ /[A-G]/ ? 1 : 0;

    (my $i, $pitch) = $self->_find_pitch($pitch);
    my $alt = $self->_scale->[ $i + $offset ];

    if ($named) {
        $pitch = $self->pitchname($pitch);
        $alt = $self->pitchname($alt);
    }

    # Compute the ornament durations
    my $x = $MIDI::Simple::Length{$duration} * TICKS;
    my $y = sprintf '%0.f', $x / $number;
    my $z = sprintf '%0.f', $x - (2 * $y);
    print "Durations: $x, $y, $z\n" if $self->verbose;
    $y = 'd' . $y;
    $z = 'd' . $z;

    my @mordent;

    push @mordent, [$y, $pitch], [$y, $alt], [$z, $pitch];
    print 'Mordent: ', ddc(\@mordent) if $self->verbose;

    return \@mordent;
}


sub slide {
    my ($self, $duration, $from, $to) = @_;

    my @scale = map { get_scale_MIDI($self->scale_note, $_, 'chromatic') } -1 .. OCTAVES - 1;

    my $named = $from =~ /[A-G]/ ? 1 : 0;

    (my $i, $from) = $self->_find_pitch($from, \@scale);
    (my $j, $to) = $self->_find_pitch($to, \@scale);

    my ($start, $end);
    if ($i <= $j) {
        $start = $i;
        $end = $j;
    }
    else {
        $start = $j;
        $end = $i;
    }

    # Compute the ornament durations
    my $x = $MIDI::Simple::Length{$duration} * TICKS;
    my $y = $end - $start + 1; # Number of notes in the slide
    my $z = sprintf '%0.f', $x / $y;
    print "Durations: $x, $y, $z\n" if $self->verbose;
    $z = 'd' . $z;

    my @slide;
    if ($named) {
        @slide = map { [ $z, $self->pitchname($scale[$_]) ] } $start .. $end;
    }
    else {
        @slide = map { [ $z, $scale[$_] ] } $start .. $end;
    }
    @slide = reverse @slide if $j < $i;
    print 'Slide: ', ddc(\@slide) if $self->verbose;

    return \@slide;
}

sub _find_pitch {
    my ($self, $pitch, $scale) = @_;

    $scale //= $self->_scale;

    $pitch = $self->pitchnum($pitch)
        if $pitch =~ /[A-G]/;

    my $i = first_index { $_ eq $pitch } @$scale;
    croak "Unknown pitch: $pitch" if $i < 0;

    return $i, $pitch;
}

1;

__END__