Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Sort out chords, stringify, and transposition.

  • Loading branch information...
commit db67a224d783aa35992e97f3a849e90e28a8f4c7 1 parent d39bfc4
@colomon authored
Showing with 22 additions and 8 deletions.
  1. +8 −4 lib/ABC/Chord.pm
  2. +6 −1 lib/ABC/Utils.pm
  3. +8 −3 t/08-transpose.t
View
12 lib/ABC/Chord.pm
@@ -13,7 +13,11 @@ class ABC::Chord does ABC::Pitched {
}
method Str() {
- $.main-note ~ $.main-accidental ~ $.main-type ~ ($.bass-note ?? '/' ~ $.bass-note ~ $.bass-accidental !! "");
+ '"' ~ $.main-note
+ ~ $.main-accidental
+ ~ $.main-type
+ ~ ($.bass-note ?? '/' ~ $.bass-note ~ $.bass-accidental !! "")
+ ~ '"';
}
method perl() {
@@ -26,17 +30,17 @@ class ABC::Chord does ABC::Pitched {
given $accidental {
when '#' { $note-accidental = '^' }
when 'b' { $note-accidental = '_' }
- when '=' { $note-accidental = '=' }
+ $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 = '' }
when '' { $new-accidental = '' }
die "Unable to handle $new-accidental in a chord name";
}
- ($new-accidental, $new-note.uc);
+ ($new-note.uc, $new-accidental);
}
my ($main-note, $main-accidental) = change-chord($.main-note, $.main-accidental);
View
7 lib/ABC/Utils.pm
@@ -11,7 +11,12 @@ package ABC::Utils {
}
}
when "inline_field" { '[' ~ $element-pair.value.key ~ ':' ~ $element-pair.value.value ~ ']'; }
- when "chord_or_text" { '"' ~ $element-pair.value ~ '"'; }
+ when "chord_or_text" {
+ $element-pair.value.map({
+ when Str { '"' ~ $_ ~ '"'; }
+ ~$_;
+ }).join('') ;
+ }
when "endline" { "\n"; }
~$element-pair.value;
}
View
11 t/08-transpose.t
@@ -19,7 +19,11 @@ use ABC::Pitched;
sub transpose(Str $test, $pitch-changer) {
my $match = ABC::Grammar.parse($test, :rule<element>, :actions(ABC::Actions.new));
if $match {
- $match.ast.value.transpose($pitch-changer);
+ given $match.ast.value {
+ when Positional { $_>>.transpose($pitch-changer); }
+ when ABC::Pitched { $_.transpose($pitch-changer); }
+ die "Don't know how to transpose { $_.WHAT }";
+ }
}
}
@@ -43,7 +47,7 @@ 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";
+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));
@@ -134,7 +138,8 @@ 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";
+is transpose('"Amin/F"', &e-flat-to-d), '"G#min/E"', "Eb to D on Amin/F yields G#min/E";
+is transpose('"Abmin/F"', &e-flat-to-d), '"Gmin/E"', "Eb to D on Abmin/F yields Gmin/E";
done;
Please sign in to comment.
Something went wrong with that request. Please try again.