#!/usr/bin/perl
# abcmac -- Barfly-style macro preprocessor for ABC files.
#
# Copyright © 2001 Anselm Lingnau <anselm@strathspey.org>. 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 ran/local/bin/perl"
		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 lon/local/bin/perlr-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\x01/local/bin/perl;\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; for/local/bin/perlt 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;
    }
}

--==_Exmh_18304111530--


To subscribe/unsubscribe, point your browser to: http://www.tullochgorm.com/lists.html