File Coverage

blib/lib/MIDI/Chord/Guitar.pm

Criterion	Covered	Total	%
statement	116	121	95.8
branch	25	28	89.2
condition	12	20	60.0
subroutine	18	19	94.7
pod	3	3	100.0
total	174	191	91.1

package MIDI::Chord::Guitar;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: MIDI pitches for guitar chord voicings

our $VERSION = '0.0703';

use strict;
use warnings;

use File::ShareDir qw(dist_dir);
use List::Util qw(any zip);
use Music::Note;
use Text::CSV_XS ();
use Moo;
use strictures 2;
use namespace::clean;


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

sub _build_voicing_file {
    my ($self) = @_;
    my $file = eval { dist_dir('MIDI-Chord-Guitar') . '/midi-guitar-chord-voicings.csv' };
    return $file;
}


has chords => (
  is       => 'lazy',
  init_arg => undef,
);

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

    my $file = $self->voicing_file;

    my %data;

    my $csv = Text::CSV_XS->new({ binary => 1 });

    open my $fh, '<', $file
        or die "Can't read $file: $!";

    while (my $row = $csv->getline($fh)) {
        my $chord = shift @$row;
        my $fingering = shift @$row;
        push @{ $data{$chord}{fingering} }, $fingering;
        my @notes;
        for my $r (@$row) {
            push @notes, $r if $r ne '';
        }
        push @{ $data{$chord}{notes} }, \@notes;
    }

    close $fh;

    return \%data;
}


sub transform {
    my ($self, $target, $chord_name, $variation) = @_;

    $target = Music::Note->new($target, 'ISO')->format('midinum');

    $chord_name //= '';

    my @notes;

    if (defined $variation) {
      my $pitches = $self->chords->{ 'C' . $chord_name }{notes}[$variation];

      my $diff = $target - _lowest_c($pitches);

      @notes = map { $_ + $diff } @$pitches;
    }
    else {
        for my $pitches (@{ $self->chords->{ 'C' . $chord_name }{notes} }) {
            my $diff = $target - _lowest_c($pitches);
            push @notes, [ map { $_ + $diff } @$pitches ];
        }
    }

    return \@notes;
}

sub _lowest_c {
    my ($pitches) = @_;

    my $lowest = 0;

    for my $c (48, 60, 72) {
        if (any { $_ == $c } @$pitches) {
            $lowest = $c;
            last;
        }
    }

    return $lowest;
}


sub voicings {
    my ($self, $chord_name, $format) = @_;

    $chord_name //= '';
    $format ||= '';

    my $voicings = $self->chords->{ 'C' . $chord_name }{notes};

    if ($format) {
        my $temp;

        for my $chord (@$voicings) {
            my $span;

            for my $n (@$chord) {
                my $note = Music::Note->new($n, 'midinum')->format($format);
                push @$span, $note;
            }

            push @$temp, $span;
        }

        $voicings = $temp;
    }

    return $voicings;
}


sub fingering {
    my ($self, $target, $chord_name, $variation) = @_;

    $target = Music::Note->new($target, 'ISO')->format('midinum');

    $chord_name //= '';

    my @fingering;

    if (defined $variation) {
        my $fingering = $self->chords->{ 'C' . $chord_name }{fingering}[$variation];
        my $pitches = $self->chords->{ 'C' . $chord_name }{notes}[$variation];

        my ($str, $p) = _find_fingering($target, $pitches, $fingering);

        push @fingering, $str . '-' . $p if $p >= 0;
    }
    else {
        for (zip $self->chords->{ 'C' . $chord_name }{notes}, $self->chords->{ 'C' . $chord_name }{fingering}) {
            my ($pitches, $fingering) = @$_;

            my ($str, $p) = _find_fingering($target, $pitches, $fingering);

            push @fingering, $str . '-' . $p if $p >= 0;
        }
    }

    return \@fingering;
}

# XXX This is overly complicated, questionable logic
sub _find_fingering {
    my ($target, $pitches, $fingering) = @_;

    my $diff = $target - _lowest_c($pitches);

    my ($str, $pos) = split /-/, $fingering;

    my $p = $pos + $diff;

    if ($pos != 1 && $str !~ /0/) {
        if ($p == 0 && $str !~ /0/) {
            $str = _decrement_fingering($str);
            $p++;
        }
        elsif ($p != 0 && $str =~ /0/) {
            $str = _increment_fingering($str);
        }
    }
    elsif ($p > 1 && $str =~ /0/) {
        $str = _increment_fingering($str);
        $p--;
    }

    return $str, $p;
}


sub _increment_fingering {
    my ($fingering) = @_;
    my $incremented = '';
    for my $char (split //, $fingering) {
        $incremented .= $char =~ /\d/ ? $char + 1 : $char;
    }
    return $incremented;
}

sub _decrement_fingering {
    my ($fingering) = @_;
    my $decremented = '';
    for my $char (split //, $fingering) {
        $decremented .= $char =~ /\d/ ? $char - 1 : $char;
    }
    return $decremented;
}

1;

__END__