All right, everybody, please forget the simple-minded piece of junk I
posted recently, which suffered from the delusion of being a BarFly
macro preprocessor. As far as I am concerned here comes the Real Thing,
based on Phil Taylor's description of BarFly macros (I hope it does
everything right). This works at least for Phil's examples (and Jack's
tune, too). Suggestions on how to improve the `transpose this note 5
steps up' code are welcome :^)
Please let me know if you find this useful, would like to see bug fixes,
changes and/or improvements, and so on. I'll give the program a more
permanent home on my web site if there is sufficient interest.
Cheers,
Anselm
--
Anselm Lingnau .......................................... [EMAIL PROTECTED]
There is only one basic human right, the right to do as you damn well please.
And with it comes the only basic human duty, the duty to take the consequences.
-- P. J. O'Rourke
#!/usr/bin/perl
# abcmac -- Barfly-style macro preprocessor for ABC files.
#
# Copyright © 2001 Anselm Lingnau <[EMAIL PROTECTED]>. Use this as you
# like as long as you don't alter or remove this comment or pretend that
# you wrote it yourself.
#
# See http://www.barfly.dial.pipex.com/bfextensions.html for a description
# of BarFly macros.
use strict;
# This defines what a macro takes as an argument.
# Currently the argument is a note name (no length).
my $arg = q{[\^=_]?[A-Ga-g](,*|\'*)};
my $subst;
my (@m, @global_m);
my $xnotes = 'hijklmnopqrstuvwxyz';
my $n_pos = index($xnotes, 'n');
my @tnotes =
qw/C,,, D,,, E,,, F,,, G,,, A,,, B,,, C,, D,, E,, F,, G,, A,, B,,
C, D, E, F, G, A, B C D E F G A B
c d e f g a b c' d' e' f' g' a' b'
c'' d'' e'' f'' g'' a'' b'' c''' d''' e''' f''' g''' a''' b'''/;
my ($i, $tnotes_max) = (0, scalar(@tnotes));
my %pos;
foreach (@tnotes) { $pos{$_} = $i++; };
# Transpose note `$base' according to the relative position of `$note'
# compared to `n' -- e.g., $base = 'A', $note = 'o' gives 'B'. Don't bother
# dealing with accidentals, since BarFly doesn't either.
sub transpose {
my ($base, $note) = @_;
my ($steps) = index($xnotes, $note) - $n_pos;
my ($new_note) = $pos{$base} + $steps;
die "transposed note out of range"
if $new_note < 0 || $new_note >= $tnotes_max;
return $tnotes[$new_note];
}
# Main loop.
my ($global) = 1;
while (<>) {
if (/^([A-Za-z]):/) { # header line
if ($1 eq 'm') { # macro definition
my $def = $_;
$def =~ s/\s*%.*$//;
if ($global) { # Remember global macros separately
push @global_m, $def;
} else {
push @m, $def;
}
} elsif ($1 eq 'K') { # last line in header
my @subst = ();
# Construct a sequence of expansion commands for the macros.
# Make sure to expand longer-named macros first, to avoid
# replacing `On' before `On/'
foreach my $macro (@m) {
my ($name, $value)
= $macro =~ /m:\s*(\S+)\s*=\s*(.*)\s*$/;
my $name_len = length $name;
my $transposing;
if ($transposing = $name =~ s/n/($arg)/) {
$value =~ s/([h-z])/".&transpose(\$1,'$1')."/g;
$value = qq{"$value"};
push @subst, [$name_len,
qq{s\x01$name\x01$value\x01ge;\n}];
} else {
push @subst, [$name_len, qq{s\x01$name\x01$value\x01g;\n}];
}
}
foreach my $s (sort { $$b[0] <=> $$a[0] } @subst) {
$subst .= $$s[1];
}
# print "-" x 72, "\n", $subst, "-" x 72, "\n";
} elsif ($1 eq 'X') { # First tune starts here.
$global = 0;
}
print; # This prints »m:« lines as well - should it?
} elsif (/^$/) { # End of tune; forget non-global macros
@m = @global_m;
} elsif (!/^%/) { # non-comment line -- expand macros
chomp;
my $out = '';
while (length $_) {
if (s/^(".*?")//) { # leave stuff in quotes alone
$out .= $1;
} else { # look for macro calls to preprocess
my $v;
s/^([^\"]*)//;
for ($v = $1) { eval $subst; warn $@ if $@; $out .= $_; }
}
}
print $out, "\n";
} else {
print;
}
}
