File Coverage

blib/lib/Music/GuitarChordDiagram.pm

Criterion	Covered	Total	%
statement	32	65	49.2
branch	0	14	0.0
condition			n/a
subroutine	8	9	88.8
pod	2	2	100.0
total	42	90	46.6

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

# ABSTRACT: Draw Guitar Chord Diagrams

our $VERSION = '0.0501';

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

use Imager;
use List::MoreUtils 'first_index';
use Music::Chord::Namer 'chordname';


has chord => (
    is => 'rw',
);


has position => (
    is      => 'rw',
    isa     => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 1 },
);


has strings => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 6 },
);


has frets => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 5 },
);


has size => (
    is      => 'ro',
    isa     => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
    default => sub { 30 },
);


has outfile => (
    is      => 'rw',
    default => sub { 'chord-diagram' },
);


has font => (
    is      => 'ro',
    default => sub { '/opt/X11/share/fonts/TTF/VeraMono.ttf' },
);


has tuning => (
    is      => 'ro',
    default => sub { [qw/E B G D A E/] },
);


has fretboard => (
    is       => 'ro',
    init_arg => undef,
);


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


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

    my @scale = qw/C Db D Eb E F Gb G Ab A Bb B/;
    my @index = map { my $t = $_; first_index { $t eq $_ } @scale } @{ $self->tuning };
    my %notes;

    my $n = 0;

    for my $i ( @index ) {
        $n++;
        $notes{$n} = [ map { $scale[ ($i + $_) % @scale ] } 0 .. @scale - 1 ];
    }

    $self->{fretboard} = \%notes;
}


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

    my $WHITE = 'white';
    my $BLUE  = 'blue';
    my $BLACK = 'black';
    my $SPACE = $self->size;

    my @chord;

    # Setup a new image
    my $i = Imager->new(
        xsize => $SPACE + $self->strings * $SPACE - $self->strings,
        ysize => $SPACE + $self->frets * $SPACE - $self->frets,
    );
    my $font = Imager::Font->new( file => $self->font );
    $i->box( filled => 1, color => $WHITE );

    # Draw the vertical string lines
    for my $string (0 .. $self->strings - 1) {
        $i->line(
            color => $BLUE,
            x1    => $SPACE + $string * $SPACE,
            y1    => $SPACE,
            x2    => $SPACE + $string * $SPACE,
            y2    => $SPACE + ($self->frets - 1) * $SPACE,
            aa    => 1,
            endp  => 1
        );
    }

    # Draw the horizontal fret lines
    for my $fret ( 0 .. $self->frets - 1 ) {
        $i->line(
            color => $BLUE,
            x1    => $SPACE,
            y1    => $SPACE + $fret * $SPACE,
            x2    => $SPACE + ($self->strings - 1) * $SPACE,
            y2    => $SPACE + $fret * $SPACE,
            aa    => 1,
            endp  => 1
        );

        # Indicate the neck position
        if ( $fret == 1 ) {
            $i->string(
                font  => $font,
                text  => $self->position,
                color => $BLACK,
                x     => $SPACE / 2,
                y     => $SPACE * 2 + $SPACE / 4,
                size  => $SPACE / 2,
                aa    => 1,
            );
        }
    }

    # Draw the note/mute markers
    my $string = $self->strings;

    for my $note ( split //, $self->chord ) {
        if ( $note =~ /[xX]/ ) {
            print "X at 0,$string\n" if $self->verbose;

            $i->string(
                font  => $font,
                text  => 'X',
                color => $BLACK,
                x     => $SPACE + ($self->strings - $string) * $SPACE - $SPACE / 6,
                y     => $SPACE - 2,
                size  => $SPACE / 2,
                aa    => 1,
            );
        }
        elsif ( $note =~ /[oO0]/ ) {
            my $temp = $self->fretboard->{$string}[0];
            push @chord, $temp;
            print "O at 0,$string = $temp\n" if $self->verbose;

            $i->string(
                font  => $font,
                text  => 'O',
                color => $BLACK,
                x     => $SPACE + ($self->strings - $string) * $SPACE - $SPACE / 6,
                y     => $SPACE - 2,
                size  => $SPACE / 2,
                aa    => 1,
            );
        }
        else {
            my $temp = $self->fretboard->{$string}[$self->position + $note - 1];
            push @chord, $temp;
            print "Dot at $note,$string = $temp\n" if $self->verbose;

            $i->circle(
                color => $BLACK,
                r     => $SPACE / 5,
                x     => $SPACE + ($self->strings - $string) * $SPACE,
                y     => $SPACE + $SPACE / 2 + ($note - 1) * $SPACE,
            );
        }

        # Decrement the current string number
        $string--;
    }

    # Print the chord name
    $i->string(
        font  => $font,
        text  => scalar(chordname(@chord)),
        color => $BLACK,
        x     => $SPACE,
        y     => $SPACE + $self->frets * $SPACE - $self->frets - $SPACE / 4,
        size  => $SPACE / 2,
        aa    => 1,
    );

    # Output the image
    my $type = 'png';
    my $name = $self->outfile . '.' . $type;
    $i->write( type => $type, file => $name )
        or die "Can't save $name: ", $i->errstr;
}

1;

__END__