Permalink
Browse files

Try to start setting up framework for transposition.

  • Loading branch information...
1 parent 053cc8a commit d13c7adafaec934ab9e8ed1d3b53fe427f6725f4 @colomon committed Jun 3, 2012
Showing with 65 additions and 3 deletions.
  1. +3 −3 bin/abctranspose
  2. +5 −0 lib/ABC/Note.pm
  3. +5 −0 lib/ABC/Pitched.pm
  4. +9 −0 lib/ABC/Tune.pm
  5. +43 −0 t/08-transpose.t
View
@@ -14,8 +14,8 @@ sub print-header($out, $header) {
}
}
-sub print-music($out, $tune) {
- for $tune.music -> $element {
+sub print-music($out, @music) {
+ for @music -> $element {
print ElementToStr($element);
}
}
@@ -34,7 +34,7 @@ sub Transpose($in, $out) {
# my $meter = $tune.header.get-first-value("M");
# my $length = $tune.header.get-first-value("L") // "1/8";
- print-music($out, $tune);
+ print-music($out, $tune.music);
}
}
View
@@ -23,4 +23,9 @@ class ABC::Note does ABC::Duration {
method perl() {
"ABC::Note.new({ $.accidental.perl }, { $.basenote.perl }, { $.octave.perl } { $.ticks.perl }, { $.is-tie.perl })";
}
+
+ method transpose($pitch-changer) {
+ my ($new-accidental, $new-basenote, $new-octave) = $pitch-changer($.accidental, $.basenote, $.octave);
+ ABC::Note.new($new-accidental, $new-basenote, $new-octave, self, $.is-tie);
+ }
}
View
@@ -0,0 +1,5 @@
+use v6;
+
+role ABC::Pitched {
+ method transpose($pitch-changer) { ... }
+}
View
@@ -1,5 +1,6 @@
use v6;
use ABC::Header;
+use ABC::Pitched;
class ABC::Tune {
has $.header;
@@ -9,4 +10,12 @@ class ABC::Tune {
self.bless(*, :$header, :@music);
}
+ method transpose(Int $steps-up) {
+ sub transpose-element($element) {
+ $element.key => ($element.value ~~ ABC::Pitched) ?? $element.transpose($steps-up)
+ !! $element.value;
+ }
+
+ ABC::Tune.new($.header, @.music.map({ transpose-element($_); }));
+ }
}
View
@@ -0,0 +1,43 @@
+use v6;
+use Test;
+
+use ABC::Grammar;
+use ABC::Header;
+use ABC::Tune;
+use ABC::Duration;
+use ABC::Note;
+use ABC::Rest;
+use ABC::Tuplet;
+use ABC::BrokenRhythm;
+use ABC::Chord;
+use ABC::LongRest;
+use ABC::GraceNotes;
+use ABC::Actions;
+use ABC::Utils;
+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);
+ }
+}
+
+sub up-octave($accidental, $basenote, $octave) {
+ if $octave ~~ /","/ {
+ return ($accidental, $basenote, $/.postmatch);
+ } elsif $octave ~~ /"'"/ || $basenote ~~ /<lower>/ {
+ return ($accidental, $basenote, $octave ~ "'");
+ } else {
+ return ($accidental, $basenote.lc, $octave);
+ }
+}
+
+is transpose("A", &up-octave), "a", "Octave bump to A yields a";
+is transpose("a", &up-octave), "a'", "Octave bump to a yields a'";
+is transpose("a''", &up-octave), "a'''", "Octave bump to a'' yields a'''";
+is transpose("A,", &up-octave), "A", "Octave bump to A, yields A";
+is transpose("A,,", &up-octave), "A,", "Octave bump to A,, yields A,";
+
+
+done;

0 comments on commit d13c7ad

Please sign in to comment.