Permalink
Browse files

Move key_signature to ABC.pm and start tests for it.

  • Loading branch information...
1 parent 94fb445 commit 325c475e760e6919b82e23f47af9db8226ac932d @LastOfTheCarelessMen committed Dec 30, 2009
Showing with 119 additions and 57 deletions.
  1. +52 −0 lib/ABC.pm
  2. +3 −57 playing.pl
  3. +64 −0 t/02-key.t
View
@@ -39,6 +39,58 @@ grammar ABC
regex tune { <header> <music> }
}
+sub key_signature($key_signature_name)
+{
+ my %keys = (
+ 'C' => 0,
+ 'G' => 1,
+ 'D' => 2,
+ 'A' => 3,
+ 'E' => 4,
+ 'B' => 5,
+ 'F#' => 6,
+ 'C#' => 7,
+ 'F' => -1,
+ 'Bb' => -2,
+ 'Eb' => -3,
+ 'Ab' => -4,
+ 'Db' => -5,
+ 'Gb' => -6,
+ 'Cb' => -7
+ );
+
+ my $match = $key_signature_name ~~ m/ <ABC::basenote> ('#' | 'b')? \h* (\w*) /;
+ die "Illegal key signature\n" unless $match ~~ Match;
+ my $lookup = [~] $match<ABC::basenote>.uc, $match[0];
+ my $sharps = %keys{$lookup};
+
+ if ($match[1].defined) {
+ given ~($match[1]) {
+ when "" { }
+ when /^maj/ { }
+ when /^ion/ { }
+ when /^mix/ { $sharps -= 1; }
+ when /^dor/ { $sharps -= 2; }
+ when /^m/ { $sharps -= 3; }
+ when /^aeo/ { $sharps -= 3; }
+ when /^phr/ { $sharps -= 4; }
+ when /^loc/ { $sharps -= 5; }
+ when /^lyd/ { $sharps += 1; }
+ default { die "Unknown mode {$match[1]} 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]} = "_"; } }
+ }
+
+ return %hash;
+}
+
class ABCHeader
{
View
@@ -30,62 +30,8 @@
}
}
-sub key_signature($key_signature_name)
-{
- my %keys = (
- 'C' => 0,
- 'G' => 1,
- 'D' => 2,
- 'A' => 3,
- 'E' => 4,
- 'B' => 5,
- 'F#' => 6,
- 'C#' => 7,
- 'F' => -1,
- 'Bb' => -2,
- 'Eb' => -3,
- 'Ab' => -4,
- 'Db' => -5,
- 'Gb' => -6,
- 'Cb' => -7
- );
-
- $match = $key_signature_name ~~ m/ <ABC::basenote> ('#' | 'b')? (\w*) /;
- die "Illegal key signature\n" unless $match ~~ Match;
- say "$key_signature_name:";
- my $lookup = [~] $match<ABC::basenote>.uc, $match[0];
- my $sharps = %keys{$lookup};
-
- if ($match[1].defined) {
- given ~($match[1]) {
- when "" { }
- when /^maj/ { }
- when /^ion/ { }
- when /^mix/ { $sharps -= 1; }
- when /^dor/ { $sharps -= 2; }
- when /^m/ { $sharps -= 3; }
- when /^aeo/ { $sharps -= 3; }
- when /^phr/ { $sharps -= 4; }
- when /^loc/ { $sharps -= 5; }
- when /^lyd/ { $sharps += 1; }
- default { die "Unknown mode {$match[1]} requested"; }
- }
- }
-
- my @sharp_notes = <F C G D A E B>;
- my %hash = @sharp_notes Z @sharp_notes;
-
- given $sharps {
- when 1..7 { for ^$sharps -> $i { %hash{@sharp_notes[$i]} = "^" ~ @sharp_notes[$i]; } }
- when -7..-1 { for ^(-$sharps) -> $i { %hash{@sharp_notes[6-$i]} = "_" ~ @sharp_notes[6-$i]; } }
- }
-
- say %hash.perl;
-
-}
-
# @notes.map({.<pitch>.say});
-key_signature("Abmix");
-key_signature("Ab");
-key_signature("Amix");
+say key_signature("Ab mix").perl;
+say key_signature("Ab").perl;
+say key_signature("Amix").perl;
View
@@ -0,0 +1,64 @@
+use v6;
+use Test;
+use ABC;
+
+plan *;
+
+{
+ 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 = key_signature("Dmix");
+ is %key.elems, 1, "Dmix has one sharp";
+ is %key<F>, "^", "F is sharp";
+}
+
+{
+ my %key = key_signature("Am");
+ is %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 = key_signature("Ador");
+ is %key.elems, 1, "Ador has one sharp";
+ is %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 = 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 = 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";
+}
+
+done_testing;

0 comments on commit 325c475

Please sign in to comment.