fretboard

#!/usr/bin/perl
use strict;
use warnings;

# THIS PROGRAM IS NOW SUPERSEDED BY https://metacpan.org/release/Music-FretboardDiagram

use Imager;

my $WHITE = 'white';
my $BLUE  = 'blue';
my $BLACK = 'black';
my $SPACE = 20;

my $string_num = shift || 6;
my $fret_num   = shift || 5;
my $chord      = shift || 'x12340';
my $outfile    = shift || $0;
my $fontfile   = shift || '/opt/X11/share/fonts/TTF/VeraMono.ttf';

my $type = 'png';

my $i = Imager->new(
    xsize => $SPACE + $string_num * $SPACE - $string_num,
    ysize => $SPACE + $fret_num * $SPACE - $fret_num,
);

$i->box( filled => 1, color => $WHITE );

for my $string (0 .. $string_num - 1) {
    $i->line(
        color => $BLUE,
        x1    => $SPACE + $string * $SPACE,
        y1    => $SPACE,
        x2    => $SPACE + $string * $SPACE,
        y2    => $SPACE + ($fret_num - 1) * $SPACE,
        aa    => 1,
        endp  => 1
    );
}
for my $fret (0 .. $fret_num - 1) {
    $i->line(
        color => $BLUE,
        x1    => $SPACE,
        y1    => $SPACE + $fret * $SPACE,
        x2    => $SPACE + ($string_num - 1) * $SPACE,
        y2    => $SPACE + $fret * $SPACE,
        aa    => 1,
        endp  => 1
    );
}

my $font = Imager::Font->new( file => $fontfile );

my $string = $string_num;

for my $note ( split //, $chord ) {
    if ( $note =~ /[xX.-]/ ) {
        print "X at 0,$string\n";
        $i->string(
            font  => $font,
            text  => 'X',
            color => $BLACK,
            x     => $SPACE + ( $string_num - $string ) * $SPACE - $SPACE / 4,
            y     => $SPACE - 2,
            size  => $SPACE - 2,
            aa    => 1,
        );
    }
    elsif ( $note =~ /[oO0]/ ) {
        print "O at 0,$string\n";
        $i->circle(
            color  => $BLACK,
            r      => $SPACE / 4,
            x      => $SPACE + ( $string_num - $string ) * $SPACE,
            y      => $SPACE / 2,
            filled => 0,
        );
    }
    else {
        print "Dot at $note,$string\n";
        $i->circle(
            color => $BLACK,
            r     => $SPACE / 4,
            x     => $SPACE + ( $string_num - $string ) * $SPACE,
            y     => $SPACE + $SPACE / 2 + ( $note - 1 ) * $SPACE,
        );
    }
    $string--;
}

$i->write( type => $type, file => "$outfile.$type" )
    or die "Can't save $outfile.$type ", $i->errstr;