File Coverage

blib/lib/Text/Chord/Piano.pm
Criterion Covered Total %
statement 57 57 100.0
branch 14 14 100.0
condition 2 2 100.0
subroutine 13 13 100.0
pod 6 6 100.0
total 92 92 100.0


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__