Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Move some stuff to ABC::Utils, pitch-to-ordinal and ordinal-to-pitch …

…subs.
  • Loading branch information...
commit d39bfc46c9df93f2e3326e131465a38c6627b642 1 parent 8841e3b
@colomon authored
View
9 bin/abc2ly
@@ -6,6 +6,7 @@ use ABC::Actions;
use ABC::Duration; #OK
use ABC::Note;
use ABC::LongRest;
+use ABC::Utils;
my $paper-size = "letter"; # or switch to "a4" for European paper
@@ -23,14 +24,6 @@ my %octave-map = ( -1 => "",
my %unrecognized_gracings;
-sub is-a-power-of-two($n) {
- if $n ~~ Rat {
- is-a-power-of-two($n.numerator) && is-a-power-of-two($n.denominator);
- } else {
- !($n +& ($n - 1));
- }
-}
-
class Context {
has $.key-name;
has %.key;
View
27 lib/ABC/Chord.pm
@@ -1,6 +1,7 @@
use v6;
+use ABC::Pitched;
-class ABC::Chord {
+class ABC::Chord does ABC::Pitched {
has $.main-note;
has $.main-accidental;
has $.main-type;
@@ -18,4 +19,28 @@ class ABC::Chord {
method perl() {
"ABC::Chord.new({ $.main-note.perl }, { $.main-accidental.perl }, { $.main-type.perl }, { $.bass-note.perl }, { $.bass-accidental.perl })";
}
+
+ method transpose($pitch-changer) {
+ sub change-chord($note, $accidental) {
+ my $note-accidental;
+ given $accidental {
+ when '#' { $note-accidental = '^' }
+ when 'b' { $note-accidental = '_' }
+ when '=' { $note-accidental = '=' }
+ }
+ my ($new-accidental, $new-note, $new-octave) = $pitch-changer($note-accidental, $note, "");
+ given $new-accidental {
+ when '^' { $new-accidental = '#' }
+ when '_' { $new-accidental = 'b' }
+ when '=' { $new-accidental = '=' }
+ when '' { $new-accidental = '' }
+ die "Unable to handle $new-accidental in a chord name";
+ }
+ ($new-accidental, $new-note.uc);
+ }
+
+ my ($main-note, $main-accidental) = change-chord($.main-note, $.main-accidental);
+ my ($bass-note, $bass-accidental) = change-chord($.bass-note, $.bass-accidental);
+ ABC::Chord.new($main-note, $main-accidental, $.main-type, $bass-note, $bass-accidental);
+ }
}
View
76 lib/ABC/Grammar.pm
@@ -91,82 +91,6 @@ grammar ABC::Grammar
token tune_file { \s* [<tune> \s*]+ }
token key_sig { <basenote> ('#' | 'b')? \h* (\w*) }
-
- our sub key_signature($key_signature_name) is export
- {
- 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
- );
-
- # say :$key_signature_name.perl;
-
- my $match = ABC::Grammar.parse($key_signature_name, :rule<key_sig>);
- # say :$match.perl;
- die "Illegal key signature\n" unless $match;
- my $lookup = $match<basenote>.uc ~ ($match[0] // "");
- # say :$lookup.perl;
- my $sharps = %keys{$lookup};
-
- # say :$sharps.perl;
-
- 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;
- }
-
- our sub apply_key_signature(%key_signature, $pitch)
- {
- my $resulting_note = "";
- if $pitch<accidental>
- {
- $resulting_note ~= $pitch<accidental>.Str;
- }
- else
- {
- if %key_signature.exists($pitch<basenote>.uc) {
- $resulting_note ~= %key_signature{$pitch<basenote>.uc};
- }
- }
- $resulting_note ~= $pitch<basenote>.Str;
- $resulting_note ~= $pitch<octave>.Str if $pitch<octave>;
- return $resulting_note;
- }
}
sub header_hash($header_match) #OK
View
151 lib/ABC/Utils.pm
@@ -1,3 +1,6 @@
+use v6;
+use ABC::Grammar;
+
package ABC::Utils {
sub ElementToStr($element-pair) is export {
given $element-pair.key {
@@ -13,6 +16,154 @@ package ABC::Utils {
~$element-pair.value;
}
}
+
+ sub key_signature($key_signature_name) is export
+ {
+ 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
+ );
+
+ # say :$key_signature_name.perl;
+
+ my $match = ABC::Grammar.parse($key_signature_name, :rule<key_sig>);
+ # say :$match.perl;
+ die "Illegal key signature\n" unless $match;
+ my $lookup = $match<basenote>.uc ~ ($match[0] // "");
+ # say :$lookup.perl;
+ my $sharps = %keys{$lookup};
+
+ # say :$sharps.perl;
+
+ 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;
+ }
+
+ sub apply_key_signature(%key_signature, $pitch) is export
+ {
+ my $resulting_note = "";
+ if $pitch<accidental>
+ {
+ $resulting_note ~= $pitch<accidental>.Str;
+ }
+ else
+ {
+ if %key_signature.exists($pitch<basenote>.uc) {
+ $resulting_note ~= %key_signature{$pitch<basenote>.uc};
+ }
+ }
+ $resulting_note ~= $pitch<basenote>.Str;
+ $resulting_note ~= $pitch<octave>.Str if $pitch<octave>;
+ return $resulting_note;
+ }
+
+ sub is-a-power-of-two($n) is export {
+ if $n ~~ Rat {
+ is-a-power-of-two($n.numerator) && is-a-power-of-two($n.denominator);
+ } else {
+ !($n +& ($n - 1));
+ }
+ }
+
+ my %notename-to-ordinal = (
+ C => 0,
+ D => 2,
+ E => 4,
+ F => 5,
+ G => 7,
+ A => 9,
+ B => 11,
+ c => 12,
+ d => 14,
+ e => 16,
+ f => 17,
+ g => 19,
+ a => 21,
+ b => 23
+ );
+
+ sub pitch-to-ordinal(%key, $accidental, $basenote, $octave) is export {
+ my $ord = %notename-to-ordinal{$basenote};
+ given $accidental || %key{$basenote.uc} || "" {
+ when /^ "^"+ $/ { $ord += $_.chars; }
+ when /^ "_"+ $/ { $ord -= $_.chars; }
+ }
+ given $octave {
+ when /^ "'"+ $/ { $ord += $_.chars * 12}
+ when /^ ","+ $/ { $ord -= $_.chars * 12}
+ when "" { }
+ die "Unable to recognize octave $octave";
+ }
+ $ord;
+ }
+
+ sub ordinal-to-pitch(%key, $basenote, $ordinal) is export {
+ my $octave = 0;
+ my $working-ordinal = %notename-to-ordinal{$basenote.uc};
+ while $ordinal + 5 < $working-ordinal {
+ $working-ordinal -= 12;
+ $octave -= 1;
+ }
+ while $working-ordinal + 5 < $ordinal {
+ $working-ordinal += 12;
+ $octave += 1;
+ }
+
+ my $key-accidental = %key{$basenote.uc} || "=";
+ my $working-accidental;
+ given $ordinal - $working-ordinal {
+ when -2 { $working-accidental = "__"; }
+ when -1 { $working-accidental = "_"; }
+ when 0 { $working-accidental = "="; }
+ when 1 { $working-accidental = "^"; }
+ when 2 { $working-accidental = "^^"; }
+ die "Too far away from note: $ordinal vs $working-ordinal";
+ }
+ if $key-accidental eq $working-accidental {
+ $working-accidental = "";
+ }
+ if $octave > 0 {
+ ($working-accidental, $basenote.lc, "'" x ($octave - 1));
+ } else {
+ ($working-accidental, $basenote.uc, "," x -$octave);
+ }
+ }
}
View
37 t/02-key.t
@@ -1,45 +1,46 @@
use v6;
use Test;
use ABC::Grammar;
+use ABC::Utils;
{
- my %key = ABC::Grammar::key_signature("D");
+ 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::Grammar::key_signature("Dmix");
+ my %key = key_signature("Dmix");
is %key.elems, 1, "Dmix has one sharp";
is %key<F>, "^", "F is sharp";
}
{
- my %key = ABC::Grammar::key_signature("Am");
+ my %key = key_signature("Am");
is %key.elems, 0, "Am has no sharps or flats";
}
{
- my %key = ABC::Grammar::key_signature("Ddor");
+ my %key = key_signature("Ddor");
is %key.elems, 0, "Ddor has no sharps or flats";
}
{
- my %key = ABC::Grammar::key_signature("Ador");
+ my %key = key_signature("Ador");
is %key.elems, 1, "Ador has one sharp";
is %key<F>, "^", "F is sharp";
}
{
- my %key = ABC::Grammar::key_signature("Amix");
+ 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::Grammar::key_signature("C#m");
+ 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";
@@ -48,7 +49,7 @@ use ABC::Grammar;
}
{
- my %key = ABC::Grammar::key_signature("C#");
+ 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";
@@ -60,16 +61,16 @@ use ABC::Grammar;
}
{
- my %key = ABC::Grammar::key_signature("C#m");
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("f", :rule<pitch>)), "^f", "f => ^f";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("C", :rule<pitch>)), "^C", "C => ^C";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("G", :rule<pitch>)), "^G", "G => ^G";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("d", :rule<pitch>)), "^d", "d => ^d";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("_f", :rule<pitch>)), "_f", "_f => _f";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("=C", :rule<pitch>)), "=C", "=C => =C";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("^G", :rule<pitch>)), "^G", "^G => ^G";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("^^d", :rule<pitch>)), "^^d", "^^d => ^^d";
- is ABC::Grammar::apply_key_signature(%key, ABC::Grammar.parse("b'", :rule<pitch>)), "b'", "b' => b'";
+ 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'";
}
View
92 t/08-transpose.t
@@ -43,6 +43,98 @@ is transpose("[C,Eg]", &up-octave), "[Ceg']", "Octave bump to [C,Eg] yields [Ceg
is transpose("(3C,Eg", &up-octave), "(3Ceg'", "Octave bump to (3C,Eg yields (3Ceg'";
is transpose("A<a", &up-octave), "a<a'", "Octave bump to A<a yields a<a'";
is transpose('{Bc}', &up-octave), '{bc\'}', "Octave bump to Bc yields bc'";
+# is transpose('"Amin/F"', &up-octave), '"Amin/F"', "Octave bump to chord yields no change";
+
+sub pitch2ordinal(%key, $test) {
+ my $match = ABC::Grammar.parse($test, :rule<mnote>, :actions(ABC::Actions.new));
+ if $match {
+ pitch-to-ordinal(%key, $match.ast.accidental, $match.ast.basenote, $match.ast.octave);
+ }
+}
+
+{
+ my %key = key_signature("C");
+ is pitch2ordinal(%key, "C"), 0, "C ==> 0";
+ is pitch2ordinal(%key, "D"), 2, "D ==> 2";
+ is pitch2ordinal(%key, "E"), 4, "E ==> 4";
+ is pitch2ordinal(%key, "F"), 5, "F ==> 5";
+ is pitch2ordinal(%key, "G"), 7, "G ==> 7";
+ is pitch2ordinal(%key, "A"), 9, "A ==> 9";
+ is pitch2ordinal(%key, "B"), 11, "B ==> 11";
+ is pitch2ordinal(%key, "c"), 12, "c ==> 12";
+ is pitch2ordinal(%key, "=A"), 9, "=A ==> 9";
+ is pitch2ordinal(%key, "^A"), 10, "^A ==> 10";
+ is pitch2ordinal(%key, "_A"), 8, "_A ==> 8";
+ is pitch2ordinal(%key, "^^A"), 11, "^^A ==> 11";
+ is pitch2ordinal(%key, "__A"), 7, "__A ==> 7";
+ is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27";
+ is pitch2ordinal(%key, "d'''"), 50, "d''' ==> 50";
+
+ %key = key_signature("Ab");
+ is pitch2ordinal(%key, "C"), 0, "C ==> 0";
+ is pitch2ordinal(%key, "D"), 1, "D ==> 1";
+ is pitch2ordinal(%key, "E"), 3, "E ==> 3";
+ is pitch2ordinal(%key, "F"), 5, "F ==> 5";
+ is pitch2ordinal(%key, "G"), 7, "G ==> 7";
+ is pitch2ordinal(%key, "A"), 8, "A ==> 8";
+ is pitch2ordinal(%key, "B"), 10, "B ==> 10";
+ is pitch2ordinal(%key, "c"), 12, "c ==> 12";
+ is pitch2ordinal(%key, "=A"), 9, "=A ==> 9";
+ is pitch2ordinal(%key, "^A"), 10, "^A ==> 10";
+ is pitch2ordinal(%key, "_A"), 8, "_A ==> 8";
+ is pitch2ordinal(%key, "^^A"), 11, "^^A ==> 11";
+ is pitch2ordinal(%key, "__A"), 7, "__A ==> 7";
+ is pitch2ordinal(%key, "^^G,,,"), -27, "^^G,,, ==> -27";
+ is pitch2ordinal(%key, "d'''"), 49, "d''' ==> 49";
+
+ %key = key_signature("C");
+ 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,";
+ is ordinal-to-pitch(%key, "C", 1), "^ C ", "1/C => ^C";
+ is ordinal-to-pitch(%key, "D", 1), "_ D ", "1/D => _D";
+ is ordinal-to-pitch(%key, "B", 1), "^^ B ,", "1/B => ^^B,";
+ is ordinal-to-pitch(%key, "C", -1), "_ C ", "-1/C => _C";
+ is ordinal-to-pitch(%key, "B", -1), " B ,", "-1/B => B,";
+ is ordinal-to-pitch(%key, "C", -12), " C ,", "-12/C => C,";
+ is ordinal-to-pitch(%key, "D", -12), "__ D ,", "-12/D => __D,";
+ is ordinal-to-pitch(%key, "B", -12), "^ B ,,", "-12/B => ^B,,";
+ is ordinal-to-pitch(%key, "C", 11), "_ c ", "11/C => _c";
+ is ordinal-to-pitch(%key, "B", 11), " B ", "11/B => B";
+ is ordinal-to-pitch(%key, "C", 12), " c ", "12/C => c";
+ is ordinal-to-pitch(%key, "D", 12), "__ d ", "12/D => __d";
+ is ordinal-to-pitch(%key, "B", 12), "^ B ", "12/B => ^B";
+ is ordinal-to-pitch(%key, "C", 13), "^ c ", "1/C => ^c";
+ is ordinal-to-pitch(%key, "D", 13), "_ d ", "1/D => _d";
+ is ordinal-to-pitch(%key, "B", 13), "^^ B ", "1/B => ^^B";
+ is ordinal-to-pitch(%key, "C", 23), "_ c '", "23/C => _c'";
+ is ordinal-to-pitch(%key, "B", 23), " b ", "23/B => b";
+ is ordinal-to-pitch(%key, "C", 24), " c '", "24/C => c'";
+ is ordinal-to-pitch(%key, "D", 24), "__ d '", "24/D => __d'";
+ is ordinal-to-pitch(%key, "B", 24), "^ b ", "24/B => ^b";
+ is ordinal-to-pitch(%key, "C", 25), "^ c '", "25/C => ^c'";
+ is ordinal-to-pitch(%key, "D", 25), "_ d '", "25/D => _d'";
+ is ordinal-to-pitch(%key, "B", 25), "^^ b ", "25/B => ^^b";
+}
+
+sub e-flat-to-d($accidental, $basenote, $octave) {
+ my %e-flat = key_signature("Eb");
+ my %d = key_signature("D");
+ 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);
+}
+
+is transpose("A", &e-flat-to-d), "G", "Eb to D on A yields G";
+is transpose("a", &e-flat-to-d), "g", "Eb to D on a yields g";
+is transpose("a''2", &e-flat-to-d), "g''2", "Eb to D on a'' yields g''";
+is transpose("A,-", &e-flat-to-d), "G,-", "Eb to D on A,- yields G,-";
+is transpose("[_EG_B]", &e-flat-to-d), "[DFA]", "Eb to D on [_EG_B] yields [DFA]";
+is transpose("[EGB]", &e-flat-to-d), "[DFA]", "Eb to D on [EGB] yields [DFA]";
+is transpose("(3C,Eg", &e-flat-to-d), "(3B,,Df", "Eb to D on (3C,Eg yields (3B,,Df";
+is transpose("=A<a", &e-flat-to-d), "^G<g", "Eb to D on =A<a yields ^G<g";
+is transpose('{Bc}', &e-flat-to-d), '{AB}', "Eb to D on Bc yields AB";
+# is transpose('"Amin/F"', &e-flat-to-d), '"Amin/F"', "Eb to D on chord yields no change";
done;
Please sign in to comment.
Something went wrong with that request. Please try again.