root/lang/perl/Music-Chord-Note/trunk/lib/Music/Chord/Note.pm @ 25323

Revision 25323, 4.8 kB (checked in by bayashi, 6 years ago)

C->C E Gとかします

Line 
1package Music::Chord::Note;
2
3use warnings;
4use strict;
5use Carp qw( croak );
6
7our $VERSION = '0.0.1';
8
9my @tone_list = ('C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B',
10                 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B');
11
12my $base_chord_list = {
13    'base'     => '0,4,7',
14    'b5'       => '0,4,6',
15    '6'        => '0,4,7,9',
16    '6(9)'     => '0,4,7,9,14',         '69'       => '0,4,7,9,14',
17    'M7'       => '0,4,7,11',
18    'M7(9)'    => '0,4,7,11,14',        'M79'       => '0,4,7,11,14',
19    'M9'       => '0,4,7,11,14',
20    '7'        => '0,4,7,10',
21    '7(b5)'    => '0,4,6,10',           '7b5'      => '0,4,6,10',
22    '7(b9)'    => '0,4,7,10,13',        '7b9'      => '0,4,7,10,13',
23    'b9'       => '0,4,7,10,13',
24    'b9(#5)'   => '0,4,8,10,13',        'b9#5'     => '0,4,8,10,13',
25    #'7(b9,13)' => '',
26    '7(#9)'    => '0,4,7,10,15',        '7+9'      => '0,4,7,10,15',
27    '7(#11)'   => '0,4,7,10,15,18',     '7+11'     => '0,4,7,10,15,18',
28    '7(#13)'   => '0,4,10,21',          '7+13'     => '0,4,10,21',
29    '9'        => '0,4,7,10,14',
30    '9(b5)'    => '0,4,6,10,14',        '9b5'      => '0,4,6,10,14',
31    '11'       => '0,4,7,10,14,17',
32    '13'       => '0,4,7,10,14,17,21',
33    'm'        => '0,3,7',
34    'm6'       => '0,3,7,9',
35    'm6(9)'    => '0,3,7,9,14',          'm69'     => '0,3,7,9,14',
36    'mM7'      => '0,3,7,11',
37    'm7'       => '0,3,7,10',
38    'm7(b5)'   => '0,3,6,10',            'm7b5'    => '0,3,6,10',
39    'm7(9)'    => '0,3,7,10,14',         'm79'     => '0,3,7,10,14',
40    'm9'       => '0,3,7,10,14',
41    'm7(9,11)' => '0,3,7,10,14,17',
42    'm11'      => '0,3,7,10,14,17',
43    'm13'      => '0,3,7,10,14,17,21',
44    'dim'      => '0,3,6',
45    'dim7'     => '0,3,6,9',
46    'aug'      => '0,4,8',
47    'aug7'     => '0,4,8,10',
48    'augM7'    => '0,4,8,11',
49    'aug9'     => '0,4,8,10,14',
50    'sus4'     => '0,5,7',
51    '7sus4'    => '0,5,7,10',
52    'add2'     => '0,2,4,7',
53    'add4'     => '0,4,5,7',
54    'add9'     => '0,4,7,14',
55};
56
57my $scalic_value = {
58    'C'  => 0,
59    'C#' => 1, 'Db' => 1,
60    'D'  => 2,
61    'D#' => 3, 'Eb' => 3,
62    'E'  => 4,
63    'E#' => 5, 'Fb' => 4, # joke!
64    'F'  => 5,
65    'F#' => 6, 'Gb' => 6,
66    'G'  => 7,
67    'G#' => 8, 'Ab' => 8,
68    'A'  => 9,
69    'A#' => 10, 'Bb' => 10,
70    'B'  => 11,
71    'Cb' => 11, 'B#' => 0, # joke!
72};
73
74sub new {
75    my $class = shift;
76    bless {}, $class;
77}
78
79sub chord {
80    my ($self, $chord_name) = @_;
81    croak "No CHORD_NAME!" unless $chord_name;
82    my ($tonic, $kind) = ($chord_name =~ /([A-G][b#]?)(.+)?/);
83    croak("unknown chord $chord_name") unless defined $tonic;
84    $kind = 'base' unless $kind;
85    my $scalic = $scalic_value->{$tonic};
86    croak("undefined kind of chord $kind($chord_name)") unless defined $base_chord_list->{$kind};
87    my @keys;
88    for my $scale ( split(/\,/, $base_chord_list->{$kind}) ){
89        my $note = $scale + $scalic;
90        $note = int($note % 24) + 12 if $note > 23;
91        push(@keys, $tone_list[$note]);
92    }
93    return @keys;
94}
95
961;
97
98__END__
99
100
101=head1 NAME
102
103Music::Chord::Note - get Chord Tone List from Chord Name
104
105
106=head1 SYNOPSIS
107
108    use Music::Chord::Note;
109
110    my $cn = Music::Chord::Note->new();
111
112    my @tone = $cn->chord('CM7');
113
114    print "@tone"; # C E G B
115
116
117=head1 METHOD
118
119=over
120
121=item new()
122
123constructor
124
125=item chord($chord_name)
126
127get tone list from chord name
128
129=back
130
131
132=head1 AUTHOR
133
134Copyright (c) 2008, Dai Okabayashi C<< <bayashi@cpan.org> >>
135
136
137=head1 LICENCE
138
139This module is free software; you can redistribute it and/or
140modify it under the same terms as Perl itself. See L<perlartistic>.
141
142
143=head1 DISCLAIMER OF WARRANTY
144
145BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
146FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
147OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
148PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
149EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
150WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
151ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
152YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
153NECESSARY SERVICING, REPAIR, OR CORRECTION.
154
155IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
156WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
157REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
158LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
159OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
160THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
161RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
162FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
163SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
164SUCH DAMAGES.
Note: See TracBrowser for help on using the browser.