Permalink
Browse files

Start ABC::KeyInfo class to hold all the information found in the ABC…

… K: field.
  • Loading branch information...
1 parent d3768b4 commit 5eb61bd3243e1d92d48830870f305e299889d26e @colomon committed Mar 3, 2013
Showing with 139 additions and 116 deletions.
  1. +4 −3 bin/abc2ly
  2. +79 −0 lib/ABC/KeyInfo.pm
  3. +0 −58 lib/ABC/Utils.pm
  4. +48 −48 t/02-key.t
  5. +8 −7 t/08-transpose.t
View
7 bin/abc2ly
@@ -9,6 +9,7 @@ use ABC::Duration; #OK
use ABC::Note;
use ABC::LongRest;
use ABC::Utils;
+use ABC::KeyInfo;
my $paper-size = "letter"; # or switch to "a4" for European paper
@@ -28,13 +29,13 @@ my %unrecognized_gracings;
class Context {
has $.key-name;
- has %.key;
+ has $.key-info;
has $.meter;
has $.length;
method new($key-name, $meter, $length) {
self.bless(*, :$key-name,
- :key(key_signature($key-name)),
+ :key-info(KeyInfo.new($key-name)),
:$meter,
:$length);
}
@@ -94,7 +95,7 @@ class Context {
}
method key-to-string() {
- my $sf = %.key.map({ "{.key}{.value}" }).sort.Str.lc;
+ my $sf = $.key-info.key.map({ "{.key}{.value}" }).sort.Str.lc;
my $major-key-name;
given $sf {
when "" { $major-key-name = "c"; }
View
79 lib/ABC/KeyInfo.pm
@@ -0,0 +1,79 @@
+use v6;
+use ABC::Grammar;
+
+class ABC::KeyInfo {
+ has %.key;
+ has $.clef;
+
+ method new($key-field, :$current-key-info) {
+ my $match = ABC::Grammar.parse($key-field, :rule<key>);
+ # say :$match.perl;
+ die "Illegal key signature\n" unless $match;
+
+ my %key-info;
+ my $clef-info;
+ if $current-key-info {
+ %key-info = $current-key-info.key;
+ $clef-info = $current-key-info.clef;
+ }
+
+ if $match<key-def> {
+ %key-info = {};
+ my %keys = (
+ 'C' => 0,
+ 'G' => 1,
+ 'D' => 2,
+ 'A' => 3,
+ 'E' => 4,
+ 'B' => 5,
+ 'F' => -1,
+ );
+
+ # say $match<key-def>.perl;
+ my $lookup = $match<key-def><basenote>.uc;
+ # say :$lookup.perl;
+ my $sharps = %keys{$match<key-def><basenote>.uc};
+ if $match<key-def><chord_accidental> {
+ given ~$match<key-def><chord_accidental> {
+ when "#" { $sharps += 7; }
+ when "b" { $sharps -= 7; }
+ }
+ }
+
+ if $match<key-def><mode> {
+ given $match<key-def><mode>[0] {
+ when so .<major> { }
+ when so .<ionian> { }
+ when so .<mixolydian> { $sharps -= 1; }
+ when so .<dorian> { $sharps -= 2; }
+ when so .<minor> { $sharps -= 3; }
+ when so .<aeolian> { $sharps -= 3; }
+ when so .<phrygian> { $sharps -= 4; }
+ when so .<locrian> { $sharps -= 5; }
+ when so .<lydian> { $sharps += 1; }
+ default { die "Unknown mode $_ requested"; }
+ }
+ }
+
+ my @sharp_notes = <F C G D A E B>;
+
+ given $sharps {
+ when 1..7 { for ^$sharps -> $i { %key-info{@sharp_notes[$i]} = "^"; } }
+ when -7..-1 { for ^(-$sharps) -> $i { %key-info{@sharp_notes[6-$i]} = "_"; } }
+ }
+
+ if $match<key-def><global-accidental> {
+ for $match<key-def><global-accidental> -> $ga {
+ %key-info{$ga<basenote>.uc} = ~$ga<accidental>;
+ }
+ }
+ }
+
+ if $match<clef> {
+ say $match<clef>.perl;
+ }
+
+ self.bless(*, :key(%key-info), :clef($clef-info));
+ }
+
+}
View
58 lib/ABC/Utils.pm
@@ -22,64 +22,6 @@ package ABC::Utils {
}
}
- sub key_signature($key_signature_name) is export
- {
- my %keys = (
- 'C' => 0,
- 'G' => 1,
- 'D' => 2,
- 'A' => 3,
- 'E' => 4,
- 'B' => 5,
- 'F' => -1,
- );
-
- my $match = ABC::Grammar.parse($key_signature_name, :rule<key>);
- # say :$match.perl;
- die "Illegal key signature\n" unless $match;
- fail unless $match<key-def>;
- # say $match<key-def>.perl;
- my $lookup = $match<key-def><basenote>.uc;
- # say :$lookup.perl;
- my $sharps = %keys{$match<key-def><basenote>.uc};
- if $match<key-def><chord_accidental> {
- given ~$match<key-def><chord_accidental> {
- when "#" { $sharps += 7; }
- when "b" { $sharps -= 7; }
- }
- }
-
- if $match<key-def><mode> {
- given $match<key-def><mode>[0] {
- when so .<major> { }
- when so .<ionian> { }
- when so .<mixolydian> { $sharps -= 1; }
- when so .<dorian> { $sharps -= 2; }
- when so .<minor> { $sharps -= 3; }
- when so .<aeolian> { $sharps -= 3; }
- when so .<phrygian> { $sharps -= 4; }
- when so .<locrian> { $sharps -= 5; }
- when so .<lydian> { $sharps += 1; }
- default { die "Unknown mode $_ requested"; }
- }
- }
-
- my @sharp_notes = <F C G D A E B>;
- my %hash;
-
- given $sharps {
- when 1..7 { for ^$sharps -> $i { %hash{@sharp_notes[$i]} = "^"; } }
- when -7..-1 { for ^(-$sharps) -> $i { %hash{@sharp_notes[6-$i]} = "_"; } }
- }
-
- if $match<key-def><global-accidental> {
- for $match<key-def><global-accidental> -> $ga {
- %hash{$ga<basenote>.uc} = ~$ga<accidental>;
- }
- }
-
- return %hash;
- }
sub apply_key_signature(%key_signature, $pitch) is export
{
View
96 t/02-key.t
@@ -2,83 +2,83 @@ use v6;
use Test;
use ABC::Grammar;
use ABC::Utils;
+use ABC::KeyInfo;
{
- my %key = key_signature("D");
- is %key.elems, 2, "D has two sharps";
- is %key<F>, "^", "F is sharp";
- is %key<C>, "^", "C is sharp";
+ my $key = ABC::KeyInfo.new("D");
+ is $key.key.elems, 2, "D has two sharps";
+ is $key.key<F>, "^", "F is sharp";
+ is $key.key<C>, "^", "C is sharp";
}
{
- my %key = key_signature("Dmix");
- is %key.elems, 1, "Dmix has one sharp";
- is %key<F>, "^", "F is sharp";
+ my $key = ABC::KeyInfo.new("Dmix");
+ is $key.key.elems, 1, "Dmix has one sharp";
+ is $key.key<F>, "^", "F is sharp";
}
{
- my %key = key_signature("Am");
- is %key.elems, 0, "Am has no sharps or flats";
+ my $key = ABC::KeyInfo.new("Am");
+ is $key.key.elems, 0, "Am has no sharps or flats";
}
{
- my %key = key_signature("Ddor");
- is %key.elems, 0, "Ddor has no sharps or flats";
+ my $key = ABC::KeyInfo.new("Ddor");
+ is $key.key.elems, 0, "Ddor has no sharps or flats";
}
{
- my %key = key_signature("Ador");
- is %key.elems, 1, "Ador has one sharp";
- is %key<F>, "^", "F is sharp";
+ my $key = ABC::KeyInfo.new("Ador");
+ is $key.key.elems, 1, "Ador has one sharp";
+ is $key.key<F>, "^", "F is sharp";
}
{
- my %key = key_signature("Amix");
- is %key.elems, 2, "Amix has two sharps";
- is %key<F>, "^", "F is sharp";
- is %key<C>, "^", "C is sharp";
+ my $key = ABC::KeyInfo.new("Amix");
+ is $key.key.elems, 2, "Amix has two sharps";
+ is $key.key<F>, "^", "F is sharp";
+ is $key.key<C>, "^", "C is sharp";
}
{
- my %key = key_signature("C#m");
- is %key.elems, 4, "C#m has four sharps";
- is %key<F>, "^", "F is sharp";
- is %key<C>, "^", "C is sharp";
- is %key<G>, "^", "G is sharp";
- is %key<D>, "^", "D is sharp";
+ my $key = ABC::KeyInfo.new("C#m");
+ is $key.key.elems, 4, "C#m has four sharps";
+ is $key.key<F>, "^", "F is sharp";
+ is $key.key<C>, "^", "C is sharp";
+ is $key.key<G>, "^", "G is sharp";
+ is $key.key<D>, "^", "D is sharp";
}
{
- my %key = key_signature("C#");
- is %key.elems, 7, "C# has seven sharps";
- is %key<F>, "^", "F is sharp";
- is %key<C>, "^", "C is sharp";
- is %key<G>, "^", "G is sharp";
- is %key<D>, "^", "D is sharp";
- is %key<A>, "^", "A is sharp";
- is %key<E>, "^", "E is sharp";
- is %key<B>, "^", "B is sharp";
+ my $key = ABC::KeyInfo.new("C#");
+ is $key.key.elems, 7, "C# has seven sharps";
+ is $key.key<F>, "^", "F is sharp";
+ is $key.key<C>, "^", "C is sharp";
+ is $key.key<G>, "^", "G is sharp";
+ is $key.key<D>, "^", "D is sharp";
+ is $key.key<A>, "^", "A is sharp";
+ is $key.key<E>, "^", "E is sharp";
+ is $key.key<B>, "^", "B is sharp";
}
{
- my %key = key_signature("C ^f _b");
- is %key.elems, 2, "C ^f _b has two thingees";
- is %key<F>, "^", "F is sharp";
- is %key<B>, "_", "B is flat";
+ my $key = ABC::KeyInfo.new("C ^f _b");
+ is $key.key.elems, 2, "C ^f _b has two thingees";
+ is $key.key<F>, "^", "F is sharp";
+ is $key.key<B>, "_", "B is flat";
}
{
- my %key = key_signature("C#m");
- is apply_key_signature(%key, ABC::Grammar.parse("f", :rule<pitch>)), "^f", "f => ^f";
- is apply_key_signature(%key, ABC::Grammar.parse("C", :rule<pitch>)), "^C", "C => ^C";
- is apply_key_signature(%key, ABC::Grammar.parse("G", :rule<pitch>)), "^G", "G => ^G";
- is apply_key_signature(%key, ABC::Grammar.parse("d", :rule<pitch>)), "^d", "d => ^d";
- is apply_key_signature(%key, ABC::Grammar.parse("_f", :rule<pitch>)), "_f", "_f => _f";
- is apply_key_signature(%key, ABC::Grammar.parse("=C", :rule<pitch>)), "=C", "=C => =C";
- is apply_key_signature(%key, ABC::Grammar.parse("^G", :rule<pitch>)), "^G", "^G => ^G";
- is apply_key_signature(%key, ABC::Grammar.parse("^^d", :rule<pitch>)), "^^d", "^^d => ^^d";
- is apply_key_signature(%key, ABC::Grammar.parse("b'", :rule<pitch>)), "b'", "b' => b'";
+ my $key = ABC::KeyInfo.new("C#m");
+ is apply_key_signature($key.key, ABC::Grammar.parse("f", :rule<pitch>)), "^f", "f => ^f";
+ is apply_key_signature($key.key, ABC::Grammar.parse("C", :rule<pitch>)), "^C", "C => ^C";
+ is apply_key_signature($key.key, ABC::Grammar.parse("G", :rule<pitch>)), "^G", "G => ^G";
+ is apply_key_signature($key.key, ABC::Grammar.parse("d", :rule<pitch>)), "^d", "d => ^d";
+ is apply_key_signature($key.key, ABC::Grammar.parse("_f", :rule<pitch>)), "_f", "_f => _f";
+ is apply_key_signature($key.key, ABC::Grammar.parse("=C", :rule<pitch>)), "=C", "=C => =C";
+ is apply_key_signature($key.key, ABC::Grammar.parse("^G", :rule<pitch>)), "^G", "^G => ^G";
+ is apply_key_signature($key.key, ABC::Grammar.parse("^^d", :rule<pitch>)), "^^d", "^^d => ^^d";
+ is apply_key_signature($key.key, ABC::Grammar.parse("b'", :rule<pitch>)), "b'", "b' => b'";
}
-
done;
View
15 t/08-transpose.t
@@ -15,6 +15,7 @@ use ABC::GraceNotes;
use ABC::Actions;
use ABC::Utils;
use ABC::Pitched;
+use ABC::KeyInfo;
sub transpose(Str $test, $pitch-changer) {
my $match = ABC::Grammar.parse($test, :rule<element>, :actions(ABC::Actions.new));
@@ -57,7 +58,7 @@ sub pitch2ordinal(%key, $test) {
}
{
- my %key = key_signature("C");
+ my %key = ABC::KeyInfo.new("C").key;
is pitch2ordinal(%key, "C"), 0, "C ==> 0";
is pitch2ordinal(%key, "D"), 2, "D ==> 2";
is pitch2ordinal(%key, "E"), 4, "E ==> 4";
@@ -74,7 +75,7 @@ sub pitch2ordinal(%key, $test) {
is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27";
is pitch2ordinal(%key, "d'''"), 50, "d''' ==> 50";
- %key = key_signature("Ab");
+ %key = ABC::KeyInfo.new("Ab").key;
is pitch2ordinal(%key, "C"), 0, "C ==> 0";
is pitch2ordinal(%key, "D"), 1, "D ==> 1";
is pitch2ordinal(%key, "E"), 3, "E ==> 3";
@@ -91,7 +92,7 @@ sub pitch2ordinal(%key, $test) {
is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27";
is pitch2ordinal(%key, "d'''"), 49, "d''' ==> 49";
- %key = key_signature("C");
+ %key = ABC::KeyInfo.new("C").key;
is ordinal-to-pitch(%key, "C", 0), " C ", "0/C => C";
is ordinal-to-pitch(%key, "D", 0), "__ D ", "0/D => __D";
is ordinal-to-pitch(%key, "B", 0), "^ B ,", "0/B => ^B,";
@@ -122,8 +123,8 @@ sub pitch2ordinal(%key, $test) {
}
sub e-flat-to-d($accidental, $basenote, $octave) {
- my %e-flat = key_signature("Eb");
- my %d = key_signature("D");
+ my %e-flat = ABC::KeyInfo.new("Eb").key;
+ my %d = ABC::KeyInfo.new("D").key;
my $ordinal = pitch-to-ordinal(%e-flat, $accidental, $basenote, $octave);
my $basenote-in-d = $basenote.uc eq "A" ?? "G" !! ($basenote.ord - 1).chr.uc;
ordinal-to-pitch(%d, $basenote-in-d, $ordinal - 1);
@@ -153,8 +154,8 @@ class Transposer {
}
method set-key($new-key) {
- %.current-from = key_signature($new-key);
- %.current-to = key_signature(%.key-changes{$new-key});
+ %.current-from = ABC::KeyInfo.new($new-key).key;
+ %.current-to = ABC::KeyInfo.new(%.key-changes{$new-key}).key;
# $.pitch-name-shift = $new-key.
}

0 comments on commit 5eb61bd

Please sign in to comment.