|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Text::Chord::Piano;  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
132857
 | 
 use warnings;  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
12
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
67
 | 
    | 
| 
4
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
11
 | 
 use strict;  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
45
 | 
    | 
| 
5
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
10
 | 
 use Carp qw(croak);  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
91
 | 
    | 
| 
6
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
7
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
993
 | 
 use Music::Chord::Note;  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1819
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
77
 | 
    | 
| 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
9
 | 
2
 | 
 
 | 
 
 | 
  
2
  
 | 
 
 | 
16
 | 
 use base qw(Class::Accessor::Fast);  | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
    | 
| 
 
 | 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
912
 | 
    | 
| 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __PACKAGE__->mk_accessors( qw(finger) );  | 
| 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $VERSION = '0.062';  | 
| 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $cn = Music::Chord::Note->new();  | 
| 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my $black_keys;  | 
| 
17
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 for my $black_key (qw(1 3 6 8 10 13 15 18 20 22)){  | 
| 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     $black_keys->{$black_key} = 2;  | 
| 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
21
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 my @white_keys = (  | 
| 
22
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 #   C   C#  D   D#  E   F   F#  G   G#  A   A#  B  | 
| 
23
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
      2,  4,  6,  8, 10, 14, 16, 18, 20, 22, 24, 26,  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     30, 32, 34, 36, 38, 42, 44, 46, 48, 50, 52, 54,  | 
| 
25
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 );  | 
| 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
27
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub new {  | 
| 
29
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
86
 | 
     my $class = shift;  | 
| 
30
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     bless {  | 
| 
31
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         finger => '*',  | 
| 
32
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }, $class;  | 
| 
33
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
34
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub chord {  | 
| 
36
 | 
12
 | 
 
 | 
 
 | 
  
12
  
 | 
  
1
  
 | 
3113
 | 
     my ($self, $chord_name) = @_;  | 
| 
37
 | 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
32
 | 
     return $self->generate($chord_name, $self->_get_keys($chord_name));  | 
| 
38
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
39
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
40
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub gen {  | 
| 
41
 | 
8
 | 
 
 | 
 
 | 
  
8
  
 | 
  
1
  
 | 
22
 | 
     my ($self, $chord_name, @keys) = @_;  | 
| 
42
 | 
8
 | 
 
 | 
 
 | 
 
 | 
 
 | 
21
 | 
     return $self->generate($chord_name, @keys);  | 
| 
43
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
44
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub generate {  | 
| 
45
 | 
18
 | 
 
 | 
 
 | 
  
18
  
 | 
  
1
  
 | 
41
 | 
     my ($self, $chord_name, @keys) = @_;  | 
| 
46
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
     my $keyboard = $self->_draw_keyboard;  | 
| 
47
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
45
 | 
     for my $key (0..23){  | 
| 
48
 | 
432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
814
 | 
         my $play = 0;  | 
| 
49
 | 
432
 | 
 
 | 
 
 | 
 
 | 
 
 | 
567
 | 
         for my $i (@keys){  | 
| 
50
 | 
1680
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
2848
 | 
             $play = 1 if $i == $key;  | 
| 
51
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
52
 | 
432
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
736
 | 
         if($play){  | 
| 
53
 | 
70
 | 
 
 | 
  
100
  
 | 
 
 | 
 
 | 
199
 | 
             my $y = $black_keys->{$key} || 5;  | 
| 
54
 | 
70
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1328
 | 
             $keyboard->[$y]->[$white_keys[$key]] = $self->finger;  | 
| 
55
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
56
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
57
 | 
18
 | 
 
 | 
 
 | 
 
 | 
 
 | 
44
 | 
     return $self->put_keyboard($keyboard)."$chord_name\n";  | 
| 
58
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
59
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
60
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub put_keyboard {  | 
| 
61
 | 
19
 | 
 
 | 
 
 | 
  
19
  
 | 
  
1
  
 | 
455
 | 
     my $self     = shift;  | 
| 
62
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     my $keyboard = shift;  | 
| 
63
 | 
19
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
53
 | 
     $keyboard = $self->_draw_keyboard if ref $keyboard ne 'ARRAY';  | 
| 
64
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     my $text;  | 
| 
65
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
27
 | 
     for my $line (@{$keyboard}){  | 
| 
 
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
    | 
| 
66
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
168
 | 
         for my $char (@{$line}){  | 
| 
 
 | 
133
 | 
 
 | 
 
 | 
 
 | 
 
 | 
179
 | 
    | 
| 
67
 | 
7714
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9933
 | 
             $text .= $char;  | 
| 
68
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
         }  | 
| 
69
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
70
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
429
 | 
     return $text;  | 
| 
71
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
72
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
73
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub all_chords {  | 
| 
74
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
1
  
 | 
3
 | 
     my $self = shift;  | 
| 
75
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
3
 | 
     return $cn->all_chords_list;  | 
| 
76
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
77
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
78
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _get_keys {  | 
| 
79
 | 
12
 | 
 
 | 
 
 | 
  
12
  
 | 
 
 | 
22
 | 
     my ($self, $chord_name) = @_;  | 
| 
80
 | 
12
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
206
 | 
     croak "no chord" unless $chord_name;  | 
| 
81
 | 
11
 | 
 
 | 
 
 | 
 
 | 
 
 | 
60
 | 
     my ($tonic, $kind) = ($chord_name =~ /([A-G][b#]?)(.+)?/);  | 
| 
82
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
28
 | 
     $kind = 'base' unless $kind;  | 
| 
83
 | 
11
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
116
 | 
     croak "undefined chord $chord_name" unless defined $tonic;  | 
| 
84
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
34
 | 
     my $scalic = $cn->scale($tonic);  | 
| 
85
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
115
 | 
     my @keys;  | 
| 
86
 | 
10
 | 
 
 | 
 
 | 
 
 | 
 
 | 
24
 | 
     for my $scale ( $cn->chord_num($kind) ){  | 
| 
87
 | 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
131
 | 
         my $tone = $scale + $scalic;  | 
| 
88
 | 
35
 | 
  
100
  
 | 
 
 | 
 
 | 
 
 | 
94
 | 
         $tone = int($tone % 24) + 12 if $tone > 23;  | 
| 
89
 | 
35
 | 
 
 | 
 
 | 
 
 | 
 
 | 
75
 | 
         push(@keys, $tone);  | 
| 
90
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     }  | 
| 
91
 | 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
31
 | 
     return @keys;  | 
| 
92
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
93
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
94
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub _draw_keyboard {  | 
| 
95
 | 
19
 | 
 
 | 
 
 | 
  
19
  
 | 
 
 | 
31
 | 
     my $self = shift;  | 
| 
96
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
     return [  | 
| 
97
 | 
19
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2076
 | 
 		[split(//, "|  | | | |  |  | | | | | |  |  | | | |  |  | | | | | |  |\n")],  | 
| 
98
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|  | | | |  |  | | | | | |  |  | | | |  |  | | | | | |  |\n")],  | 
| 
99
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|  | | | |  |  | | | | | |  |  | | | |  |  | | | | | |  |\n")],  | 
| 
100
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|  |_| |_|  |  |_| |_| |_|  |  |_| |_|  |  |_| |_| |_|  |\n")],  | 
| 
101
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|   |   |   |   |   |   |   |   |   |   |   |   |   |   |\n")],  | 
| 
102
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|   |   |   |   |   |   |   |   |   |   |   |   |   |   |\n")],  | 
| 
103
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 		[split(//, "|___|___|___|___|___|___|___|___|___|___|___|___|___|___|\n")],  | 
| 
104
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 	];  | 
| 
105
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
106
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
107
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  | 
| 
108
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
109
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 __END__  |