File Coverage

blib/lib/Music/Cadence.pm

Criterion	Covered	Total	%
statement	147	147	100.0
branch	63	68	92.6
condition	31	38	81.5
subroutine	14	14	100.0
pod	2	2	100.0
total	257	269	95.5

package Music::Cadence;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Generate musical cadence chords

our $VERSION = '0.1505';

use List::Util 'any';
use Music::Chord::Note;
use Music::Chord::Positions;
use Music::Note;
use Music::Scales;
use Music::ToRoman;

use Moo;
use strictures 2;
use namespace::clean;

with('Music::PitchNum');


has key => (
    is      => 'ro',
    default => sub { 'C' },
);


has scale => (
    is      => 'ro',
    default => sub { 'major' },
);


has octave => (
    is      => 'ro',
    default => sub { 0 },
);


has format => (
    is      => 'ro',
    default => sub { 'isobase' },
);


has seven => (
    is      => 'ro',
    default => sub { 0 },
);


has picardy => (
    is      => 'ro',
    default => sub { 0 },
);


sub cadence {
    my ( $self, %args ) = @_;

    my $cadence = [];

    my $key       = $args{key} || $self->key;
    my $scale     = $args{scale} || $self->scale;
    my $octave    = $args{octave} // $self->octave;
    my $picardy   = $args{picardy} || $self->picardy;
    my $type      = $args{type} || 'perfect';
    my $leading   = $args{leading} || 1;
    my $variation = $args{variation} || 1;
    my $inversion = $args{inversion} || 0;

    die 'unknown leader' if $leading < 1 or $leading > 7;

    my @scale_notes = get_scale_notes( $key, $scale );

    if ( $type eq 'perfect' ) {
        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[4], $octave );
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[0], $octave );
        # Add another top note, but an octave above
        my $top = $chord->[0];
        if ( $self->format eq 'midinum' ) {
            $top += 12;
        }
        else {
            if ( $top =~ /^(.+?)(\d+)$/ ) {
                my $note   = $1;
                my $octave = $2;
                $top = $note . ++$octave;
            }
        }
        push @$chord, $top;
        push @$cadence, $chord;
    }
    elsif ( $type eq 'imperfect' && $inversion ) {
        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[4], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{1}, $octave )
            if $inversion->{1};
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[0], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{2}, $octave )
            if $inversion->{2};
        push @$cadence, $chord;
    }
    elsif ( $type eq 'imperfect' ) {
        my $note = $variation == 1 ? $scale_notes[4] : $scale_notes[6];
        my $chord = $self->_generate_chord( $key, $scale, $note, $octave );
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[0], $octave );
        push @$cadence, $chord;
    }
    elsif ( $type eq 'evaded' && $self->seven ) {
        if ( $inversion ) {
            $inversion->{1} = 3
                unless defined $inversion->{1};
            $inversion->{2} = 1
                unless defined $inversion->{2};
        }
        else {
            $inversion = { 1 => 3, 2 => 1 };
        }

        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[4], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{1}, $octave );
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[0], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{2}, $octave );
        push @$cadence, $chord;
    }
    elsif ( $type eq 'plagal' ) {
        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[3], $octave );
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[0], $octave );
        push @$cadence, $chord;
    }
    elsif ( $type eq 'half' ) {
        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[ $leading - 1 ], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{1}, $octave )
            if $inversion && $inversion->{1};
        push @$cadence, $chord;

        $chord = $self->_generate_chord( $key, $scale, $scale_notes[4], $octave );
        $chord = $self->_invert_chord( $chord, $inversion->{2}, $octave )
            if $inversion && $inversion->{2};
        push @$cadence, $chord;
    }
    elsif ( $type eq 'deceptive' ) {
        my $chord = $self->_generate_chord( $key, $scale, $scale_notes[4], $octave );
        push @$cadence, $chord;

        my $note = $variation == 1 ? $scale_notes[5] : $scale_notes[3];
        $chord = $self->_generate_chord( $key, $scale, $note, $octave );
        push @$cadence, $chord;
    }
    else {
        die 'unknown cadence';
    }

    if ( $picardy ) {
        if ( $self->format eq 'midinum' ) {
            $cadence->[1][1]++;
        }
        else {
            my $note = Music::Note->new( $cadence->[1][1], $self->format );
            my $num  = $note->format('midinum');
            $num++;
            $note = Music::Note->new( $num, 'midinum' );
            $cadence->[1][1] = $note->format( $self->format );
        }
    }

    return $cadence;
}

sub _invert_chord {
    my ( $self, $chord, $inversion, $octave ) = @_;

    my $mcp = Music::Chord::Positions->new;

    if ( $self->format eq 'midinum' ) {
        $chord = $mcp->chord_inv( $chord, inv_num => $inversion );
    }
    else { # Perform these gymnastics to convert named notes to inverted named notes:
        # Strip the octave if present
        $chord = [ map { s/\d+//; $_ } @$chord ]
            if $octave;

        # Convert the chord into pitch-class representation
        my $pitches = [ map { $self->pitchnum( $_ . -1 ) } @$chord ];

        # Do the inversion!
        $pitches = $mcp->chord_inv( $pitches, inv_num => $inversion );

        # Convert the pitch-classes back to named notes
        $chord = [ map { $self->pitchname($_) } @$pitches ];

        # Clean-up the chord
        for ( @$chord ) {
            if ( $octave ) {
                s/-1/$octave/;
                s/0/$octave + 1/e;
            }
            else {
                s/-1//;
                s/0//;
            }

            if ( $self->format eq 'midi' ) {
                s/#/s/;
                s/b/f/;
            }
        }
    }

    return $chord;
}

sub _generate_chord {
    my ( $self, $key, $scale, $note, $octave ) = @_;

    # Know what chords should be diminished
    my %diminished = (
        ionian     => 'vii',
        major      => 'vii',
        dorian     => 'vi',
        phrygian   => 'v',
        lydian     => 'iv',
        mixolydian => 'iii',
        aeolian    => 'ii',
        minor      => 'ii',
        locrian    => 'i',
    );

    die 'unknown scale' unless exists $diminished{$scale};

    my $mtr = Music::ToRoman->new(
        scale_note => $key,
        scale_name => $scale,
        chords     => 0,
    );

    # Figure out if the chord is diminished, minor, or major
    my $roman = $mtr->parse($note);
    my $type  = $roman =~ /^$diminished{$scale}$/ ? 'dim' : $roman =~ /^[a-z]/ ? 'm' : '';

    $type .= 7
        if $self->seven;

    my $mcn = Music::Chord::Note->new;

    # Get the notes of the chord (without an octave)
    my @notes = $mcn->chord( $note . $type );

    if ( $self->format eq 'midi' ) {
        # Convert the sharps and flats
        for ( @notes ) {
            s/#/s/;
            s/b/f/;
        }
    }
    elsif ( $self->format eq 'midinum' ) {
        # Convert the notes to midinum format
        @notes = map { $self->pitchnum( $_ . $octave ) } @notes;
    }
    elsif ( $self->format ne 'isobase' ) {
        die 'unknown format';
    }

    # Append the octave if defined and the format is not midinum
    @notes = map { $_ . $octave } @notes
        if $octave && $self->format ne 'midinum';

    return \@notes;
}


sub remove_notes {
    my ($self, $indices, $chord) = @_;
    my @chord;
    for my $n (0 .. @$chord - 1) {
        next if any { $n == $_ } @$indices;
        push @chord, $chord->[$n];
    }
    return \@chord;
}

1;

__END__