File Coverage

blib/lib/Music/Chord/Progression/T.pm

Criterion	Covered	Total	%
statement	88	90	97.7
branch	14	20	70.0
condition			n/a
subroutine	16	17	94.1
pod	2	2	100.0
total	120	129	93.0

package Music::Chord::Progression::T;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Generate transposed chord progressions

our $VERSION = '0.0100';

use Moo;
use strictures 2;
use Carp qw(croak);
use Data::Dumper::Compact qw(ddc);
use Music::Chord::Note ();
use Music::Chord::Namer qw(chordname);
use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(Music-MelodicDevice-Transposition); # local author libs
use Music::MelodicDevice::Transposition ();
use namespace::clean;

with 'Music::PitchNum';


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


has base_octave => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid octave" unless $_[0] =~ /^[1-8]$/ },
    default => sub { 4 },
);


has chord_quality => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid quality" unless $_[0] =~ /^\w*$/ },
    default => sub { '' },
);


has base_chord => (
    is => 'lazy',
);

sub _build_base_chord {
    my ($self) = @_;
    my $cn = Music::Chord::Note->new;
    my @chord = $cn->chord_with_octave(
        $self->base_note . $self->chord_quality,
        $self->base_octave
    );
    return \@chord;
}


has format => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid format" unless $_[0] =~ /^(?:ISO|midinum)$/ },
    default => sub { 'ISO' },
);


has semitones => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid number of semitones" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 7 },
);


has max => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid maximum" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 4 },
);


has transform => (
    is      => 'ro',
    isa     => sub { croak "$_[0] is not a valid transform" unless ref $_[0] eq 'ARRAY' || $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 4 },
);


has mdt => (
    is => 'lazy',
);

sub _build_mdt {
    return Music::MelodicDevice::Transposition->new;
}


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


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

    my ($pitches, $notes) = $self->_get_pitches;

    my @transform = $self->_build_transform;

    $self->_initial_conditions(@transform) if $self->verbose;

    my @generated;
    my $i = 0;

    for my $token (@transform) {
        $i++;

        my $transformed = $self->_build_chord($token, $pitches, $notes);

        my @notes = map { $self->pitchname($_) } @$transformed;
        my @base = map { s/^([A-G][#b]?)\d/$1/r } @notes; # for chord-name

        push @generated, $self->format eq 'ISO' ? \@notes : $transformed;

        printf "%d. %s: %s   %s   %s\n",
            $i, $token,
            ddc($transformed), ddc(\@notes),
            scalar chordname(@base)
            if $self->verbose;

        $notes = $transformed;
    }

    return \@generated;
}


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

    my ($pitches, $notes) = $self->_get_pitches;

    my @transform = $self->_build_transform;

    $self->_initial_conditions(@transform) if $self->verbose;

    my @generated;
    my $posn = 0;

    for my $i (1 .. $self->max) {
        my $token = $transform[ $posn % @transform ];

        my $transformed = $self->_build_chord($token, $pitches, $notes);

        my @notes = map { $self->pitchname($_) } @$transformed;
        my @base = map { s/^([A-G][#b]?)\d/$1/r } @notes; # for chord-name

        push @generated, $self->format eq 'ISO' ? \@notes : $transformed;

        printf "%d. %s (%d): %s   %s   %s\n",
            $i, $token, $posn % @transform,
            ddc($transformed), ddc(\@notes),
            scalar chordname(@base)
            if $self->verbose;

        $notes = $transformed;

        $posn = int rand 2 ? $posn + 1 : $posn - 1;
    }

    return \@generated;
}

sub _get_pitches {
    my ($self) = @_;
    my @pitches = map { $self->pitchnum($_) } @{ $self->base_chord };
    return \@pitches, [ @pitches ];
}

sub _initial_conditions {
    my ($self, @transform) = @_;
    printf "Initial: %s%s %s\nTransforms: %s\n",
        $self->base_note, $self->base_octave, $self->chord_quality,
        join(',', @transform);
}

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

    my @transform;

    if (ref $self->transform eq 'ARRAY') {
        @transform = @{ $self->transform };
    }
    elsif ($self->transform =~ /^\d+$/) {
        @transform = ('I', map { 'T' . int(rand $self->semitones + 1) } 1 .. $self->transform - 1);
    }

    return @transform;
}

sub _build_chord {
    my ($self, $token, $pitches, $notes) = @_;

    my $chord = [];

    if ($token =~ /^I$/) {
        $chord = $pitches; # no transformation
    }
    else {
        (my $semitones = $token) =~ s/^T(-?\d+)$/$1/;
        $chord = $self->mdt->transpose($semitones, $notes);
    }

    return $chord;
}

1;

__END__