File Coverage

blib/lib/Music/GuitarChordDiagram.pm
Criterion Covered Total %
statement 18 65 27.6
branch 0 14 0.0
condition n/a
subroutine 6 9 66.6
pod 2 2 100.0
total 26 90 28.8


line stmt bran cond sub pod time code
1             package Music::GuitarChordDiagram;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Draw Guitar Chord Diagrams - DEPRECATED
5              
6             our $VERSION = '0.0502_1';
7              
8 1     1   962 use Moo;
  1         9129  
  1         4  
9 1     1   1495 use strictures 2;
  1         1277  
  1         32  
10 1     1   534 use namespace::clean;
  1         8880  
  1         6  
11              
12 1     1   879 use Imager;
  1         35797  
  1         8  
13 1     1   604 use List::MoreUtils 'first_index';
  1         10280  
  1         6  
14 1     1   1298 use Music::Chord::Namer 'chordname';
  1         1950  
  1         1105  
15              
16              
17             has chord => (
18             is => 'rw',
19             );
20              
21              
22             has position => (
23             is => 'rw',
24             isa => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
25             default => sub { 1 },
26             );
27              
28              
29             has strings => (
30             is => 'ro',
31             isa => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
32             default => sub { 6 },
33             );
34              
35              
36             has frets => (
37             is => 'ro',
38             isa => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
39             default => sub { 5 },
40             );
41              
42              
43             has size => (
44             is => 'ro',
45             isa => sub { die "$_[0] is not a positive integer" unless $_[0] =~ /^[1-9]\d*$/ },
46             default => sub { 30 },
47             );
48              
49              
50             has outfile => (
51             is => 'rw',
52             default => sub { 'chord-diagram' },
53             );
54              
55              
56             has font => (
57             is => 'ro',
58             default => sub { '/opt/X11/share/fonts/TTF/VeraMono.ttf' },
59             );
60              
61              
62             has tuning => (
63             is => 'ro',
64             default => sub { [qw/E B G D A E/] },
65             );
66              
67              
68             has fretboard => (
69             is => 'ro',
70             init_arg => undef,
71             );
72              
73              
74             has verbose => (
75             is => 'ro',
76             default => sub { 0 },
77             );
78              
79              
80             sub BUILD {
81 0     0 1   my ( $self, $args ) = @_;
82              
83 0           my @scale = qw/C Db D Eb E F Gb G Ab A Bb B/;
84 0     0     my @index = map { my $t = $_; first_index { $t eq $_ } @scale } @{ $self->tuning };
  0            
  0            
  0            
  0            
85 0           my %notes;
86              
87 0           my $n = 0;
88              
89 0           for my $i ( @index ) {
90 0           $n++;
91 0           $notes{$n} = [ map { $scale[ ($i + $_) % @scale ] } 0 .. @scale - 1 ];
  0            
92             }
93              
94 0           $self->{fretboard} = \%notes;
95             }
96              
97              
98             sub draw {
99 0     0 1   my ($self) = @_;
100              
101 0           my $WHITE = 'white';
102 0           my $BLUE = 'blue';
103 0           my $BLACK = 'black';
104 0           my $SPACE = $self->size;
105              
106 0           my @chord;
107              
108             # Setup a new image
109 0           my $i = Imager->new(
110             xsize => $SPACE + $self->strings * $SPACE - $self->strings,
111             ysize => $SPACE + $self->frets * $SPACE - $self->frets,
112             );
113 0           my $font = Imager::Font->new( file => $self->font );
114 0           $i->box( filled => 1, color => $WHITE );
115              
116             # Draw the vertical string lines
117 0           for my $string (0 .. $self->strings - 1) {
118 0           $i->line(
119             color => $BLUE,
120             x1 => $SPACE + $string * $SPACE,
121             y1 => $SPACE,
122             x2 => $SPACE + $string * $SPACE,
123             y2 => $SPACE + ($self->frets - 1) * $SPACE,
124             aa => 1,
125             endp => 1
126             );
127             }
128            
129             # Draw the horizontal fret lines
130 0           for my $fret ( 0 .. $self->frets - 1 ) {
131 0           $i->line(
132             color => $BLUE,
133             x1 => $SPACE,
134             y1 => $SPACE + $fret * $SPACE,
135             x2 => $SPACE + ($self->strings - 1) * $SPACE,
136             y2 => $SPACE + $fret * $SPACE,
137             aa => 1,
138             endp => 1
139             );
140              
141             # Indicate the neck position
142 0 0         if ( $fret == 1 ) {
143 0           $i->string(
144             font => $font,
145             text => $self->position,
146             color => $BLACK,
147             x => $SPACE / 2,
148             y => $SPACE * 2 + $SPACE / 4,
149             size => $SPACE / 2,
150             aa => 1,
151             );
152             }
153             }
154              
155             # Draw the note/mute markers
156 0           my $string = $self->strings;
157              
158 0           for my $note ( split //, $self->chord ) {
159 0 0         if ( $note =~ /[xX]/ ) {
    0          
160 0 0         print "X at 0,$string\n" if $self->verbose;
161              
162 0           $i->string(
163             font => $font,
164             text => 'X',
165             color => $BLACK,
166             x => $SPACE + ($self->strings - $string) * $SPACE - $SPACE / 6,
167             y => $SPACE - 2,
168             size => $SPACE / 2,
169             aa => 1,
170             );
171             }
172             elsif ( $note =~ /[oO0]/ ) {
173 0           my $temp = $self->fretboard->{$string}[0];
174 0           push @chord, $temp;
175 0 0         print "O at 0,$string = $temp\n" if $self->verbose;
176              
177 0           $i->string(
178             font => $font,
179             text => 'O',
180             color => $BLACK,
181             x => $SPACE + ($self->strings - $string) * $SPACE - $SPACE / 6,
182             y => $SPACE - 2,
183             size => $SPACE / 2,
184             aa => 1,
185             );
186             }
187             else {
188 0           my $temp = $self->fretboard->{$string}[$self->position + $note - 1];
189 0           push @chord, $temp;
190 0 0         print "Dot at $note,$string = $temp\n" if $self->verbose;
191              
192 0           $i->circle(
193             color => $BLACK,
194             r => $SPACE / 5,
195             x => $SPACE + ($self->strings - $string) * $SPACE,
196             y => $SPACE + $SPACE / 2 + ($note - 1) * $SPACE,
197             );
198             }
199              
200             # Decrement the current string number
201 0           $string--;
202             }
203              
204             # Print the chord name
205             $i->string(
206 0           font => $font,
207             text => scalar(chordname(@chord)),
208             color => $BLACK,
209             x => $SPACE,
210             y => $SPACE + $self->frets * $SPACE - $self->frets - $SPACE / 4,
211             size => $SPACE / 2,
212             aa => 1,
213             );
214              
215             # Output the image
216 0           my $type = 'png';
217 0           my $name = $self->outfile . '.' . $type;
218 0 0         $i->write( type => $type, file => $name )
219             or die "Can't save $name: ", $i->errstr;
220             }
221              
222             1;
223              
224             __END__