File Coverage

blib/lib/Music/MelodicDevice/Transposition.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	10	12	83.3
condition	2	3	66.6
subroutine	11	11	100.0
pod	1	1	100.0
total	69	72	95.8

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

# ABSTRACT: Apply chromatic and diatonic transposition to notes

our $VERSION = '0.0601';

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

with('Music::PitchNum');

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 notes => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a valid list" unless ref($_[0]) eq 'ARRAY' },
    default => sub { [] },
);


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


sub transpose {
    my ($self, $offset, $notes) = @_;

    $notes ||= $self->notes;

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

    my @transposed;

    for my $n (@$notes) {
        my ($i, $pitch) = $self->_find_pitch($n);
        if ($i == -1) {
            push @transposed, undef;
        }
        else {
            if ($named) {
                push @transposed, $self->pitchname($self->_scale->[ $i + $offset ]);
            }
            else {
                push @transposed, $self->_scale->[ $i + $offset ];
            }
        }
    }
    print 'Transposed: ', ddc(\@transposed) if $self->verbose;

    return \@transposed;
}

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

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

    my $i = first_index { $_ == $pitch } @{ $self->_scale };

    return $i, $pitch;
}

1;

__END__