#! /usr/bin/perl
#
# muscript: typesets music scores into PostScript.  Peter Billam, may1994
# www.pjb.com.au/muscript  - and into MIDI apr2005, and into XML jan2007
#
#########################################################################
#        This Perl script is Copyright (c) 1994, Peter J Billam         #
#     c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia      #
#                                                                       #
# Permission is granted  to any individual or institution to use, copy, #
# modify or redistribute this software, so long as it is not resold for #
# profit,  and provided this notice is retained.   Neither Peter Billam #
# nor  P J B Computing  make any representations  about the suitability #
# of this software for any purpose. It is provided "as is", without any #
# express or implied warranty.         http://www.pjb.com.au/muscript   #
#########################################################################
# still unused in syntax: ` ! @ $ % ^ & * : ; ?
# needs hard syntax for: 1a 2a :|| 8va DalSegno HairpinCresc PianoPedals
# needs IndentingStaves TitleInMidpage

$debug = 0;
if ($debug) {$|=1;}  # so you can 'tail -f' on the output file
$[=1; # awk legacy, needed by $isyst $ibar and $istave

# Beginning of Configuration Stuff: mostly relative to stave height ...
$Version               = '2.8w';  # -p option works again
$VersionDate           = '19jul2008';
$SpaceAtBeginningOfBar = 0.60;
$AccidentalBeforeNote  = 0.40;
$AccidentalDxInKeysig  = 0.20;
$BlackBlobHalfWidth    = 0.17;
$BlackBlobHalfHeight   = 0.113; # gives -w warning, but needed in DATA
$BlackBlobHalfHeight   += 0.0;  # avoids warning, I hate being forced to this
$WhiteBlobHalfWidth    = 0.183;
$WhiteBlobHalfHeight   = 0.122;
$SmallNoteRatio        = 0.61;
$SmallStemRatio        = 0.76;
$StemFromBlobCentre    = 0.176;
$DotRightOfNote        = 0.38;
$DotAboveNote          = 0.06;
$NoteShift             = 0.28;
$AccidentalShift       = 0.19;
$DoubleFlatSpacing     = 0.25;
$SpaceLeftOfClef       = 0.40;
$SpaceRightOfClef      = 0.90;
$SpaceForClef          = 0.80;
$SpaceForTimeSig       = 0.50;
$SpaceAfterKeySig      = 0.10;
$SpaceForStartRepeat   = 0.35;
$SpaceForEndRepeat     = 0.10;
$SpaceAtEndOfBar       = 0.00;
$TieAfterNote          = 0.17;
$TieAboveNote          = 0.20;
$TieShift              = 0.60;
$TieDy                 = 0.30;
$TieOverhang           = 0.32;
$MustSquashTie         = 0.80;
$MustReallySquashTie   = 0.50;
$MaxTieGradient        = 0.55; # dimensionless; dy/dx
$TextBelowStave        = 0.50;
$TextSize              = 0.55;
$SmallFontRatio        = 0.707;
$StemLength            = 0.85;
$OptionClearance       = 0.19; # 0.38
$OptionDy              = 0.35;
%OptionDy              = (dot=>0.25, tenuto=>0.26, upbow=>0.43, gs=>0.55,
	blank=>0.25, Is=>0.35, is=>0.33, bs=>0.35, rs=>0.33, I=>0.47, i=>0.45,
	b=>0.47, r=>0.45, dim=>0.0, cre=>0.0);  # should be in sub initialise
$MinBeamClearance      = 0.70;
$FlatHalfHeight        = 0.20;
$SharpHalfHeight       = 0.15;
$BeamWidth             = 0.13; # gives -w warning, but needed in DATA
$BeamWidth             += 0.0; # avoids warning, I hate being forced to this
$BeamSpacing           = 0.22;
$MaxBeamStub           = 0.35;
$TailSpacing           = 0.24;
$MaxBeamGradient       = 0.45; # dimensionless; dy/dx
$SegnoHeight           = 0.90;
$RegularFont           = 'Times-Roman-ISO';
$BoldFont              = 'Times-Bold-ISO';
$ItalicFont            = 'Times-Italic-ISO';
$BoldItalicFont        = 'Times-BoldItalic-ISO';
$HeaderFontSize        = 9;    # in point
$TitleFontSize         = 17.5; # in point
$AmpleSysGap           = 0.15; # relative to page height
$LetterFactor          = 0.94074; # US letter paper height relative to A4
$LetterInnerMargin     = 8.4;  # in point
$LetterOuterMargin     = 8.4;  # in point
# MIDI stuff ....
$TPC                   = 96;   # MIDI Ticks Per Crochet
$DefaultLegato         = 0.85; # MIDI default length of a crochet
$DefaultVolume         = 100;  # MIDI default volume (0..127)
# End of Configuration Stuff.

use Text::ParseWords;

# Command-line options ...
my $PageSize = 'a4';
my $Strip  = 0;
my $Quiet  = 0;
my $Midi   = 0;
my $Xml    = 0;
while (1) {
	my $arg = $ARGV[$[];
	if ($arg eq '-v') {	# version
		my $shortversion = $Version; $shortversion =~ s{[a-z]$}{};
		print <<EOT;
Muscript version $Version $VersionDate  http://www.pjb.com.au/muscript
For home page     see http://www.pjb.com.au/muscript/index.html
For sample source see http://www.pjb.com.au/muscript/samples
EOT
		exit;
	} elsif ($arg eq '-letter' || $arg eq '-us')  { shift; $PageSize='letter';
	} elsif ($arg eq '-a4')     { shift; $PageSize = 'a4';
	} elsif ($arg eq '-auto')   { shift; $PageSize = 'auto';
	} elsif ($arg eq '-compromise') { shift; $PageSize = 'compromise';
	} elsif ($arg =~ /^-s/)     { shift; $Strip  = 1;
	} elsif ($arg =~ /^-p/)     { shift; ps_prolog(); exit 0;
	} elsif ($arg =~ /^-q/)     { shift; $Quiet  = 1;
	} elsif ($arg eq '-xml')    { shift; $Xml=1; $Midi=0; $Quiet=1;
	} elsif ($arg eq '-midi')   { shift; $Midi=1; $Xml=0; $Quiet=1;
		eval 'require MIDI'; if ($@) { die
			"you'll need to install the MIDI-Perl module from www.cpan.org\n";
		}
	} elsif ($arg =~ /^-/) {
		print <<'EOT';
Usage: muscript [filenames]  # converts filenames to PostScript
       muscript -a4          # forces A4 output (default)
       muscript -us          # forces US Letter output
       muscript -compromise  # forces A4 width and Letter height
       muscript -auto        # Autodetects PageSize of US Letter printers
       muscript -s           # Strips off the PS prolog (for concatenating)
       muscript -p           # just outputs the PS Prolog
       muscript -q           # Quiet
       muscript -midi        # converts to MIDI
       muscript -xml         # converts to MusicXML
       muscript -v           # prints Version information
       muscript -h           # prints this Helpful message
For home page see http://www.pjb.com.au/muscript/index.html
For sample source see http://www.pjb.com.au/muscript/samples/
For sample output see http://www.pjb.com.au/mus/comp.html
EOT
		exit;
	} else { last;
	}
}

# Other globals
my $eps;         # a small number; nothing to do with EPS output :-)
my $no_tty;
my $pagenum;
my $ibar;
my %bartype;
my %stave2channel;
my %stave2volume;
my %stave2transpose;
my %stave2legato;
my @midiscore;
my $miditempo;           # needed by "midi pause" and &midi_timesig
my $midi_timesig;
my $miditicksperbeat;
my %midi_expression;
my $ticksatbarstart;
my $ticksthisbar;
my $xml_tempo; my $xml_timesig;
my $Startbeamup;
my $Startbeamdown;
my $Startcrossbeam;
my $LineNum = 0;
my %accidentalled;
my %Options;
my %Opt_Cache = (); # orcish hash of lists
my $oldmiditempo;
my $defaultstem;    # for this stave
my %ystave;
my $ystave;         # timesaver
my %maxstaveheight;
my %staveheight;
my $staveheight;    # timesaver
my %yblinebot; my %yblinetop; my %nblines;  # barlines on this system
my %x_start; my %y_start;  # $x_start{'tie',$isyst,$istave,$itie}; (or 'slur')
my $just_did_newsystem = 0;
my %xml;
my %xml_accidental;
my %accidental2alter;
my %xml_dynamics = map { $_, 1 } qw(p pp ppp pppp ppppp pppppp
 f ff fff ffff fffff ffffff mp mf sf sfp sfpp fp rf rfz sfz sffz fz);
my @xml_cache;       # cache for music-data in a measure, to count staves
my %midline; my %line2step;  # for shifting rests in xml
my %SlurOrTie;
my %SlurOrTieShift;
my $PS_Prolog_Already = 0;

# but "boundingbox" can override these ...
$lmar=40; $rmar=565; $botmar=60; $topmar=781;  # for systems
$footmar=30; $headmar=811;  # for header and footer text

&initialise();

while (<>) {
	$LineNum++;
	my $nextline;
	if ($_ =~ s{\\\n$}{} and $nextline = <>) { $_ .= $nextline; redo; }
	my $line = $_;
	$line =~ s{^\s+}{};  # strip leading space
	chop $line;
	next unless $line;
	if ($line =~ /^boundingbox\s+(\d+)\s+(\d+)$/) {&boundingbox($1,$2); next;}
	if (!$Midi && !$Xml && !$PS_Prolog_Already) { &ps_prolog(); }
	if ($line =~ /^([1-9][0-9]*)\s+systems?\s+(.*)$/) { &systems($1,$2); next; }
	if ($line =~ /^midi\s*(.*)$/) { &midi_global($1); next; }
	if ($Xml && !$xml{'header finished'}) {
		# for xml, the header lines must be consecutive ...
		if (!&xml_header($line)) { $xml{'header finished'} = 1; redo; }
	}
	if (!$Midi && !$Xml) {   # PostScript header and footer
		if ($line =~ /^rightfoot\s(.*)$/) { &ps_rightfoot($1); next; }
		if ($line =~ /^leftfoot\s(.*)$/)  { &ps_leftfoot($1);  next; }
		if ($line =~ /^innerhead\s(.*)$/) { &ps_innerhead($1); next; }
		if ($line =~ /^lefthead\s(.*)$/)  { &ps_lefthead($1);  next; }
		if ($line =~ /^righthead\s(.*)$/) { &ps_righthead($1); next; }
		if ($line =~ /^pagenum\s?(.*)$/)  { &ps_pagenum($1);   next; }
	}
	if ($line =~ /^title.*$/)     { &title($line);     next; }
	if ($line =~ /^%\s*(.*)/)     { &comment($1);      next; }
	if ($line =~ m{^/\s*$})       { &newsystem($line); next; }
	if ($line =~ m{^/\s*([1-9][0-9]*)\s*bars?\s*(.*)$}) {  # both on same line
		&newsystem('/'); &bars($1,$2); $ibar=0; next;
	}
	if ($line =~ /^([1-9][0-9]*)\s*bars?\s*(.*)$/) {&bars($1,$2);$ibar=0;next;}
	if ($line =~ s/^\|\s*//)      { &newbar($line); }
	if ($line =~ /^([rbiI])([ls]?)(\d?\.?\d*)\s(.*)$/) {
		if ($Xml)   { &xml_text($1,$2,$3,$4); next; }
		if ($Midi)  { next; }
		&ps_text($1,$2,$3,$4);  next;
	}
	if ($line =~ s/^(stave|=)\s*//) { &newstave($line); next; }
	# input syntax error if it reaches here...   XXX warn?
}
if ($Midi) {
	&midi_write();
} elsif ($Xml) {
	&xml_print_cache();
	print "\t\t</measure>\n\t</part>\n</score-partwise>\n";
} else {
	&ps_finish_ties();	# put in any unfinished ties ... 2.7j
	print "pgsave restore\nshowpage\n%%EOF\n"; # XXX shouldn't showpage in EPS
	print TTY "\n" unless $no_tty;
}
exit 0;

# ------------------------ Subroutines -------------------------------

sub initialise {
	if (!$Quiet) {
		open(TTY, '>/dev/tty') || ($no_tty = 'yes');
		select TTY; $|=1; select STDOUT;
	}

	$eps = 0.0005;  # should be less than .001 for correct word spacing
	$ipage = 0;

	# pitch to height-on-stave assocarray is defined for the alto clef ...
	# my %raw_table;
	if ($Midi) {
		%raw_notetable = (  # defined for alto clef
			'f~~'=>89, 'e~~'=>88, 'd~~'=>86, 'c~~'=>84, 'b~'=>83,
			'a~'=>81, 'g~'=>79, 'f~'=>77, 'e~'=>76, 'd~'=>74, 'c~'=>72,
			b=>71,   a=>69,  g=>67,  f=>65,  e=>64,  d=>62,  c=>60,
			B=>59,   A=>57,  G=>55,  F=>53,  E=>52,  D=>50,  C=>48,
			B_=>47,  A_=>45, G_=>43, F_=>41, E_=>40, D_=>38, C_=>36,
			B__=>12, A__=>10,
		);
		foreach (keys %raw_notetable) {
			$notetable{$_}        = $raw_notetable{$_};
			$notetable{$_ . '#'}  = $raw_notetable{$_} + 1;
			$notetable{$_ . 'b'}  = $raw_notetable{$_} - 1;
			$notetable{$_ . '##'} = $raw_notetable{$_} + 2;
			$notetable{$_ . 'bb'} = $raw_notetable{$_} - 2;
			$notetable{$_ . 'n'}  = $raw_notetable{$_};
			if (/^([A-Ga-g])([~_]+)/) {   # cope with A#__ order too
				$notetable{"$1#$2"} = $raw_notetable{$_} + 1;
				$notetable{"$1b$2"} = $raw_notetable{$_} - 1;
				$notetable{"$1n$2"} = $raw_notetable{$_};
			}
		}
	}
	# ytable also needed by Midi, to keep track of stemup e.g. for slurs/ties
	%ytable = (
		'f~~'=>1.625, 'e~~'=>1.5, 'd~~'=>1.375, 'c~~'=>1.25, 'b~'=>1.125,
		'a~'=>1.0, 'g~'=>0.875, 'f~'=>0.75, 'e~'=>0.625, 'd~'=>0.5,
		'c~'=>0.375, b=>0.25, a=>0.125, g=>0.01, f=>-0.125, e=>-0.25,
		d=>-0.375, c=>-0.5, B=>-0.625, A=>-0.75, G=>-0.875, F=>-1.0,
		E=>-1.125, D=>-1.25, C=>-1.375, B_=>-1.5, A_=>-1.625, G_=>-1.75,
		F_=>-1.875, E_=>-2.0, D_=>-2.125, C_=>-2.25, B__=>-2.375, A__=>-2.5,
	);

	# note durations ...
	%nbeats=( dsq=>.125,smq=>.25,qua=>.5,cro=>1.0,min=>2.0,smb=>4.0,bre=>8.0);
	foreach $key (keys %nbeats) {
		$nbeats{$key.'2'} = $nbeats{$key}*0.75;     # duplet
		$nbeats{$key.'3'} = $nbeats{$key}*0.66667;  # triplet
		$nbeats{$key.'4'} = $nbeats{$key}*0.75;     # quadruplet
		$nbeats{$key.'5'} = $nbeats{$key}*0.8;      # quintuplet
		$nbeats{$key.'6'} = $nbeats{$key}*0.66667;  # sextuplet
	}
	foreach $key (keys %nbeats) {   # dotted notes
		$nbeats{$key . '.'  } = $nbeats{$key} * 1.5;
		$nbeats{$key . '..' } = $nbeats{$key} * 1.75;
		$nbeats{$key . '...'} = $nbeats{$key} * 1.875;
	}
	foreach $key (grep (/^cro|^min|^smb/, keys %nbeats)) { # tremolandi
		$nbeats{$key . '/'  } = $nbeats{$key};
		$nbeats{$key . '//' } = $nbeats{$key};
		$nbeats{$key . '///'} = $nbeats{$key};
	}
	foreach $key (grep (/^dsq|^smq|^qua|^cro|^min|^smb/, keys %nbeats)) {
		$nbeats{$key . '-s'}  = $nbeats{$key};   # small notes
	}
	%Options = (
		'down'=>'downbow', '.'=>'dot', 'emph'=>'emphasis', 'gs'=>'gs',
		'mordent'=>'mordent', 'stac'=>'dot', 'stacc'=>'dot',
		'ten'=>'tenuto', 'tenuto'=>'tenuto',
		'tr'=>'trill', 'tr#'=>'trsharp', 'trb'=>'trflat', 'trn'=>'trnat',
		'turn'=>'turn', 'up'=>'upbow', 
	);
	%SlurOrTie = (
		'('=>'starttie',
		'{'=>'startslur',
		')'=>'endtie',
		'}'=>'endslur',
	);
	%SlurOrTieShift = (
		""=>0, "'"=>1, "''"=>2, "'''"=>3, "''''"=>4,
		","=>-1, ",,"=>-2, ",,,"=>-3, ",,,,"=>-4,
	);
	if ($Midi) {
		@midiscore        = ();  # LoL
		$midi_timesig     = q{};
		$miditicksperbeat = $TPC;
		$ticksatbarstart  = 0;
		$ticksthisbar     = 0;  # so as not to delay the start
		$midibarparts     = '2.4';  # default guesses 4/4 at 100 cro/min
		%stave2channel    = ();
		$currentstavenum  = '1';
	} elsif ($Xml) {
		%stave2channel    = ();
		$xml_timesig       = '4/4';
		%xml_duration=(
			dsq=>'32nd',smq=>'16th',qua=>'eighth',cro=>'quarter',
			min=>'half',smb=>'whole',bre=>'breve'
		);
		foreach $key (keys %xml_duration) {
			$xml_duration{$key.q{3}} = "$xml_duration{$key}";
		}
		foreach $key (keys %xml_duration) {
			$xml_duration{$key} = "<type>$xml_duration{$key}</type>";
		}
		foreach $key (keys %xml_duration) {   # dotted notes
			$xml_duration{$key.'.'  }=$xml_duration{$key}.'<dot/>';
			$xml_duration{$key.'..' }=$xml_duration{$key}.'<dot/><dot/>';
			$xml_duration{$key.'...'}=$xml_duration{$key}.'<dot/><dot/><dot/>';
		}
		foreach $key (grep (/^cro|^min|^smb/, keys %xml_duration)) {
			$xml_duration{$key . '/'  } = $xml_duration{$key};
			$xml_duration{$key . '//' } = $xml_duration{$key};
			$xml_duration{$key . '///'} = $xml_duration{$key};
		}
		foreach $key
			(grep (/^dsq|^smq|^qua|^cro|^min|^smb/, keys %xml_duration)) {
			$xml_duration{$key . '-s'}  = $xml_duration{$key}; # small notes
		}
		%xml_accidental = (
			'#'=>'sharp', '##'=>'double-sharp',
			'b'=>'flat', 'bb'=>'flat-flat', 'n'=>'natural',
		);
		%accidental2alter = (
			'#'=>1, '##'=>2, 'b'=>-1, 'bb'=>-2, 'n'=>0, ''=>0,
		);
		%midline = (
			treble8va=>41, treble=>34, treble8vab=>27, alto=>28,
			tenor=>26, bass8va=>29, bass=>22, bass8va=>15,
		);
		%line2step = (
			'0'=>'C', '1'=>'D', '2'=>'E', '3'=>'F',
			'4'=>'G', '5'=>'A', '6'=>'B',
		);
		$xml{measure_number} = 0;
		$xml{backup} = 0;
	}
}

sub boundingbox { my ($w, $h) = @_;
	my $a4w = 210 * 72/25.4;
	my $a4h = 297 * 72/25.4;
	$lmar=40*$w/$a4w; $rmar=565*$w/$a4w;
	$botmar=60*$h/$a4h; $topmar=781*$h/$a4h;
	$footmar=30*$h/$a4h; $headmar=811*$h/$a4h;  # for header and footer text
	$Box_H = $h;
	$Box_W = $w;
}
sub systems { $[=1; $nsystems = shift; my $sizes = shift;
	# sets globals: lmargin, rmargin, nstaves, ystave, staveheight,
	# gapheight, nblines, ybline, blineheight, isyst
	return if $Midi;

	if ($nsystems && ! $sizes) {  # impose some defaults
		if      ($nsystems > 6) { $sizes = '/19/';
		} elsif ($nsystems > 4) { $sizes = '/19 30 19/';
		} elsif ($nsystems > 3) { $sizes = '/19 30 19 30 19/';
		} elsif ($nsystems > 2) { $sizes = '/19 30 19 30 19 30 19/';
		} else { $sizes = '/19 30 19 30 19 30 19 30 19 30 19/';
		}
	} elsif (!$nsystems && !$sizes &&
		$remember_nsystems && $remember_systems_sizes) {
		$sizes    = $remember_systems_sizes;
		$nsystems = $remember_nsystems;
	} else {
		$remember_systems_sizes = $sizes;    # global
		$remember_nsystems      = $nsystems; # global
		%remember_header        = ();        # global
	}

	my @systems = split(m{\s*/\s*}, $sizes, 9999);
	my $topgap = 0 + shift @systems;
	my $botgap = 0 + pop @systems;   # $botgap not yet used ...

	if ($Xml) {   # Xml: see layout.dtd -
		$ipage++;
		my @barlinesandgaps; my $istave;
		for ($isyst = $[; $isyst <= $nsystems-1+$[; $isyst++) { # ugly
			$istave = 0;
			my $igap = 1;
			my $isastave = 1;	# the first number will be a stave height
			@barlinesandgaps = split('\s+', $systems[$isyst], 9999);
			foreach my $word (@barlinesandgaps) {
				my @stavesandgaps = split(/-/, $word, 9999);
				foreach $staveorgap (@stavesandgaps) {
					if ($isastave) {
						$istave++;
						$staveheight{$isyst, $istave} = $staveorgap;
						$isastave = 0;	# the next will be a gap
					} else {  # its a gap
						$gapheight{$isyst, $igap} = $staveorgap;
						$isastave = 1;	# the next will be a stave
						$igap++;
					}
				}
			}
			$nstaves{$isyst} = $istave;
		}
		$isyst = 0;
		return;
	}

	if ($ipage > 0) {
		&ps_finish_ties();
		printf "pgsave restore\nshowpage\n";
		print TTY "\n" unless $no_tty;
	}
	$ipage++;
	print "%%Page: $ipage $ipage\n";
	print "%%BeginPageSetup\n/pgsave save def\n%%EndPageSetup\n";
	if ($PageSize eq 'letter') {
		printf "%g 0 translate 1.0 %g scale\n", ($pagenum % 2) ?
			$LetterInnerMargin : $LetterOuterMargin, $LetterFactor;
	} elsif ($PageSize eq 'compromise' ) {  # a4 width, letter height
		print "4 0 translate 1.0 0.95 scale\n";
	} elsif ($PageSize eq 'auto') {  # autodetect
		print "/pageheight currentpagedevice (PageSize) get 1 get def\n";
		print "pageheight 800 lt pageheight 785 gt and {\n";
		printf "\t%g 0 translate 1.0 %g scale\n} if\n", ($pagenum % 2) ?
			$LetterInnerMargin : $LetterOuterMargin, $LetterFactor;
	}
	print TTY "page $ipage, system" unless $no_tty;

	my $shortfall = $nsystems - scalar @systems;
	if ($shortfall > 0) {
		my $last_syst = pop @systems;
		push (@systems, $last_syst);
		while ($shortfall > 0) { push (@systems, $last_syst); $shortfall--; }
	}

	$totsyswidth = 0.0;	# initialise counter for all systems on page
	my @barlinesandgaps;
	for ($isyst = $[; $isyst <= $nsystems-1+$[; $isyst++) { # for each system
		$syswidth = 0.0;	# this system width (includes all gaps)
		$lmargin{$isyst} = $lmar;
		$rmargin{$isyst} = $rmar;
		@barlinesandgaps = split('\s+', $systems[$isyst], 9999);
		$istave = 0;
		my $igap = 1;
		my $ibline = 0;
		my $isastave = 1;	# the first number will be a stave height
		foreach my $word (@barlinesandgaps) {  # loop over barlines & gaps
			if ($isastave) {
				$ibline++;
				$yblinetop{$isyst, $ibline} = $syswidth;  # will invert later
			}
			my @stavesandgaps = split(/-/, $word, 9999);
			foreach $staveorgap (@stavesandgaps) {
				$totsyswidth += $staveorgap;
				$syswidth += $staveorgap;
				if ($isastave) {
					$istave++;
					$staveheight{$isyst, $istave} = $staveorgap;
					if (! defined $maxstaveheight{$isyst}) { # defeat -w
						$maxstaveheight{$isyst} = 0; # makes me puke to do this
					}
					if ($staveheight{$isyst,$istave}>$maxstaveheight{$isyst}) {
						$maxstaveheight{$isyst} = $staveheight{$isyst,$istave};
					}
					$isastave = 0;	# the next will be a gap
				} else {  # its a gap
					$gapheight{$isyst, $igap} = $staveorgap;
					$isastave = 1;	# the next will be a stave
					$igap++;
				}
			}
			if (! $isastave) {
				$yblinebot{$isyst, $ibline} = $syswidth;  # will invert later
			}
		}
		$nstaves{$isyst} = $istave;
		$nblines{$isyst} = $ibline;
		$ngaps{$isyst}	  = $igap-1;
	}

	# so do the systems fit on the page ?
	if ($nsystems == 1) {
		$systemgap = ($topmar-$botmar-$totsyswidth-$topgap);
	} else {
		$systemgap = ($topmar-$botmar-$totsyswidth-$topgap) / ($nsystems-1);
	}
	if ($systemgap < 0) {
		printf STDERR "\nSorry, won't fit: systemgap=%g\n", $systemgap; exit 1;
	}
	# if systemgap is large, space is left also above top sys & below bot.
	my $Y;
	my $excess = $systemgap - $AmpleSysGap*($topmar-$botmar);
	if ($nsystems == 1) {
		$Y = 0.5 * ($topmar+$botmar+$totsyswidth);
	} elsif ($excess > 0) {
		$adjustment = $excess * ($nsystems-1) / ($nsystems+1);
		$systemgap = $systemgap - $excess + $adjustment;
		$Y = $topmar - $adjustment - $topgap;
	} else {
		$Y = $topmar - $topgap;
	}

	# for each system ...
	for ($isyst=$[; $isyst<=$nsystems-1+$[; $isyst++) {
		print "% system $isyst staves, initial barline, and brackets:\n";
		my $istave = 1; my $igap = 1;
		my $max_staveheight = 0;
		while (1) {	# print the staves ...
			$ystave{$isyst,$istave} = $Y;
			if ($staveheight{$isyst,$istave} > $max_staveheight) {
				$max_staveheight = $staveheight{$isyst,$istave};
			}
			printf "%g %g %g %g stave\n", $lmargin{$isyst},
			 $rmargin{$isyst}, $Y, $staveheight{$isyst,$istave};
			$Y -= $staveheight{$isyst,$istave};
			if ($istave >= $nstaves{$isyst}) {
				printf "%g %g %g %g barline\n", $lmargin{$isyst},
				 $ystave{$isyst,1}, $Y, $staveheight{$isyst,$istave};
				if ($igap<=$ngaps{$isyst}) { $Y-=$gapheight{$isyst,$igap}; }
				last;
			}
			$istave++;
			$Y -= $gapheight{$isyst, $igap};
			$igap++;
		}

		# invert and adjust the barline tops and bottoms
		# $nblines{$isyst}-- unless $yblinebot{$isyst,$ibline};
		for ($ibline = 1; $ibline <= $nblines{$isyst}; $ibline++) {
			$yblinetop{$isyst, $ibline} =
				  $ystave{$isyst, 1} - $yblinetop{$isyst, $ibline};
			$yblinebot{$isyst, $ibline} =
				  $ystave{$isyst, 1} - $yblinebot{$isyst, $ibline};
		}
		# and print the brackets
		# should use average (or max) staveheight
		for ($i = 1; $i <= $nblines{$isyst}; $i++) {
			printf "%g %g %g %g bracket\n",
			 $lmargin{$isyst} - $max_staveheight*0.225,
			 $yblinetop{$isyst,$i}, $yblinebot{$isyst,$i}, $max_staveheight;
		}
		$Y -= $systemgap;
	}
	$isyst = 0;
}

sub newsystem {
	return if $Midi;
	if ($Xml) { $isyst++; $xml{staves} = 1; return 1; }
	&ps_finish_ties();	# first put in any unfinished ties ...
	if ($isyst >= $nsystems-1+$[) {
		&systems();
		# regurgitate remembered header lines (except for title) ...
		if ($remember_header{'pagenum'}) {
			&ps_pagenum();
			my $string = $remember_header{'innerhead'};
			if ($string) { &ps_innerhead($string); }
			$string = $remember_header{'leftfoot'};
			if ($string) { &ps_leftfoot($string); }
			$string = $remember_header{'rightfoot'};
			if ($string) { &ps_rightfoot($string); }
		} else {
			my $string = $remember_header{'lefthead'};
			if ($string) { &ps_lefthead($string); }
			$string = $remember_header{'righthead'};
			if ($string) { &ps_righthead($string); }
			$string = $remember_header{'leftfoot'};
			if ($string) { &ps_leftfoot($string); }
			$string = $remember_header{'rightfoot'};
			if ($string) { &ps_rightfoot($string); }
		}
	}
	$isyst++;      # then move on to next system ...
	$just_did_newsystem = 1; # so if no bars cmd follows, barlines get drawn
	print TTY " $isyst" unless $no_tty;
	print "% system $isyst\n";
}

sub bars { my $nbars = shift; my $str = shift; # eg. $str='| 4.5 | 2 3 | 4 ||'
	return if $Midi;
	# prints the barlines, and set the following global variables :
	# $bartype{$isyst,$ibar}, $spaceatstart{$ibar}, $nparts{$isyst,$ibar},
	# $proportion{$ibar}, $partshare{$ibar,$ipart}, $nbars{$isyst} and $ibar
	# bartype bits mean: missing,segno,start-repeat,end-repeat,double

	if ($nbars && ! $str) {
		$str = '|1|';
		$remember_bars_string = $str;   # global
		$remember_nbars       = $nbars; # global
	} elsif (!$nbars && !$str && $remember_nbars && $remember_bars_string) {
		$str   = $remember_bars_string;
		$nbars = $remember_nbars;
	} else {
		$remember_bars_string = $str;   # global
		$remember_nbars       = $nbars; # global
	}

	# could extract strings for a leftgap from this ...
	$str =~ s/^[^|]*\|+\s*//;   # throw away stuff up to first barline
	$str =~ s/\s*$//;

	my $last_terminator;
	if ($str =~ s/^:\s*//) { $bartype{$isyst,0}=4; $last_terminator='|:';
	} else { $bartype{$isyst,0} = 0; $last_terminator = '|'
	}

	my $maxstaveheight = $maxstaveheight{$isyst};
	$ibar = 0;   # its a global, but we use it initially for a local loop...
	my %spaceatstart = ();
	my $sumofproportions    = 0.0;  # sum of proportions of all bars in line
	my $sumofspaceatstarts  = 0.0;  # sum of spaceatstarts of all bars in line
	my @bars = split /\s*(:?\|\|?:?)\s*/, $str;  # 2.7g
	if (@bars % 2 && $bars[$#bars] eq q{}) { pop @bars; }
	while (1) {
		last unless @bars;
		my @tokens = split(/\s+/, shift @bars);
		my $terminator = shift @bars;  $ibar++;
		$bartype{$isyst,$ibar} = 0;
		$spaceatstart{$ibar} = $SpaceAtBeginningOfBar*$maxstaveheight; # 2.4c
		if (! $terminator)         { $bartype{$isyst,$ibar} = 16; }   # 2.7g
		if ($terminator =~ /\|\|/) { $bartype{$isyst,$ibar} |= 1; }
		if ($terminator =~ /^:/)   { $bartype{$isyst,$ibar} |= 3; }
		if ($terminator =~ /:$/)   { $bartype{$isyst,$ibar} |= 5; }
		if ($last_terminator =~ /:$/) {
			$spaceatstart{$ibar} += $SpaceForStartRepeat*$maxstaveheight;
		}
		$last_terminator = $terminator;   # ready for next bar

		if ($tokens[$[] =~ /Segno/i) {	# skip segno ?
			$bartype{$isyst,$ibar-1} |= 8;
			shift @tokens;
		}
		next if $Xml;
		if ($tokens[$[] =~ /(\d+)[b#n]/) {	# leave space for keysig ?
			$spaceatstart{$ibar} +=
				$1 * $AccidentalDxInKeysig * $maxstaveheight;
			$spaceatstart{$ibar} += $SpaceAfterKeySig * $maxstaveheight;
			shift @tokens;
		}
		if ($tokens[$[] =~ m{\d+/\d+}) {	# leave space for timesig ?
			$spaceatstart{$ibar} += $SpaceForTimeSig * $maxstaveheight;
			shift @tokens;
		}
		# this will be wrong if one of the tokens is a non-numeric syntax err
		$nparts{$isyst, $ibar} = scalar @tokens; # relative spacing

		# tot up the given proportions of the bars ...
		my $itoken = $[;
		$proportion{$ibar} = 0.0;
		my $ipart = 1;
		while (1) {
			last if $ipart > $nparts{$isyst,$ibar};
			if ($tokens[$itoken] == 0) {
				warn " line $LineNum: bars: '$tokens[$itoken]' "
				. "should be numeric and nonzero\n";
				$nparts{$isyst,$ibar} --;
				$itoken++;
			}
			$partshare{$ibar, $ipart} = $tokens[$itoken];
			$proportion{$ibar} += $tokens[$itoken];
			$itoken++;  $ipart++;
		}
		$sumofproportions += $proportion{$ibar};
		$sumofspaceatstarts += $spaceatstart{$ibar};
	}

	if ($nbars > $ibar) {   # 2.0g ; expand "5 bars | 8 |"
		my $ib = $ibar;  # Remember the last specified bar
		while (1) {
			$ibar++;
			$bartype{$isyst,$ibar} = $bartype{$isyst,$ib};
			if (!$Xml) {
				$spaceatstart{$ibar} = $spaceatstart{$ib};
				$nparts{$isyst,$ibar} = $nparts{$isyst,$ib};
				my $ipart;
				$proportion{$ibar} = 0.0;
				for ($ipart=1; $ipart <= $nparts{$isyst,$ib}; $ipart++) {
					$partshare{$ibar,$ipart} = $partshare{$ib,$ipart};
					$proportion{$ibar} += $partshare{$ib,$ipart};
				}
				$sumofproportions += $proportion{$ib};
				$sumofspaceatstarts += $spaceatstart{$ibar};
			}
			last if $ibar >= $nbars;
		}
	}
	$nbars{$isyst} = $ibar;
	if ($Xml) { $ibar = 0; $istave = 0; return; }
	# BUG should check that $sumofproportions is not zero ...

	# divide up the line between the bars according to these proportions ...
	my $lmargin = $lmargin{$isyst}+$SpaceForClef*$maxstaveheight;
	$xperproportion = ($rmargin{$isyst}-$lmargin{$isyst}-$sumofspaceatstarts
		- $SpaceForClef*$maxstaveheight) / $sumofproportions;
	my $X = $lmargin;
	$xbar{$isyst, 0} = $lmargin{$isyst};   # YYY bug? why not = $lmargin;
	if (8 & $bartype{$isyst,0}) {   # Segno at first bar ?
		printf "%g %g %g segno\n", $lmargin,
			$ystave{$isyst,1} + $staveheight{$isyst,$istave}*$SegnoHeight,
			$staveheight{$isyst, $istave};
	}
	for ($ibar=1; $ibar<=$nbars{$isyst}; $ibar++) {
		$deltaxbar{$isyst,$ibar} = $xperproportion * $proportion{$ibar}
			+ $spaceatstart{$ibar};
		$X += $deltaxbar{$isyst,$ibar};
		$xbar{$isyst,$ibar} = $X;
		&ps_barline($X, $isyst, $ibar, $istave);
	}
	$ibar = 0; $istave = 0;   # these are globals.
}

sub newbar {
	if ($Midi) {
		$ticksatbarstart += $ticksthisbar;
		$ibar++; $istave = 0;   # globals.
		&midi_timesig($_[$[]);
	} elsif ($Xml) {
		if ($xml{measure_number}) {
			&xml_print_cache();
			print "\t\t</measure>\n";
		}
		$xml{measure_number}++;
		$ibar++; $istave = 0;   # globals.
		if ($ibar > $nbars{$isyst}) { &newsystem('/'); &bars(); $ibar=1; }
		print "\t\t<measure number=\"$xml{measure_number}\">\n";
		$xml{backup} = 0;
		$xml{voice}  = 0;
		$xml{staves} = 1;
		&xml_timesig($_[$[]);
	} else {
		if ($bartype{$isyst,$ibar} & 2) {   # if bartype is :|| or :||:
			&ps_finish_ties($xbar{$isyst,$ibar});
		}
		$ibar++; $istave = 0;   # globals.
		if ($ibar > $nbars{$isyst}) { &newsystem('/'); &bars(); $ibar=1;
		} elsif ($just_did_newsystem) { &bars(); $ibar=1;
		}
		$just_did_newsystem=0;
		print "% page $pagenum, sys $isyst, bar $ibar:\n";
	}
}

sub reset_accidentalled {
	if ($_[$[] eq q{0}) { %accidentalled = (); return; }
	my ($num,$sign) = $_[$[]=~/^([1-7])([#bn])$/;
	if ($sign eq '#') {     @pitches = ('F','C','G','D','A','E','B');
	} elsif ($sign eq 'b') { @pitches = ('B','E','A','D','G','C','F');
	}
	%accidentalled = ();
	my $i = 0.5; while ($i < $num) {
		my $letter = shift @pitches;
		$accidentalled{"${letter}__"} = $sign;
		$accidentalled{"${letter}_"}  = $sign;
		$accidentalled{"${letter}"}   = $sign;
		$letter = lc $letter;
		$accidentalled{"${letter}"}   = $sign;
		$accidentalled{"${letter}~"}  = $sign;
		$accidentalled{"${letter}~~"} = $sign;
		$i+=1;
	}
}

sub newstave { $[=1;
	# warn "C \$[=$[\n"; # ARGHHH 5.008003
	my ($newstave,$remainder) = $_[$[] =~ /^(\d+[,']?)(.*)$/;
	$currentstave = "$newstave";
	$currentstavenum = $currentstave; $currentstavenum =~ tr/,'//d;
	&changestave($newstave) || return 0;
	if ($Midi) {
		&reset_accidentalled($keysig{0+$currentstavenum});
	} elsif ($Xml) {
		&reset_accidentalled($keysig{0+$currentstavenum});
		my $t3 = "\t\t\t";
		# XXX must use <backup> - using only one <part> = one MIDI track
		if ($xml{backup} > 0) {
			push @xml_cache,
			 "$t3<backup><duration>$xml{backup}</duration></backup>\n";
		}
		$xml{backup} = 0;
		$xml{voice}++;
		if ($currentstavenum > $xml{staves}) {
			$xml{staves} = $currentstavenum;
		}
	} else {
		print "% page $pagenum, sys $isyst, bar $ibar, stave $istave\n";
		# surely all the following bit should also be part of this "else" ?
	}

	$remainder =~ s/^\s+//; $remainder =~ s/\s+$//; $remainder =~ s/'/\\'/g;
	@array = &parse_line('\s+', 1, $remainder);
	foreach (@array) { s/\\'/'/g; }
	$nfields = $#array;  # or scalar @array ? awk legacy problem

	# count up the total beats in this bar, and calculate spacings ...
	$beatssofar = 0;  # global
	my $i; for ($i=$[; $i <= $nfields; $i++) {	  # for all fields
		my $token = $array[$i];
		if ($token =~ tr/<//d) { # begins a set of simultaneous notes
			my $shortest = 99;    # find the shortest note
			while (1) {
				if ($token =~ tr/>//d) { last; }
				if (&is_a_note($token) || $token =~ /^rest|^blank/) {
					if ($currentpulse<$shortest) { $shortest=$currentpulse; }
				} elsif ($nbeats{$token}) {  # it's a smb, min, etc
					if ($nbeats{$token}<$shortest) {$shortest=$nbeats{$token};}
					$currentpulse     = $nbeats{$token};
					$currentpulsetext = $token;
				}
				$i++;
				if ($i>$nfields) { warn " line $LineNum: missing >\n"; last; }
				$token = $array[$i];
			}
			$beatssofar += $shortest;
		} elsif (defined $nbeats{$token}) {  # smb, min, cro, qua etc
			$currentpulse     = $nbeats{$token};
			$currentpulsetext = $token;
		} elsif ($token eq 'clefspace') { # should reserve space by xgap hash..
		} elsif (&is_a_note($token) || $token =~ /^rest|^blank/) {
			# if note contains "+", should build up xgap hash ...
			$beatssofar += $currentpulse;
		}
	}
	# Now beatssofar has the total in the bar.
	my $maxstaveheight;
	if ($Midi) {
		if ($eps < abs $beatssofar) {
			$ticksperbeat = $ticksthisbar / $beatssofar;
		} else {
			$ticksperbeat = $TPC;
		}
	} elsif ($Xml) {
	} else {
		# The spacing of the bar was specified in nparts parts
		# BUG ! if the "|" line after a "N bars " is omitted, nparts = 0 !!
		if ($nparts{$isyst, $ibar}) {
			$beatsperpart = $beatssofar / $nparts{$isyst, $ibar};
		} else { print
			"% ERROR: no | before stave line, page $pagenum, sys $isyst\n";
			$beatsperpart = 10; # ugly but legal
		}
	
		# so what are the corresponding x positions ?
		# NB xpart[n] is the left end of part n, but xbar{s,m} is right end
		# of bar m !  So xbar{isyst,0} = LeftHandMargin.

		$maxstaveheight = $maxstaveheight{$isyst}; # for speed ...
		# place the beginning of the bar
		$xpart{1}=$xbar{$isyst,$ibar-1}+$SpaceAtBeginningOfBar*$maxstaveheight;
		# there's always a clef at BOL ...
		if ($ibar == 1) { $xpart{1} += $SpaceForClef*$maxstaveheight; }

		# make a bit of room for start-of-repeat signs
		if ($ibar>1 && $bartype{$isyst,$ibar-1} & 4) {
			$xpart{1} += $SpaceForStartRepeat * $maxstaveheight;
		} elsif ($ibar>1 && $bartype{$isyst,$ibar-1} & 1) { # and double-bars
			$xpart{1} += 0.3 * $SpaceForStartRepeat * $maxstaveheight;
		}

		# place the end of the bar
		$ilastpart = 1 + $nparts{$isyst, $ibar};
		$xpart{$ilastpart}=$xbar{$isyst,$ibar}-$SpaceAtEndOfBar*$maxstaveheight;
		# leave a bit of room for end-of-repeat signs
		if ($bartype{$isyst, $ibar} & 2) {
			$xpart{$ilastpart} -= $SpaceForEndRepeat * $maxstaveheight;
		}
	}

	# OK. Now rescan the string bar, actually writing out the symbols ...
	$beatssofar = 0;			# so far this bar
	my $theresaclef = 0;
	my $retain_clef = 0;
	$i = 1;

	# first write things that can be at BOL, like clef,keysig,timesig,repeat
	# Xml: see attributes.dtd
	my %attributes = ();
	if ($Xml && $xml{'current transpose'}!=$stave2transpose{$currentstavenum}){
		$attributes{transpose}
		 = xml_transpose($stave2transpose{$currentstavenum});
	}
	my $must_null_the_keysig = 0;   # 2.8o
	if (&midi_in_stave($array[$i])) { $i++; }   # BUG should be a loop!
	if (&is_a_clef($array[$i])) {	 # clef
		my $cleftype = $array[$i];
		$must_null_the_keysig = 1;   # 2.8o explicit clef cancels the keysig
		if ($Midi) {
			%accidentalled = ();
		} elsif ($Xml) {
			if ($xml{"clef $istave"} ne $cleftype) {
				$attributes{clef} = &xml_clef_attribute($cleftype);
				$xml{"clef $istave"} = $cleftype;
			}
		} else {
			my $x = $xbar{$isyst,$ibar-1} + $SpaceLeftOfClef*$maxstaveheight;
			if ($ibar>1 && $bartype{$isyst,$ibar-1} & 4) {  # start-of-repeat
				$x += $SpaceForStartRepeat * $maxstaveheight;
			} elsif ($ibar>1 && $bartype{$isyst,$ibar-1} & 1) {  # double-bar
				$x += 0.3 * $SpaceForStartRepeat * $maxstaveheight;
			}
			printf "%g %g %g %sclef\n", $x, $ystave, $staveheight, $cleftype;
			if ($ibar > 1) {  # at BOL, space is already reserved for clef
				$xpart{1} += 0.9 * $SpaceForClef * $maxstaveheight;  # kludge
				$theresaclef = 1;
			}
		}
		$clef{$istave} = $cleftype;
		$i++;
	} elsif ($array[$i] eq 'clefspace') {
		$xpart{1} += $SpaceForClef * $maxstaveheight;   # ibar == 1 ?
		$theresaclef = 1;
		$i++;
	} elsif ($ibar == 1 && $clef{$istave}) {
		if (!$Midi && !$Xml) { printf "%g %g %g %sclef\n",
			 $xbar{$isyst,$ibar-1} + $SpaceLeftOfClef*$maxstaveheight,
			 $ystave, $staveheight, $clef{$istave};
		}
		$theresaclef = 1;
		$retain_clef = 1;
	}

	if (&midi_in_stave($array[$i])) { $i++; }
	my $xml_keysig = q{};
	if ($array[$i] =~ /^([1-7])([#bn])$/ || $array[$i] eq q{0}) {  # keysig
		$must_null_the_keysig = 0;   # 2.8o
		if ($Midi) {
			&reset_accidentalled($array[$i]);
		} elsif ($Xml) {
			&reset_accidentalled($array[$i]);
			if ($xml{"keysig $istave"} ne $array[$i]) {
				$xml_keysig = &xml_keysig($array[$i]);
				$xml{"keysig $istave"} = $array[$i];
			}
		} else {
			my $x = $xbar{$isyst,$ibar-1};
			if ($ibar == 1 || $theresaclef) {
				$x += $SpaceForClef*$maxstaveheight;
			} else {
				$x += 0.6 * $AccidentalDxInKeysig * $maxstaveheight;
				if ($bartype{$isyst, $ibar-1} & 1) {   # doublebar
					$x += 0.3 * $SpaceForStartRepeat * $maxstaveheight;
				}
				# echoes code 85 lines above ... XXX why 0.5 ?
				if ($ibar>1 && $bartype{$isyst,$ibar-1} & 4) {  # repeat mark
					$x += 0.5 * $SpaceForStartRepeat * $maxstaveheight;
				}
			}
			if ($array[$i] eq q{0}) {  # 2.8c cancel keysig, back to Cmaj
				if ($keysig{$istave} =~ /^([1-7])([#bn])$/) {
					&ps_keysig(0-$1,$2,$x);
				}
			} else {
				&ps_keysig($1,$2,$x);
			}
		}
		$keysig{$istave} = $array[$i];
		$i++;
	} elsif($ibar==1 && $retain_clef && $keysig{$istave}=~/^([1-7])([#bn])$/){
		$must_null_the_keysig = 0;   # 2.8o
		if (!$Midi && !$Xml) { &ps_keysig
			($1, $2, $xbar{$isyst,$ibar-1}+$SpaceForClef*$maxstaveheight);
		}
	}
	if ($must_null_the_keysig) { $keysig{$istave} = q{}; }   # 2.8o

	# if new timesig, print it and adjust beginning of bar, xpart{1}
	# BUG: should actually adjust all the bars in the whole line ...
	if (&midi_in_stave($array[$i]))   { $i++; }
	if ($array[$i] =~ m{\d+/\d+}) { # new time signature, eg 6/4 or 15/8
		if ($Midi) {
		} elsif ($Xml) {
			if ($xml{"timesig $istave"} ne $array[$i]) {
				$attributes{time} = &xml_time_attribute($array[$i]);
				$xml{"timesig $istave"} = $array[$i];
			}
		} else {
			my ($topnum, $botnum) = split ('/', $array[$i], 2);
			printf "%g %g %g ($topnum) ($botnum) timesig\n",
				$xpart{1} - 0.5*$SpaceAtBeginningOfBar*$maxstaveheight,
				$ystave, $staveheight;
			$xpart{1} += $SpaceForTimeSig * $maxstaveheight;
		}
		$i++;
	}

	if (!$Midi && !$Xml) {
		if ($ibar==1 && $bartype{$isyst,0} & 4) { # start repeat at BOL
			&ps_repeatmark($isyst, $istave,
				$xpart{1} - $SpaceForStartRepeat*$staveheight);
			$xpart{1} += $SpaceForStartRepeat * $maxstaveheight;
		}
		# calculate the length of bar available for music, = end - beginning
		$dxbar = $xpart{1 + $nparts{$isyst, $ibar}} - $xpart{1};
		# and thus place the various parts within the bar
		for ($ipart = 2; $ipart <= $nparts{$isyst, $ibar}; $ipart++) {
			$xpart{$ipart} = $xpart{$ipart-1} +
				$dxbar * $partshare{$ibar, $ipart-1} / $proportion{$ibar};
		}
	} elsif ($Xml) {
		if ($xml_keysig) {
			$attributes{key} = $xml_keysig;
		} else {  # musicxml2ly insists on a key even when there isn't one :-(
			if (! $xml{"keysig $istave"}) {  # XXX 2.5u
				$attributes{key} = &xml_keysig('');
				$xml{"keysig $istave"} = 'Cmaj';
			}
		}
		if (! $xml{specified_divisions}) {
			$attributes{divisions} = "<divisions>$TPC</divisions>";
			$xml{specified_divisions} = 1;
		}
		if (%attributes) { # XXXX
			push @xml_cache, \%attributes;
		}
	}
	for (; $i <= $nfields; $i++) {					  # for all fields
		$symbol = $array[$i];
		if ($symbol =~ s/<//) {   # 2.7w
			# start of bracketed simultaneous notes
			# extract list of simultaneous things to pass to &ps_event ...
			my (@things); my $is_end_of_bracket = 0;
			while (1) {
				if ($array[$i] =~ s/>//) { $is_end_of_bracket = 1; }
				push (@things, $array[$i]);
				if ($is_end_of_bracket) { $is_end_of_bracket = 0; last; }
				$i++;
				if ($i > $#array) { last; }
			}
			if ($Midi) { &midi_event(@things)
			} elsif ($Xml) { &xml_event(@things)
			} else { &ps_event(@things);
			}
		} elsif (defined $nbeats{$symbol}) {	# it's smq, min, cro, qua etc
			$currentpulse = $nbeats{$symbol};
			$currentpulsetext = $symbol;
		} elsif (&is_a_clef($symbol)) { # clef
			if (!$Midi && !$Xml) {
				# 2.8m If last symbol in bar, omit SpaceRightOfClef
				my $x = &ps_beat2x($beatssofar,$beatsperpart);
				if ($i == $nfields) { $x -= 0.6*$SpaceForClef*$staveheight;
				} else { $x -= $SpaceRightOfClef*$staveheight;
				}
				printf "%g %g %g %sclef\n", $x, $ystave, $staveheight, $symbol;
			}
			$clef{$istave} = $symbol;
		} elsif ($symbol eq 'clefspace') {
		} elsif ($symbol =~ /^=(\d+[,']?)$/) { &changestave($1);
		} elsif (&midi_in_stave($symbol)) {
		} elsif ($beatsperpart || $Midi || $Xml) { # is a note, blank or rest
			if (&is_a_note($symbol) || $symbol =~ /^blank|^rest/) {
				if ($Midi) { &midi_event($symbol);
				} elsif ($Xml) { &xml_event($symbol);
				} else { &ps_event($symbol);
				}
			} else {
				warn " line $LineNum: not a note: $symbol\n";
			}
		}
	}
}
sub changestave { my ($stave, $stem) = $_[$[] =~ /^(\d+)([,']?)$/;
	if (!$Midi && !$Xml) {
		if ($stave > $nstaves{$isyst}) {
			print "% ERROR: stave = $stave, but system $isyst only has ";
			print "$nstaves{$stave} staves\n"; warn
			" line $LineNum: stavenumber $stave too big for system $isyst\n";
			$stave = $nstaves{$isyst};
		} elsif ($stave < 1) {
			print "% ERROR: stave = $stave, should be at least one\n";
			warn " line $LineNum: stavenumber $stave too small\n";
			$stave = 1;
		}
		$ystave      = $ystave{$isyst,$stave};      # timesaver
		$staveheight = $staveheight{$isyst,$stave}; # timesaver
	}
	$istave      = $stave;
	$defaultstem = $stem;
	return 1;
}



sub comment { my $s = $_[$[];
	if ($Midi) { push @midiscore, ['marker', $ticksatbarstart, $s];
	} elsif ($Xml) { return 1;
	} else { print "% $s\n";
	}
}
sub title { return if $Midi; my ($cmd,$string) = split(' ',$_[$[],2);
	if ($Xml) {
		# XXX out of its xml place; can also be multiple. Maybe just print:
		# print "\t<work>\n\t\t<work-title>$string</work-title>\n\t</work>\n";
		return;
	} else {
		$string =~ s/([()])/\\$1/g;
		printf "%g %g /$BoldFont $TitleFontSize ($string) centreshow\n",
		0.5 * ($lmar+$rmar), $headmar-5;
	}
}

# ------------------------- infrastructure ------------------------
sub dypitch { my $pitch = $_[$[];
	# returns how far the pitch is above the top line, in staveheights
	my $Y = $ytable{$pitch};
	if ($clef{$istave} =~ /^treble/)    { $Y += 0.125;
	} elsif ($clef{$istave} eq 'tenor') { $Y += 0.25;
	} elsif ($clef{$istave} =~ /^bass/) { $Y -= 0.125;
	}
	return $Y;
}
sub is_stemup { my ($stem, $pitch) = @_;
	my $stemup;
	if      ($stem =~ /'/)     { $stemup = 1;
	} elsif ($stem =~ /,/)     { $stemup = 0;
	} elsif ($defaultstem eq q{'}) { $stemup = 1;
	} elsif ($defaultstem eq q{,}) { $stemup = 0;
	} else {
		if (&dypitch($pitch)<-0.6) { $stemup = 1;
		} else                     { $stemup = 0;
		}
	}
	return $stemup;
}
sub is_a_clef { my $s = $_[$[];
	if ($s eq 'treble' || $s eq 'treble8va' || $s eq 'treble8vab' ||
		 $s eq 'alto' || $s eq 'tenor' ||
		 $s eq 'bass' || $s eq 'bass8va' || $s eq 'bass8vab' ) { return 1;
	} else { return 0;
	}
}
sub is_a_note { my $s = $_[$[];
	$s =~ s/[{}()][',]?\d?//g; # strip {1 {1 (1 )1 slurs and ties off
	$s =~ s/[\[\]]\d?//;       # strip [ ] [1 [1 beam characters off
	$s =~ tr/<>//d;            # strip < and > chord characters off
	$s =~ s/-.*$//;            # strip -xxx options off
	$s =~ /^[A-Ga-g][~_nbrl#,'x+]*$/;
}

sub parse_note { my $s = $_[$[];
	return unless $s;
	my $scopy = $s;
	my %r;   # will return hash_ref

	if ($s =~ s/\]$//)  { $r{endbeam}    = ']'; }
	if ($s =~ s/>$//)   { $r{endchord}   = '>'; }
	my ($notebit,$options) = split (/-/, $s, 2);
	$r{notebit} = $notebit;
	$r{options} = $options;
	my $len = $[ + length $notebit;
	pos $notebit = $[;
	if ($notebit =~ /\G\[/gc) { $r{startbeam}  = '['; }
	if ($notebit =~ /\G</gc)  { $r{startchord} = '<'; }
	if ($notebit =~ /\G([A-Ga-g][_~]*)([#bn]*)/gc) {
		$r{pitch}=$1; $r{accidental}=$2;
	}
	return \%r if $len <= pos $notebit;
	if ($notebit =~ /\G([xlr,']+)/gc) {
		my $xlrupdown = $1;
		if ($xlrupdown =~ s/(l+)//)   { $r{accidentalshift} = length $1; }
		if ($xlrupdown =~ s/(r+)//)   { $r{rightshift}      = length $1; }
		if ($xlrupdown =~ s/x//)      { $r{cross}           = 'x'; }
		if ($xlrupdown =~ s/([',])//) { $r{stem}            = $1; }
		return \%r if $len <= pos $notebit;
	}
	while ($len >= pos $notebit) {
		if ($notebit =~ /\G([{}()])([',]*)(\d)/gc) {
			$r{$SlurOrTie{$1}} = $3;
			if ($2) { $r{$SlurOrTie{$1}.'shift'} = $SlurOrTieShift{$2}; }
		} else { last;
		}
	}
	if ($notebit =~ /\G(.+)/gc) {
		my $before = substr( $notebit, $[, $-[$[] );
		warn " line $LineNum: bad note syntax in \"$scopy\" at \"$1\"\n";
	}
	return \%r;
}
sub round { my $x = $_[$[];
	if ($x > 0.0) { return int ($x + 0.5); }
	if ($x < 0.0) { return int ($x - 0.5); }
	return 0;
}
sub current_volume {
	if (defined $stave2volume{$currentstavenum}) {
		return $stave2volume{$currentstavenum};
	} else {
		return $DefaultVolume;
	}
}

# ------------------------ XML stuff -------------------------------
sub xml_header {  my $line = $_[$[];
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
	my $date = sprintf ('%4.4d-%2.2d-%2.2d', $year+1900, $mon+1, $mday);
	my $dtd = "http://www.musicxml.org/dtds/partwise.dtd";
	my $devel_dtd ="/home/pjb/musicxml/dtds/partwise.dtd";
	# if (-f $devel_dtd) { $dtd = $devel_dtd; }   # must comment out...
	if (!$xml{'header begun'}) { $xml{'header begun'} = 1; print <<EOT; }
<?xml version="1.0" encoding="ISO-8859-1" standalone="no"?>
<!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 1.1 Partwise//EN"
 "$dtd">
<score-partwise>
EOT
	if ($line =~ /^\d+\s+system/) { &systems(""); return 1; }
	if ($line =~ /^title (\S.*)$/) {
		print "\t<movement-title>$1</movement-title>\n";
		return 1;
	}
	if ($line =~ /^leftfoot (\S.*)$/) { $xml{credit} = $1; return 1; }
	if ($line =~ /^(left|right|inner|pagenum)/) { return 1; }
	print <<EOT;
	<identification>
		<encoding>
			<software>muscript $Version</software>
			<encoding-date>$date</encoding-date>
		</encoding>
	</identification>
EOT
	if ($xml{credit}) {
		print "\t<credit><credit-words>\n\t\t$xml{credit}\n",
		 , "\t</credit-words></credit>\n";
	}
	print <<EOT;
	<part-list>
		<score-part id="P1">
			<part-name>MIDI Track 1</part-name>
EOT
	# with readahead, we wouldn't need to set up all 16 channels...
	foreach (1..16) {
		print <<EOT;
			<score-instrument id="cha$_">
				<instrument-name>cha$_</instrument-name>
			</score-instrument>
EOT
	}
	foreach (1..16) {
		print <<EOT;
			<midi-instrument id="cha$_">
				<midi-channel>$_</midi-channel>
			</midi-instrument>
EOT
	}
	print <<'EOT';
		</score-part>
	</part-list>
	<part id="P1">
EOT
	return 0;
}
sub xml_event {
	if (!$Xml) { die "BUG xml_event called without \$Xml set\n"; }
	my @symbols = @_;
	my $i_note = 0;

	my $t1 = "\t"; my $t2 = "\t\t"; my $t4 = "$t2$t2";
	my $t3 = "$t2$t1"; my $t5 = "$t4$t1"; my $t6 = "$t4$t2";

	foreach my $symbol (@symbols) {
		$is_a_note = &is_a_note($symbol);
		if ($is_a_note || $symbol =~ /^rest/ || $symbol =~ /^blank/) {
			if ($currentpulse < $shortest) { $shortest = $currentpulse; }
		}
		if (defined $nbeats{$symbol}) {  # it's smb min cro qua smq dsq etc
			# we need to measure separately shortest stem-up and stem-down !
			if ($nbeats{$symbol}<$shortest) { $shortest=$nbeats{$symbol}; }
			$currentpulse = $nbeats{$symbol};
			$currentpulsetext = $symbol;
		} elsif ($is_a_note) {
			my $note_ref = &parse_note($symbol);

			# go through the options first; they can influence <note> element
			my @notations = ();
			if ($note_ref->{endslur}) {
				my $updown = ($note_ref->{endslur}%2) ? 'above' : 'below';
				push @notations,
				 "<slur type=\"stop\" placement=\"$updown\"/>";
			}
			if ($note_ref->{startslur}) {
				my $updown = ($note_ref->{startslur}%2) ? 'above' : 'below';
				push @notations,
				 "<slur type=\"start\" placement=\"$updown\"/>";
			}
			if ($note_ref->{endtie}) {
				my $updown = ($note_ref->{endtie}%2) ? 'above' : 'below';
				push @notations,
				 "<tied type=\"stop\" placement=\"$updown\"/>";
			}
			if ($note_ref->{starttie}) {
				my $updown = ($note_ref->{starttie}%2) ? 'above' : 'below';
				push @notations,
				 "<tied type=\"start\" placement=\"$updown\"/>";
			}
			# fermata is an xml notation; stacc, tenuto, emph are xml
			# articulations,  and an articulation is an xml notation;
			# tr, turn, mordent are xml ornaments
			#  and an ornament is an xml notation.
			my @articulations = ();
			my @ornaments = ();
			my $is_staccato = 0;
			my $is_emphasis = 0;
			my $options = $note_ref->{options};
			$options =~ s{'}{\\'}g;
			$Opt_Cache{$options} ||= [ parse_line('-',0,$options) ];  # 1?
			foreach (@{$Opt_Cache{$options}}) {
				my $option = $_;   # don't clobber the cache
				$option =~ s{\\'}{'}g;
				my $option_is_above = 1;
				if ($option =~ s{,$}{}g) { $option_is_above = 0; }
		
				my $text = q{}; my $shortoption = q{};
				if ($option =~  /^([Ibir]s?)(.+)$/) {  # text option
					$shortoption = $1; $text = $2;
				} elsif ($option =~  /^s(.+)$/) {
					$shortoption = 'rs'; $text = $1;
				} else {
					$shortoption = $option;
					$shortoption =~ tr /,'//d;
					$shortoption = $Options{$shortoption} || $shortoption;
				}
		
				if ($option_is_above) {
					$option =~ s{'$}{}g;
				} else {
				}
		
				if ($Options{$option}) {
					my $updown = $option_is_above ? 'above' : 'below';
					my $opt = $Options{$option};  # canonicalise
					if ($opt eq 'turn' || $opt eq 'mordent') {
						push @ornaments, "<$opt/>";
					} elsif ($opt eq 'dot') {
						$is_staccato = 1;
						push @articulations,
						 "<staccato placement=\"$updown\"/>";
					} elsif ($opt eq 'emphasis') {
						$is_emphasis = 1;
						push @articulations,
						 "<accent placement=\"$updown\"/>";
					} elsif ($opt eq 'tenuto') {
						push @articulations,
						 "<tenuto placement=\"$updown\"/>";
					} elsif ($opt =~ /^tr/) {
						push @ornaments,
						 "<trill-mark placement=\"$updown\"/>";
					}
				} elsif ($option eq 'blank') {
				} elsif (length $text) {  # text option
					my $font;  my $fontsize=$TextSize*$staveheight;
					if ($shortoption =~ /^I/) {
						if ($xml_dynamics{$text}) {
							push @notations, "<dynamics><$text/></dynamics>";
						}
						$font = $BoldItalicFont;
					} elsif ($shortoption =~ /^i/) { $font = $ItalicFont;
					} elsif ($shortoption =~ /^b/) { $font = $BoldFont;
					} else { $font = $RegularFont;
					}
					if ($shortoption =~ /s/) { $fontsize *= $SmallFontRatio; }
				} elsif ($shortoption eq 'fermata') {
					my $updown = $option_is_above ? 'upright' : 'inverted';
					push @notations,
					 "<fermata type=\"$updown\"/>";
				} elsif ($option =~ /^cre/ || $option =~ /^dim/) {
				} else {
					warn " line $LineNum: unrecognised option $option\n";
				}
			}

			my $note_attributes = q{};
			my $release = 0;   # legato = <note release="-ticks">
			my $legato = $stave2legato{$currentstavenum} || $DefaultLegato;
			if ($is_staccato) { $legato *= 0.55; }
			if ($currentpulsetext !~ /-s$/ && $currentpulse > 1.0) {
			 	$release = &round(($legato-1.0) * $TPC);
			} else { $release = &round(($legato-1.0)*$currentpulse*$TPC);
			}
			if (!$note_ref->{starttie} && abs $release > 1) {
				$note_attributes .= " release=\"$release\"";
			}
			my $vol = &current_volume();
			if ($is_emphasis) { $vol += 10; if ($vol>127) { $vol=127; } }
			my $vol = &round(1.1111*$vol);
			$note_attributes .= " dynamics=\"$vol\"";
			push @xml_cache, "$t3<note$note_attributes>\n";

			if ($currentpulsetext =~ /-s$/) {
				push @xml_cache, "$t4<grace/>\n";
			}
			if ($i_note) { push @xml_cache, "$t4<chord/>\n"; }
			$xml_pitch=&xml_pitch($note_ref->{pitch},$note_ref->{accidental});
			push @xml_cache, "$t4$xml_pitch\n";
			if ($currentpulsetext !~ /-s$/) {  # no duration on grace notes!
				my $duration = &round($currentpulse * $TPC);
				push @xml_cache, "$t4<duration>$duration</duration>\n";
				if (!$i_note) { $xml{backup} += $duration; }
			}
			if ($note_ref->{endtie}) {
				push @xml_cache, "$t4<tie type=\"stop\"/>\n";
			}
			if ($note_ref->{starttie}) {
				push @xml_cache, "$t4<tie type=\"start\"/>\n";
			}
			# fermata is a muscript option, and an xml notation
			my $channel = $stave2channel{$istave};
			if (defined $channel) {
				$channel++;
				push @xml_cache, "$t4<instrument id=\"cha$channel\"/>\n";
			}
			$i_note++;
			push @xml_cache, "$t4<voice>$xml{voice}</voice>\n";
			push @xml_cache, "$t4$xml_duration{$currentpulsetext}\n";
			if ($note_ref->{accidental}) {  # must be after <type>
				my $a = $xml_accidental{$note_ref->{accidental}};
				if ($a) {push @xml_cache,"$t4<accidental>$a</accidental>\n";}
			}
			if ($currentpulsetext =~ /3/) {  # triplet 
				push @xml_cache,
				 "$t4<time-modification><actual-notes>3</actual-notes>"
				 . "<normal-notes>2</normal-notes></time-modification>\n";
			}
			my $stemup = &is_stemup($note_ref->{stem},$note_ref->{pitch});
			push @xml_cache, "$t4<stem>".($stemup?'up':'down')."</stem>\n";
			push @xml_cache, "$t4<staff>$istave</staff>\n";
			my $nbeams = "1";
			if      ($currentpulsetext =~ /^smq/) { $nbeams = "2";
			} elsif ($currentpulsetext =~ /^dsq/) { $nbeams = "3";
			}
			if ($note_ref->{startbeam}) {
				for my $ibeam (1..$nbeams) { push @xml_cache,
					"$t4<beam number=\"$ibeam\">begin</beam>\n";
				}
				if ($stemup) { $Startbeamup = 1;
				} else {     $Startbeamdown = 1;
				}
			} elsif ($note_ref->{endbeam}) {
				for my $ibeam (1..$nbeams) { push @xml_cache,
					"$t4<beam number=\"$ibeam\">end</beam>\n";
				}
				if ($stemup) { $Startbeamup = 0;
				} else {     $Startbeamdown = 0;
				}
			} elsif ($Startbeamup   && $stemup) {
				for my $ibeam (1..$nbeams) { push @xml_cache,
					"$t4<beam number=\"$ibeam\">continue</beam>\n";
				}
			} elsif ($Startbeamdown && !$stemup) {
				for my $ibeam (1..$nbeams) { push @xml_cache,
					"$t4<beam number=\"$ibeam\">continue</beam>\n";
				}
			}

			if (@notations || @ornaments || @articulations) {
				push @xml_cache, "$t4<notations>";
				if (@notations) {
					push @xml_cache, "\n$t5", join "\n$t5", @notations;
				}
				if (@ornaments) {
					push @xml_cache,
					 "\n$t5<ornaments>", @ornaments, "</ornaments>";
				}
				if (@articulations) {
					push @xml_cache, "\n$t5<articulations>", @articulations,
					 "</articulations>";
				}
				push @xml_cache, "\n$t4</notations>\n";
			}
			push @xml_cache, "$t3</note>\n";
		} elsif ($symbol =~ /^rest/) {
			# must handle fermata
			my $clef = $clef{$istave};
			my $move = 0;  my $display = q{};
			if ($symbol =~ /('+)/)    { $move = length $1;
			} elsif ($symbol =~ /(,+)/)    { $move = 0 - length $1;
			}
			if ($move) {
				my $line = 4*$move + $midline{$clef{$istave}};
				my $octave = int (0.1 + $line/7);
				$line = $line % 7;
				my $step = $line2step{"$line"};
				$display = "<display-step>$step</display-step>"
				 . "<display-octave>$octave</display-octave>";
			}
			push @xml_cache, "$t3<note>\n$t4<rest>$display</rest>\n";
			my $duration = &round($currentpulse * $TPC);
			push @xml_cache, "$t4<duration>$duration</duration>\n";
			push @xml_cache, "$t4<voice>$xml{voice}</voice>\n";
			$xml{backup} += $duration;
			push @xml_cache, "$t4$xml_duration{$currentpulsetext}\n";
			push @xml_cache, "$t4<staff>$istave</staff>\n";
			push @xml_cache, "$t3</note>\n";
		} elsif ($symbol =~ /^blank/) {
			my $duration = &round($currentpulse * $TPC);
			$xml{backup} += $duration;
			push @xml_cache,
			 "$t3<forward><duration>$duration</duration></forward>\n";
		}
	}
}
sub xml_barline { return unless $Xml;  my ($type) = @_;
	# draws a barline of type $type. Types: 0 = simple, 1 = double,
	# add 2 for end-of-repeat, 4 for start-of-repeat, 8 for Segno
	my @elements;
	if ($type & 1) {
		push @elements, '<bar-style>light-heavy</bar-style>';
	}
	if ($type & 8) {   # Segno ...
		push @elements, '<segno/>';
	}
	if ($type & 2) {   # end repeated section ...
		push @elements, '<repeat direction="backward"/>';
	}
	if (@elements) { return "\t\t\t<barline>",@elements,"</barline>\n";
	} else { return q{};
	}
}
sub xml_transpose { my $c = 0 + $_[$[];
	my $d = round($c*0.583333) % 7;
	return "<transpose>\n\t\t\t\t\t<diatonic>$d</diatonic>"
	 . "<chromatic>$c</chromatic>\n\t\t\t\t</transpose>";
	$xml{'current transpose'} = $c;
}
sub xml_text { return unless $Xml;
	my ($type, $size, $vertpos, $text) = @_;
	
	my $font_size = 'medium';
	if      ($size =~ /l/) { $font_size = 'large';
	} elsif ($size =~ /s/) { $font_size = 'small';
	}
	my $font_weight = 'normal';
	if ($type =~ /b/ || $type =~ /I/) { $font_weight = 'bold'; }
	my $font_style = 'normal';
	if ($type =~ /i/ || $type =~ /I/) { $font_style = 'italic'; }

	$vertpos = $TextBelowStave unless $vertpos;
	my $ytext = 40.0 * $vertpos - 80.0;  # should measure gap, like &ps_text
	my $staveheight = $staveheight{$isyst,$istave}; # timesaver
	if ($istave == 0) {   # above the top stave in the system
		$ytext = 40.0 * $vertpos;
	} elsif ($istave < $nstaves{$isyst}) {   # text lies between staves
		$netgap = $gapheight{$isyst,$istave} - $TextSize*$staveheight;
		$ytext = -40.0 - (1.0-$vertpos) * $netgap * 40.0 / $staveheight;
	} else {   # below the bottom stave in the system
		$ytext = -40.0 -  40.0 * $vertpos;
	}

	my $t3 = "\t\t\t"; my $t4 = "$t3\t"; my $t5 = "$t4\t"; my $t6 = "$t3$t3";
	$text =~ s/\.\d+ / /g;
	# $text =~ s/ /#x0020/g;  # this xml hex notation not respected by mscore?

	push @xml_cache, "$t3<direction>\n";
	push @xml_cache, "$t4<direction-type>\n$t5<words halign=\"left\" ";
	if (0.1 < abs $ytext) {
		push @xml_cache, sprintf('default-y="%g" ', $ytext);
	}
	push @xml_cache, "font-style=\"$font_style\" ";
	push @xml_cache, "font-size=\"$font_size\" font-weight=\"$font_weight\">";
	push @xml_cache, "$text</words>\n$t4</direction-type>\n";
	if ($istave) {
		push @xml_cache, "$t4<staff>$istave</staff>\n$t3</direction>\n";
	} else       {
		push @xml_cache, "$t4<staff>1</staff>\n$t3</direction>\n";
	}
}
sub xml_timesig { return unless $Xml; my $str = $_[$[];
	if ($str) { $xml{'previous timesig line'} = $str;
	} else    { $str = $xml{'previous timesig line'};
	}
	my ($timesig, $parts) = split (' ', $str, 2);
	if (!$timesig) { return; }
	if ($timesig !~ m{^\d+/\d+$}) {
		if ($timesig =~ /^[.\d]+$/) {
			$parts = "$timesig $parts"; # put it back
			$timesig = $xml_timesig;
		} else {
			warn " line $LineNum: strange timesig $timesig\n"; return 0;
		}
	}
	return unless $parts;

	$timesig =~ m{^(\d+)/(\d+)$};
	my ($nn,$bottom) = (0+$1,0+$2);
	my $cro_per_bar = 4 * $nn / $bottom;
	my @parts = split ' ',$parts;
	my $nparts = scalar @parts;
	my $cro_per_part   = $cro_per_bar / $nparts;
	my $ticks_per_part = $cro_per_bar * $TPC / $nparts;  # float
	my $ticks_so_far = 0;  # int
	my $ipart = 0;
	foreach my $part (@parts) {
		$ipart++;
		my $secs_this_part;
		if ($part < 10) { $secs_this_part = $part;
		} else {
			$secs_this_part = 60 * $cro_per_bar / $part;
			if (!($nn % 3) && ($bottom == 8 || $bottom == 16)) {
				$secs_this_part *= 12 / $bottom;
			}
		}
		if ($secs_this_part < 0.1) {
			warn " line $LineNum: warning: secs_this_part=$secs_this_part\n";
			next;
		}
		my $tempo_this_part = 60 * $cro_per_part / $secs_this_part;
		push @xml_cache,
		 sprintf "\t\t\t<sound tempo=\"%g\"/>\n", $tempo_this_part;
		if ($ipart >= $nparts) { last; }
		my $new_ticks_so_far = &round($ipart * $ticks_per_part);
		my $ticks_this_part = $new_ticks_so_far - $ticks_so_far;
		push @xml_cache,
		 "\t\t\t<forward><duration>$ticks_this_part</duration></forward>\n";
		$ticks_so_far = $new_ticks_so_far;
	}
	if ($ticks_so_far) {
		push @xml_cache,
		 "\t\t\t<backup><duration>$ticks_so_far</duration></backup>\n";
	}
}
sub xml_pitch { my $pitch = shift; my $accidental = shift;
	my $step = $pitch;  $step =~ tr/[a-g]/[A-G]/d;
	my $octave;
	if ($pitch =~ tr/[A-G]/[a-g]/) { $octave = 3; } else { $octave = 4; }
	if ($clef{$istave} eq 'treble8va')     { $octave += 2;
	} elsif ($clef{$istave} eq 'treble')   { $octave += 1;
	} elsif ($clef{$istave} eq 'bass')     { $octave -= 1;
	} elsif ($clef{$istave} eq 'bass8vab') { $octave -= 2;
	}
	$octave += ($step =~ tr/~//d);
	$octave -= ($step =~ tr/_//d);
	
	my $alter = 0;   # 2.8u
	if ($accidental) {
		$accidentalled{$pitch} = $accidental;
		$alter = $accidental2alter{$accidental};
	} else {
		$alter = $accidental2alter{$accidentalled{$pitch}};
	}
	if ($alter) { $alter = "<alter>$alter</alter>"; } else { $alter = q{}; }
	return "<pitch><step>$step</step>$alter<octave>$octave</octave></pitch>";
}

sub xml_clef_attribute  { my $clef = $_[$[];
	my $sign = q{C};
	my $line = q{3};
	if ($clef =~ /^treble/)     { $sign = q{G}; $line = q{2};
	} elsif ($clef =~ /^bass/)  { $sign = q{F}; $line = q{4};
	} elsif ($clef =~ /^tenor/) { $line = q{4};
	}
	my $clef_octave_change = q{};
	if ($clef =~ /8vab$/)     { $clef_octave_change = q{-1};
	} elsif ($clef =~ /8va$/) { $clef_octave_change = q{1};
	}
	if ($clef_octave_change) {
		$clef_octave_change
		 = "<clef-octave-change>$clef_octave_change</clef-octave-change>";
	}
	return "<clef number=\"$istave\"><sign>$sign</sign><line>$line</line>"
	. "$clef_octave_change</clef>";
}
sub xml_keysig  { my $keysig = $_[$[];
	$keysig =~ m/(\d+)([#bn])/;
	my $fifths = $1 || q{0};  my $acc = $2;
	if ($acc =~ /b$/)   { $fifths = q{-} . $fifths;
	} elsif ($acc =~ /n$/) { $fifths = q{0};
	}
	return "<key number=\"$istave\"><fifths>$fifths</fifths></key>";
}
sub xml_time_attribute  { my $timesig = $_[$[];
	$timesig =~ m{(\d+)/(\d+)};
	my $beats = $1;  my $beat_type = $2;
	if ($acc =~ /b$/)   { $fifths = q{-} . $fifths;
	} if ($acc =~ /n$/) { $fifths = "0";
	}
	return "<time number=\"$istave\"><beats>$beats</beats>"
	. "<beat-type>$beat_type</beat-type></time>";
}
sub xml_print_cache {
	# Fussy order ...
	# ((footnote?,level?), divisions?, key?, time?, staves?, instruments?,
	# clef* , staff-details* , transpose? , directive* , measure-style*)
	# at beginning of measure, "staves clef clef.." for all staves :-(
	# EACH <attributes> can only contain one key, one time, one instruments
	#  and one transposes; therefore each stavenum needs its own 
	if (4 & $bartype{$isyst,$ibar-1}) {
		print "\t\t\t<barline location=\"left\">";
		print "<repeat direction=\"forward\"/></barline>\n";
	}
	foreach my $ca (@xml_cache) {
		if (ref $ca eq 'HASH') {
			print "\t\t\t<attributes>\n";
			foreach my $att qw(footnote level divisions key time) {
				if ($ca->{$att}) { print "\t\t\t\t",$ca->{$att},"\n"; }
			}
			if ($xml{staves} ne $xml{remembered_staves}) {
				print "\t\t\t\t<staves>$xml{staves}</staves>\n";
				$xml{remembered_staves} = $xml{staves};
			}
			if ($ca->{instruments}) {
				print "\t\t\t\t<instruments>",
				 $ca->{instruments},"</instruments>\n";
			}
			foreach my $att qw(clef transpose) {
				if ($ca->{$att}) { print "\t\t\t\t",$ca->{$att},"\n"; }
			}
			print "\t\t\t</attributes>\n";
		} else {
			print $ca;
		}
	}
	print &xml_barline($bartype{$isyst,$ibar});
	@xml_cache = ();
}

# ------------------------ MIDI stuff -------------------------------
sub midi_event {
	if (!$Midi) { die "BUG midi_event called without \$Midi set\n"; }
	my @symbols = @_;
	my ($shortest) = 99;
	# Here also, we'll need a measurement loop, to get $total_chord_options
	foreach my $symbol (@symbols) {
		$is_a_note = &is_a_note($symbol);
		if ($is_a_note || $symbol =~ /^rest/ || $symbol =~ /^blank/) {
			if ($currentpulse < $shortest) { $shortest = $currentpulse; }
		}
		if (defined $nbeats{$symbol}) {  # it's smb min cro qua smq dsq etc
			# we need to measure separately shortest stem-up and stem-down !
			if ($nbeats{$symbol}<$shortest) { $shortest=$nbeats{$symbol}; }
			$currentpulse = $nbeats{$symbol};
			$currentpulsetext = $symbol;
		} elsif ($is_a_note) {
			my $note_ref     = &parse_note($symbol);
			my $pitch        = $note_ref->{pitch};
			my $accidental   = $note_ref->{accidental};
			my $options      = $note_ref->{options};
			my $starttime    = $ticksatbarstart + $beatssofar*$ticksperbeat;
			my $fullduration = &round($currentpulse * $ticksperbeat);
			my $duration     = $fullduration;
			my $legato = $stave2legato{$currentstavenum} || $DefaultLegato;
			if ($duration > $TPC) { $duration -= &round((1.0-$legato) * $TPC);
			} else { $duration = &round($legato * $duration);
			}
			my $channel = $stave2channel{$istave};
			my $note = &midi_pitch("$pitch$accidental")
			 + $stave2transpose{$currentstavenum};
			if ($accidental) {
				$accidentalled{$pitch} = $accidental;
			} else {
				my $a = $accidentalled{$pitch};
				if ($a eq '#')       { $note++;
				} elsif ($a eq 'b')  { $note--;
				} elsif ($a eq '##') { $note+=2;
				} elsif ($a eq 'bb') { $note-=2;
				}
			}
			my $velocity = &current_volume();
			$options =~ s{'}{\\'}g;
			my @midiexpressions; # array of cre and dim commands
			foreach $option (&parse_line('-', 0, $options)) {
				$option =~ s{\\'}{'}g;
				$option =~ s{[,']$}{};
				if ($option eq 'fermata') { # change tempo down & back again
	  			} elsif ($option eq 'mordent') {
	  			} elsif ($option eq 'tr') {
	  			} elsif ($option eq 'tr#') {
	  			} elsif ($option eq 'trb') {
	  			} elsif ($option eq 'trn') {
	  			} elsif ($option eq 'turn') {
	  			} elsif ($option eq '.' || $option =~ /stacc?/) {
					$duration = &round(0.55 * $currentpulse * $ticksperbeat);
	  			} elsif ($option eq 'ten') {
					$starttime  -= 3;
					$duration = $currentpulse*$ticksperbeat + 3;
					$velocity = &round(1.15 * $velocity);
					if ($velocity > 127) { $velocity = 127; }
	  			} elsif ($option eq 'emph') {
					$velocity = &round(1.3 * $velocity);
					if ($velocity > 127) { $velocity = 127; }
	  			} elsif ($option =~ /^cre(\d+)$/)    {
					push @midiexpressions, 0+$1;
	  			} elsif ($option =~ /^dim(\d+)$/)    {
					push @midiexpressions, 0-$1;
				}
			}
			my $stemup = &is_stemup($note_ref->{stem}, $note_ref->{pitch});
			my $B = $starttime;
			my $D = $duration;
			my $startslur = $note_ref->{startslur};
			my $starttie  = $note_ref->{starttie};
			my $endslur   = $note_ref->{endslur};
			my $endtie    = $note_ref->{endtie};
			if ($startslur) { $startedslurs{"$istave $stemup"} = 1; }
			if ($endtie) {
				if ($startedties{"$istave $endtie"}) {
					my $beg_ref = $startedties{"$istave $endtie"};
					my $begn =   $beg_ref->[$[+4];
					if (!$accidental && ($pitch eq $beg_ref->[$[+6])) {
						$note = $begn;  # accidental tied over from prev bar
					}
					if ($begn == $note) {
						my $begtime = $beg_ref->[$[+1];
						if ($starttie) { # prolong the remembered note
							$beg_ref->[$[+2] = $starttime+$duration-$begtime;
							if ($starttie != $endtie) {
							# the tie-number might have changed, eg )1(2
								$startedties{"$istave $starttie"}
								 = $startedties{"$istave $endtie"};
								delete $startedties{"$istave $endtie"};
							}
						} else { # output the full-length combined note
							delete $startedties{"$istave $endtie"};
							$B = $begtime;
							$D = $starttime+$duration-$begtime;
						}
					} else {
						warn " line $LineNum: deprecated use of ( for slur."
						. " Use { instead\n";
						$#{$beg_ref} = $[+5;   # pop old $pitch off end
						push @midiscore, $beg_ref;
						delete $startedties{"$istave $endtie"};
						$startslur = $starttie;
					}
				} else {
					warn " line $LineNum: tie )$endtie has no "
					. "corresponding (\n";
				}
			} elsif ($midi_expression{$channel} != 100) {
				&midi_expression($B, $channel, 100);
			}
			if ($startedslurs{"$istave $stemup"}) {
				if ($endslur) {
					delete $startedslurs{"$istave $stemup"};
				} else {
					$D += $fullduration - $duration;
				}
			}
			if (@midiexpressions) { # 2.7a cre and dim
				my $n = scalar @midiexpressions;
				my $begin_section = $B;
				my $duration = $D;
				if ($starttie) { $duration = $fullduration; }
				my $ticks_per_section = &round($duration / $n);
				my $expression = 100;
				foreach my $expr (@midiexpressions) {
					if ($expression+$expr > 127)  { $expr = 127-$expression;
					} elsif ($expression+$expr < 0) { $expr = 0-$expression;
					}
					my $step = int (1.01 + 5*abs($expr)/$ticks_per_section);
					if ($expr < 0) { $step = 0 - $step; }
					my $nsteps = &round($expr / $step);
					if (! $nsteps) {
						$begin_section += $ticks_per_section; next;
					}
					my $i = 1; while (1) {
						$expression += $step;
						$ticks = &round($begin_section
						 + $i * $ticks_per_section/(1+$nsteps) );
						&midi_expression($ticks, $channel, $expression);
						$i++; if ($i > $nsteps) { last; }
					}
					$begin_section += $ticks_per_section;
				}
			}
			if ($starttie) {
				if (! $endtie) {  # 2.4e
					$startedties{"$istave $starttie"} =
					['note',$B,$fullduration,$channel,$note,$velocity,$pitch];
				}
			} else {
				# Difficult bug here if a voice crosses through a tied note
				# in the other voice on the same stave; it terminates it :-(
				push @midiscore, ['note',$B,$D,$channel,$note,$velocity];
			}
		}
	}
	$beatssofar += $shortest;
	return;
}
sub midi_pitch { my $pitch = $_[$[];  # middleC = 60
	my $P = $notetable{$pitch};
	if ($clef{$istave} eq 'treble8va')	   { $P += 24;
	} elsif ($clef{$istave} eq 'treble')   { $P += 12;
	} elsif ($clef{$istave} eq 'bass')     { $P -= 12;
	} elsif ($clef{$istave} eq 'bass8vab') { $P -= 24;
	}
	return $P;
}
sub midi_timesig { return unless $Midi; my $str = $_[$[];
	# should return here if !$str and midi_timesig has already been called.
	my ($timesig, $parts) = split (' ', $str, 2); my $cc;
	if (!$timesig) {
		$timesig = $midi_timesig;
	} elsif ($timesig !~ m{^(\d+)/(\d+)$}) {
		if ($timesig =~ /^[.\d]+$/) { $parts = "$timesig $parts"; # put back
		} else { warn " line $LineNum: strange timesig $timesig\n"; return 0;
		}
	} elsif ($timesig ne $midi_timesig) {
		# time signature ...  could be in a sub
		my ($nn,$bottom) = (0+$1,0+$2);
		my $dd=0; while (1) { if (1<<$dd >= $bottom) { last; } $dd++; }
		if ($bottom==8) {
			if ($nn%3==0) {$cc=int(0.5+$TPC*1.5);} else {$cc=int(0.5+$TPC*0.5);}
		} elsif ($bottom == 16) {
			if ($nn%3==0) {$cc=int(.5+$TPC*0.75);} else {$cc=int(.5+$TPC*0.25);}
		} elsif ($bottom == 32) {
			if ($nn%3==0) {$cc=int(.5+$TPC*.375);} else {$cc=int(.5+$TPC*.125);}
		} else { $cc = $TPC * 4.0 / $bottom;
		}
		# tweak the following globals ...
		push @midiscore, ['time_signature',$ticksatbarstart, $nn,$dd,$cc,8];
		$midi_timesig = $timesig;
		$miditicksperbeat = $cc;
		$ticksthisbar = &round(384 * $nn / $bottom);
	}
	$ticksthisbar ||= $TPC * 4 ;
	# tempo changes ...
	# return if $parts eq $midibarparts;
	if (!$parts) { $parts = $midibarparts;
	} else { $midibarparts = $parts;
	}
	my @parts = split ' ',$parts;
	my $i = 0; my $n = scalar @parts; my $ticksperpart = $ticksthisbar/$n;
	while (1) {
		my $starttime = &round($ticksatbarstart + $ticksperpart*$i);
		my $part = shift @parts;
		if ($part < 10) { # secs per part -> uSec per cro
			$miditempo = &round($TPC * 1000000 * $part / $ticksperpart);
		} else { # beats per minute -> uSec per cro
			$miditempo = &round(60000000 * $TPC / ($miditicksperbeat*$part));
		}
		if ($miditempo != $oldmiditempo) {
			push @midiscore, ['set_tempo', $starttime, $miditempo];
			$oldmiditempo = $miditempo;
		}
		$i++; last if $i >= $n;
	}
}
sub midi_global { my $str = $_[$[];
	# divisions = $TPC
	my %str = split (/\s*=\s*|\s+/, $str);
	my $cha = (defined $str{channel})? $str{channel} : $str{cha};
	if ($Xml) {  # the Parts mean MIDI-Tracks - we only use one track.
		my $t3 = "\t\t\t"; my $t4 = "\t\t\t\t";
		if (defined $cha) {
			my $pan = q{};
			if (defined $str{pan}) {
				$pan = sprintf " pan=\"%d\"", int (($str{pan}-50)*1.8);
			}
			$cha++;
			push @xml_cache,
			 "$t3<sound$pan><midi-instrument id=\"cha$cha\">\n";
			if (defined $str{patch}) {
				my $program = $str{patch} + 1;
				push @xml_cache,"$t4<midi-program>$program</midi-program>\n";
			}
			push @xml_cache,"$t3</midi-instrument></sound>\n";
		}
	} elsif ($Midi) {
		if (defined $cha) {
			if (defined $str{patch}) {
				push @midiscore,
				 ['patch_change', $ticksatbarstart, $cha, $str{patch}];
				$ticksatbarstart += 5;
				# enforce default expression, for subsequent cre and dim
				&midi_expression($ticksatbarstart,$cha,100);
			}
			if (defined $str{pan})    { &midi_cc($cha,10,$str{pan}); }
			if (defined $str{reverb}) { &midi_cc($cha,91,$str{reverb}); }
			if (defined $str{rate})   { &midi_cc($cha,76,$str{rate}); }
			if (defined $str{vibrato}){ &midi_cc($cha,77,$str{vibrato}); }
			if (defined $str{vib})    { &midi_cc($cha,77,$str{vib}); }
			if (defined $str{delay})  { &midi_cc($cha,78,$str{delay}); }
			if (defined $str{chorus}) { &midi_cc($cha,93,$str{chorus}); }
		} elsif (defined $str{pause}) {
			return unless $miditempo;  # uSec per crochet 
			$ticksatbarstart += &round($str{pause}*$TPC*1000000/$miditempo);
		} else {
			warn " line $LineNum: strange midi_global $str\n";
		}
	}
}
sub midi_cc { my ($cha, $num, $percent) = @_;
	my $val = &round($percent * 1.27);  # 0..100 to 1..127
	if ($val>127) { $val=127; } elsif ($val<0) { $val=0; }
	push @midiscore,['control_change',$ticksatbarstart,$cha,$num,$val];
}
sub midi_in_stave { my $str = $_[$[];
	if ($str =~ /^vol/) {
		if ($str =~ /^volu?m?e?(\d+)$/) {
			my $vol = 0+$1; if ($vol > 127) { $vol = 127; }
			$stave2volume{$currentstavenum} = $vol; return 1;
		} elsif ($str =~ /^volu?m?e?\+(\d+)$/) {
			my $vol = &current_volume() + $1;
			if ($vol > 127) { $vol = 127; }
			$stave2volume{$currentstavenum} = $vol; return 1;
		} elsif ($str =~ /^volu?m?e?-(\d+)$/) {
			my $vol = &current_volume() - $1;
			if ($vol < 2) { $vol = 1; }
			$stave2volume{$currentstavenum} = $vol; return 1;
		} else {
			return 0;
		}
	} elsif ($str =~ /^lega?t?o?(\d+)$/) {
		$stave2legato{$currentstavenum} = 0.01*$1; return 1;
	} elsif ($str =~ /^chan?n?e?l?(\d+)$/) {
		$stave2channel{$currentstavenum} = 0+$1; return 1;
	} elsif ($str =~ /^tran?s?p?o?s?e?([-+]?\d+)$/) {
		if ($Xml) {  # 2.8u
			my %attributes = ();
			$attributes{transpose} = xml_transpose($1);
			push @xml_cache, \%attributes;
			$xml{'current transpose'} = $c;   # 2.8u
			# XXX should remember _when_ this takes place
		}
		$stave2transpose{$currentstavenum} = 0+$1; return 1;
	} elsif ($str =~ /^vibr?a?t?o?(\d+)$/)    {
		if ($Xml) { return 1; }
		my $ticks    = $ticksatbarstart + $beatssofar*$ticksperbeat;
		my $val = round($1*1.27);  # 0..100 to 1..127
		if ($val>127) { $val=127; } elsif ($val<0) { $val=0; }
		my $cha = $stave2channel{$currentstavenum};
		push @midiscore, ['control_change',$ticks,$cha,77,$val];
		return 1;
	} else {
		return 0;
	}
}
sub midi_expression { my ($ticks, $cha, $num) = @_;
	if ($midi_expression{$cha} == $num) { return; }
	push @midiscore, ['control_change',$ticks, $cha, 11, $num];
	$midi_expression{$cha} = $num;
}
sub midi_write { return unless $Midi;
	my $ticks    = $ticksatbarstart + $beatssofar*$ticksperbeat;
	push @midiscore, ['marker', $ticks, 'final_barline']; # 2.8f
	my ($events_r,$ticks) = MIDI::Score::score_r_to_events_r(\@midiscore);
	if (!$events_r) { die "MIDI::Score::score_r_to_events_r failed\n"; }
	my $track = MIDI::Track->new( {'events'=>$events_r} );
	if (!$track) { die "MIDI::Track->new failed\n"; }
	my $opus=MIDI::Opus->new({'format'=>0,'ticks'=>$TPC,'tracks'=>[$track]});
	if (!$opus) { die "MIDI::Opus->new failed\n"; }
	$opus->write_to_file( '>-' );
}
# -------------------------- PostScript stuff --------------------------
sub ps_prolog {
	if ($PS_Prolog_Already || $Midi || $Xml) { return; }
	if (!$Strip) {   # prepend the ps header ...
		if ($Box_W && $Box_H) {
			print "%!PS-Adobe.3.0 EPSF-3.0\n%%BoundingBox 0 0 $Box_W $Box_H\n";
		} else {
			print "%!PS-Adobe-3.0\n";
		}
		# do we _really_ have to quote the whole thing ?
		while (<DATA>) { s{"}{\\"}g; print eval qq/"$_"/; }
	}
	$PS_Prolog_Already = 1;
}
#sub ps_events() {
#	warn <<'EOT';
#sub ps_events is not yet implemented.  If it ever is, it will scan
#%events_by_space and %inserts_by_space, working out the $X position
#of each event and calling &ps_event each time.
#EOT
#}
sub ps_event {
	my @symbols = @_;
	# print one thing, or multiple simultaneous things, on one stave ...
	if ($Midi) { die "BUG: ps_event called with \$Midi set\n"; }
	if ($Xml)  { die "BUG: ps_event called with \$Xml set\n"; }

	# will be right-adjusted later if there is an r in one of the notes ...
	my $X = &ps_beat2x($beatssofar,$beatsperpart);

	# measure shortest, highest and lowest stemup and stemdown notes ...
	local ($higheststemup, $loweststemup, $higheststemdown, $loweststemdown)
		= (0, 1000, 0, 1000);  # used by ps_y_above_note ps_y_below_note
	local ($highestnostem, $lowestnostem) = (0, 1000);  # ditto
	my ($Y, $symbol, $notebit, $endbeamup, $endbeamdown);
	my ($startcrossbeam, $endcrossbeamm, $total_chord_options);
	my ($shortest, $shortestup, $shortestdown) = (99, 99, 99);
	my ($stemup_rightshift,$stemdown_rightshift,$smb_rightshift) = (0,0,0);
	my %height2cross = ();  # 2.8p

	foreach my $symbol (@symbols) {

		if ($symbol =~ /^blank/) {
			$Y = $ystave - 0.5*$staveheight;
			if ($Y > $highestnostem) { $highestnostem = $Y; }
			if ($Y < $lowestnostem)  { $lowestnostem  = $Y; }
			my ($notebit, $this_notes_options) = split(/-/, $symbol, 2);
			$total_chord_options .= $this_notes_options;
		} elsif ($symbol =~ /^rest([,']*)/) {
			if ($1 =~ /,,,/)      { $Y = $ystave - 2.15*$staveheight;
			} elsif ($1 =~ /,,/)  { $Y = $ystave - 1.65*$staveheight;
			} elsif ($1 =~ /,/)   { $Y = $ystave - 1.15*$staveheight;
			} elsif ($1 =~ /'''/) { $Y = $ystave + 1.15*$staveheight;
			} elsif ($1 =~ /''/)  { $Y = $ystave + 0.65*$staveheight;
			} elsif ($1 =~ /'/)   { $Y = $ystave + 0.15*$staveheight;
			} else { $Y = $ystave - 0.5*$staveheight;
			}
			if ($Y > $highestnostem) { $highestnostem = $Y; }
			if ($Y < $lowestnostem)  { $lowestnostem  = $Y; }
			my ($notebit, $this_notes_options) = split(/-/, $symbol, 2);
			$total_chord_options .= $this_notes_options;
		} elsif (&is_a_note($symbol)) {
			my $note_ref = &parse_note($symbol);
			$symbol = $note_ref;  # 2.5m handle note as hashref
			my $notebit .= $note_ref->{notebit};
			$total_chord_options .= $note_ref->{options};
			$Y = &ps_ypitch($note_ref->{pitch});
			$stemup = &is_stemup($note_ref->{stem},$note_ref->{pitch});
			if (&ps_is_stemless()) {
				if ($Y > $highestnostem)   { $highestnostem = $Y; }
				if ($Y < $lowestnostem)    { $lowestnostem  = $Y; }
				if ($note_ref->{rightshift}) {
					$smb_rightshift = $note_ref->{rightshift};
				}
			} else {
				my $startbeam = $note_ref->{startbeam};
				my $endbeam   = $note_ref->{endbeam};
				if ($stemup) {	# stem up note ...
					if ($Y > $higheststemup)	{
						$higheststemup = $Y;
						$accidentalup = $note_ref->{accidental} || '-';
					}
					if ($Y < $loweststemup)      { $loweststemup = $Y; }
					if ($startbeam eq '[')       { $Startbeamup = 'yes';
					} elsif ($startbeam eq '[X') {
						$Startcrossbeam = $startbeam;
					}
					if ($endbeam eq ']')       { $endbeamup = 'yes';
					} elsif ($endbeam eq ']X') { $endcrossbeam = $endbeam;
					}
					if ($note_ref->{rightshift}) {
						$stemup_rightshift = $note_ref->{rightshift};
					}
					if ($currentpulse < $shortestup) {
						$shortestup = $currentpulse;
						$shortestuptext = $currentpulsetext;
					}
				} else { # stem down note ...
					if ($Y > $higheststemdown) { $higheststemdown = $Y; }
					if ($Y < $loweststemdown)  {
						$loweststemdown = $Y;
						$accidentaldown = $note_ref->{accidental} || '-';
					}
					if ($startbeam eq '[')       { $Startbeamdown = 'yes';
					} elsif ($startbeam eq '[X') {
						$Startcrossbeam = $startbeam;
					}
					if ($endbeam eq ']')       { $endbeamdown   = 'yes';
					} elsif ($endbeam eq ']X') { $endcrossbeam = $endbeam;
					}
					if ($note_ref->{rightshift}) {
						$stemdown_rightshift = $note_ref->{rightshift};
					}
					if ($note_ref->{cross}) {   # 2.8p
						my $height = &round(4*$ytable{$note_ref->{pitch}});
						$height2cross{$height} = 1;
					}
					if ($currentpulse < $shortestdown) {
						$shortestdown = $currentpulse;
						$shortestdowntext = $currentpulsetext;
					}
				}
			}
		} elsif (defined $nbeats{$symbol}) {  # it's smb min. min// cro etc
			$currentpulse = $nbeats{$symbol};   # BUG XXX fails smb <C cro G>
			$currentpulsetext = $symbol;
		} # it could also be other stuff, which we ignore here
	}
	# here ends the measurement loop

	# now begins the printing loop; print each vertically aligned symbol ...
	my $note_shift             = $NoteShift * $staveheight;
	my $stem_from_blob_centre  = $StemFromBlobCentre * $staveheight;
	foreach my $symbol (@symbols) {
		my $is_a_note = ref($symbol) eq "HASH";  # chached in previous loop
		if ($is_a_note || $symbol =~ /^rest/ || $symbol =~ /^blank/) {
			if ($currentpulse < $shortest) { $shortest = $currentpulse; }
		}
		if (defined $nbeats{$symbol}) {  # it's smb min cro qua smq dsq etc
			# we should measure separately shortest stem-up and stem-down !
			if ($nbeats{$symbol} < $shortest) { $shortest=$nbeats{$symbol}; }
			$currentpulse = $nbeats{$symbol};
			$currentpulsetext = $symbol;
		} elsif ($symbol=~/^blank/){ &ps_blank($currentpulsetext,$symbol,$X);
		} elsif ($symbol=~/^rest/) { &ps_rest($currentpulsetext,$symbol,$X);
		} elsif (&is_a_clef($symbol))    { # clef
		} elsif ($symbol eq 'clefspace') { # clefspace
		} elsif ($is_a_note) {             # it's a note !
			my $note_ref = $symbol;
			my $stemup=&is_stemup($note_ref->{stem},$note_ref->{pitch});
			my $shift;
			if ($currentpulsetext =~ /-s$/) { $acc *= $SmallNoteRatio; }
			if ($note_ref->{cross}) {
				my $d = $stem_from_blob_centre * 2.0;
				if ($currentpulsetext =~ /-s$/) { $d *= $SmallNoteRatio; }
				if (&ps_is_stemless()) {
					$shift = $smb_rightshift * $note_shift;
					&ps_note($note_ref, $X+$d+$shift, \%height2cross);
				} elsif ($stemup) {
					$shift = $stemup_rightshift * $note_shift;
					&ps_note($note_ref, $X+$d+$shift, \%height2cross);
				} else {
					$shift = $stemdown_rightshift * $note_shift;
					&ps_note($note_ref, $X-$d+$shift, \%height2cross);
				}
			} else {
				$shift = 0;
				if (&ps_is_stemless()) {
					$shift = $smb_rightshift * $note_shift;
				} elsif ($stemup_rightshift && $stemup) {
					$shift = $stemup_rightshift * $note_shift;
				} elsif ($stemdown_rightshift && !$stemup) {
					$shift = $stemdown_rightshift * $note_shift;
				}
				&ps_note($note_ref, $X+$shift, \%height2cross);
			}
		}
	}

	# print the notestems, if any ...
	my ($ystemend, $halfstemlength);
	if (&ps_is_stemless()) {   # just print the tremolandi, if any
		my $halfstemlength = 0.6*$StemLength * $staveheight;
		my $smb_x = $X + $smb_rightshift * $note_shift;
		if ($stemup) {   # XXX but $stemup has not been set :-(
			if ($currentpulsetext =~ m{///}) {
				printf "%g %g %g tremolando_dsq\n",
				$smb_x, $highestnostem + $halfstemlength, $staveheight;
			} elsif ($currentpulsetext =~ m{//}) {
				printf "%g %g %g tremolando_smq\n",
				$smb_x, $highestnostem + $halfstemlength, $staveheight;
			} elsif ($currentpulsetext =~ m{/}) {
				printf "%g %g %g tremolando_qua\n",
				$smb_x, $highestnostem + $halfstemlength, $staveheight;
			}
		} else { # stemdown
			if ($currentpulsetext =~ m{///}) {
				printf "%g %g %g tremolando_dsq\n",
				$smb_x, $lowestnostem - $halfstemlength,  $staveheight;
			} elsif ($currentpulsetext =~ m{//}) {
				printf "%g %g %g tremolando_smq\n",
				$smb_x, $lowestnostem - $halfstemlength,  $staveheight;
			} elsif ($currentpulsetext =~ m{/}) {
				printf "%g %g %g tremolando_qua\n",
				$smb_x, $lowestnostem - $halfstemlength,  $staveheight;
			}
		}
	} else {   # stems and possibly also tremolandi needed
		# print the stem(s), if any ...
		if ($higheststemup) {   # if there are some stempup notes ...
			$xstem = $X + $stem_from_blob_centre;
			$xstem += $stemup_rightshift * $note_shift;
			my $smallness = 1.0;
			if ($shortestuptext =~ /-s$/) {
				$xstem -=
					($BlackBlobHalfWidth*(1.0-$SmallNoteRatio))*$staveheight;
				$smallness = $SmallStemRatio;
			}
			$ystemend = $higheststemup + $StemLength*$staveheight*$smallness;
			# if ($shortestup<0.6 || ($shortestup>.7 && $shortestup<0.8)) {
			if (&ps_tails_or_beams($shortestuptext)) { # tails or beams ?
				if ($Startbeamup) {
					if (@beamup) {
						warn " line $LineNum: nested stem-up beams\n";
					}
					@beamup =
					 sprintf("%g\t%g\t%g\t$shortestuptext\tup\t%s\t%s",
					 $xstem,$loweststemup,$higheststemup,
					 $accidentalup, $total_chord_options);
				} elsif ($Startcrossbeam) {
					if (@crossbeam) {
						warn " line $LineNum: nested crossbeams\n";
					}
					@crossbeam =
					 sprintf("%g\t%g\t%g\t$shortestuptext\tup\t%s\t%s",
					 $xstem,$loweststemup, $higheststemup,
					 $accidentalup, $total_chord_options);
				} elsif (defined @crossbeam) { # mysterious -w warning here !
					push (@crossbeam,
					 sprintf("%g\t%g\t%g\t$shortestuptext\tup\t%s\t%s",
					 $xstem,$loweststemup,$higheststemup,
					 $accidentalup, $total_chord_options));
				} elsif (defined @beamup) { # mysterious -w warning here !
					push (@beamup,
					 sprintf("%g\t%g\t%g\t$shortestuptext\tup\t%s\t%s",
					 $xstem,$loweststemup,$higheststemup,
					 $accidentalup, $total_chord_options));
				} else {   # an independent, non-beamed qua smq or dsq
					if ($shortestuptext =~ /^qua/) {
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend, $loweststemup, $staveheight*$smallness;
					} elsif ($shortestuptext =~ /^smq/) {
						my $d = $TailSpacing * 0.5 * $staveheight;
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend-$d, $loweststemup, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend+$d, $ystemend-$d, $staveheight*$smallness;
					} elsif ($shortestuptext =~ /^dsq/) {
						my $d = $TailSpacing * $staveheight*$smallness;
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend-$d, $loweststemup, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend, $ystemend-$d, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemup\n", $xstem,
						$ystemend+$d, $ystemend, $staveheight*$smallness;
					}
				}
				if ($endbeamup) { &ps_beam(@beamup); }
			} else {	# crochets and minims ...
				printf "%g %g %g %g notestem\n",
				 $xstem, $ystemend, $loweststemup, $staveheight;
				# print the tremolandi, if any
				if ($currentpulsetext =~ m{///}) {
					printf "%g %g %g tremolando_dsq\n",
					$xstem, 0.5 * ($ystemend+$higheststemup), $staveheight;
				} elsif ($currentpulsetext =~ m{//}) {
					printf "%g %g %g tremolando_smq\n",
					$xstem, 0.5 * ($ystemend+$higheststemup), $staveheight;
				} elsif ($currentpulsetext =~ m{/}) {
					printf "%g %g %g tremolando_qua\n",
					$xstem, 0.5 * ($ystemend+$higheststemup), $staveheight;
				}
			}
			undef $Startbeamup;
		}
		if ($higheststemdown) {   # also, if there are some stemdown notes ...
			$xstem = $X - $stem_from_blob_centre;
			$xstem += $stemdown_rightshift * $note_shift;
			my $smallness = 1.0;
			if ($shortestdowntext =~ /-s$/) {
				$xstem +=
					($BlackBlobHalfWidth*(1.0-$SmallNoteRatio))*$staveheight;
				$smallness = $SmallStemRatio;
			}
			$ystemend = $loweststemdown - $StemLength*$staveheight*$smallness;

			if (&ps_tails_or_beams($shortestdowntext)) { # tails or beams ?
				if ($Startbeamdown) {
					if (@beamdown) {
						warn " line $LineNum: nested stem-down beams\n";
					}
					@beamdown = (
					 sprintf("%g\t%g\t%g\t$shortestdowntext\tdown\t%s\t%s",
					 $xstem,$loweststemdown,$higheststemdown,
					 $accidentaldown, $total_chord_options));
				} elsif (@beamdown) {
					push (@beamdown,
					 sprintf("%g\t%g\t%g\t$shortestdowntext\tdown\t%s\t%s",
					 $xstem,$loweststemdown,$higheststemdown,
					 $accidentaldown, $total_chord_options));
				} else {
					if ($shortestdowntext =~ /^qua/) {
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$higheststemdown, $ystemend, $staveheight*$smallness;
					} elsif ($shortestdowntext =~ /^smq/) {
						my $d = $TailSpacing * 0.5 * $staveheight*$smallness;
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$higheststemdown, $ystemend+$d, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$ystemend+$d, $ystemend-$d, $staveheight*$smallness;
					} elsif ($shortestdowntext =~ /^dsq/) {
						my $d = $TailSpacing * $staveheight*$smallness;
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$higheststemdown, $ystemend+$d, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$ystemend+$d, $ystemend, $staveheight*$smallness;
						printf "%g %g %g %g quaverstemdown\n", $xstem,
						$ystemend, $ystemend-$d, $staveheight*$smallness;
					}
				}
				if ($endbeamdown) { &ps_beam(@beamdown); }
			} else {	# crochets and minims ...
				printf "%g %g %g %g notestem\n",
				 $xstem, $higheststemdown, $ystemend, $staveheight;
				if ($currentpulsetext =~ m{///}) {  # print any tremolandi
					printf "%g %g %g tremolando_dsq\n",
					$xstem, 0.5 * ($ystemend+$loweststemdown), $staveheight;
				} elsif ($currentpulsetext =~ m{//}) {
					printf "%g %g %g tremolando_smq\n",
					$xstem, 0.5 * ($ystemend+$loweststemdown), $staveheight;
				} elsif ($currentpulsetext =~ m{/}) {
					printf "%g %g %g tremolando_qua\n",
					$xstem, 0.5 * ($ystemend+$loweststemdown), $staveheight;
				}
			}
			undef $Startbeamdown;
		}
	}

	# end of bracketed simultaneous notes, sub ps_event
	undef $accidentalup; undef $accidentaldown;
	$beatssofar += $shortest;
}
sub ps_tails_or_beams { my $text = $_[$[];
	if ($text =~ /^qua/) { return 1; }
	if ($text =~ /^smq/) { return 1; }
	if ($text =~ /^dsq/) { return 1; }
	return 0;
}
sub ps_is_stemless {
	if ($currentpulsetext =~ /^smb|^bre/) { return 1; } else { return 0; }
}
sub ps_note { local ($note_ref, $X, $height2cross_ref) = @_; # $X needs local
	# all the stem, tail, beam and rightshift stuff is in sub ps_event
	my $Xacc = $X - $AccidentalBeforeNote*$staveheight;
	local $Y      = &ps_ypitch($note_ref->{pitch});  # $Y needs local
	local $stemup = &is_stemup($note_ref->{stem},$note_ref->{pitch});
	my $acc_shift = $note_ref->{accidentalshift};
	if (($stemup || &ps_is_stemless()) && $note_ref->{cross}) { # 2.8p
		$Xacc -= 0.37 * $staveheight*$AccidentalShift;
	} elsif ($acc_shift && !$stemup && !$note_ref->{cross}) {
		my $height = &round(4*$ytable{$note_ref->{pitch}});
		if ($height2cross_ref->{$height-1}||$height2cross_ref->{$height+1}) {
			$Xacc -= 0.42 * $staveheight*$AccidentalShift;
		}
	}
	if ($acc_shift) { $Xacc -= $acc_shift*$staveheight*$AccidentalShift; }

	my $acc_size;
	if ($currentpulsetext =~ /-s$/) { $acc_size=$SmallNoteRatio*$staveheight;
	} else { $acc_size = $staveheight;
	}

	# print the accidental, if any
	local $accidental = $note_ref->{accidental};
	if (! defined $accidental) { $accidental = q{}; } # defeat -w warning
	if ($accidental eq '#') {
		printf ("%g %g %g sharp\n", $Xacc, $Y, $acc_size);
	} elsif ($accidental eq 'b') {
		printf ("%g %g %g flat\n",  $Xacc, $Y, $acc_size);
	} elsif ($accidental eq 'n') {
		printf ("%g %g %g natural\n",  $Xacc, $Y, $acc_size);
	} elsif ($accidental eq '##') {
		printf ("%g %g %g doublesharp\n", $Xacc, $Y, $acc_size);
	} elsif ($accidental eq 'bb') {
		printf ("%g %g %g flat\n",  $Xacc, $Y, $acc_size*0.9);
		printf "%g %g %g flat\n",
			$Xacc - $DoubleFlatSpacing*$staveheight, $Y, $acc_size*0.9;
	} elsif ($accidental) {
		die "BUG! pitch = $pitch, wierd accidental $accidental\n";
	}

	# print the blob, white or black
	if ($currentpulsetext =~ /^bre/) {  # bre cannot be small (yet ...)
		printf ("%g %g %g breve\n", $X, $Y, $staveheight);
	} elsif ($currentpulsetext =~ /^min|^smb/) {
		printf ("%g %g %g whiteblob\n", $X, $Y, $acc_size);
	} else {
		printf ("%g %g %g blackblob\n", $X, $Y, $acc_size);
	}

	# print the ledger lines, if any
	&ps_ledger_lines($X, &dypitch ($note_ref->{pitch}));

	# print the dot, if any
	{
		my $sh = $staveheight;
		if ($currentpulsetext =~ /-s$/) { $sh *= $SmallNoteRatio; }
		# should really only raise dot if note is on a line ...
		if ($currentpulsetext =~ /\.\./) {
			my $x_plus  = $X + $DotRightOfNote*$sh; 
			my $y_minus = $Y + $DotAboveNote*$sh; 
			printf ("%g %g %g doubledot\n", $x_plus, $y_minus, $sh);
		} elsif ($currentpulsetext =~ /\./) {
			my $x_plus  = $X + $DotRightOfNote*$sh; 
			my $y_minus = $Y + $DotAboveNote*$sh; 
			printf ("%g %g %g dot\n", $x_plus, $y_minus, $sh);
		}
	}

	# end the slur or tie, if any; here in PostScript they're the same.
	# XXX but if up {'1 then the x-adjustments could be dispensed with.
	# XXX we could have endslur AND endtie, or startslur AND starttie
	if ($note_ref->{endtie}) {
		&end_thing('tie', $note_ref->{endtie}, $note_ref->{endtieshift});
	}
	if ($note_ref->{endslur}) {
		&end_thing('slur',$note_ref->{endslur},$note_ref->{endslurshift});
	}
	sub end_thing { my ($thing_type, $thing_num, $thing_shift) = @_;
		my ($x_left, $y_left);
		$x_left = $x_start{$thing_type,$isyst,$istave,$thing_num};
		if (! $x_left) { # detect the nearest :|| before using BOL ...
			my $ib = $ibar;
			while (1) {
				$ib--;
				if (2&$bartype{$isyst,$ib}) {
					$x_left = $xbar{$isyst,$ib}; last;
				}
				if ($ib < 1) {
					$x_left = $lmargin{$isyst} + $SpaceForClef*$staveheight;
					last;
				}
			}
		}
		# XXX if stemup & shiftup, 1st step is a notestem, else .5 staveheight
		my $updown = 1.0;
		if ($thing_num % 2) {  # end tie above (odd numbers)
			my $above_note = $TieAboveNote + $thing_shift*$TieDy;
			if ($stemup && $thing_shift>0) { $above_note += $TieShift; }
			$y_right = $Y + $above_note*$staveheight;
			$x_right = $X;
			$y_left=$y_start{$thing_type,$isyst,$istave,$thing_num}||$y_right;
			if ($accidental eq 'b' && !$thing_shift) {
			  $y_right += 0.7*$TieAboveNote*$staveheight;
			}
		} else {	# end tie below
			$updown = -1.0;
			my $above_note = $thing_shift*$TieDy - $TieAboveNote;
			if (!$stemup && $thing_shift<0) { $above_note -= $TieShift; }
			$y_right = $Y + $above_note*$staveheight;
			$y_left=$y_start{$thing_type,$isyst,$istave,$thing_num}||$y_right;
			if ($stemup || $thing_shift) { $x_right = $X;
			} else { $x_right = $X - 1.6 * $BlackBlobHalfWidth * $staveheight;
			}
		}
		if (($x_right - $x_left) < $MustReallySquashTie*$staveheight) {
			$x_left  -= 0.75 * $BlackBlobHalfWidth * $staveheight;  # 2.4f
			$x_right += 0.75 * $BlackBlobHalfWidth * $staveheight;  # 2.4f
		} elsif (($x_right - $x_left) < $MustSquashTie*$staveheight) {
			$x_left  -= 0.50 * $BlackBlobHalfWidth * $staveheight;
			$x_right += 0.50 * $BlackBlobHalfWidth * $staveheight;
		}
		# impose max tie gradient ...
		my $max_delta_y = $MaxTieGradient * ($x_right-$x_left);
		my $actual_delta_y = abs ($y_right-$y_left);
		if ($actual_delta_y > $max_delta_y) {
			if ($y_right > $y_left) {	# positive gradient
				if ($thing_num%2) { $y_left += $actual_delta_y-$max_delta_y;
				} else { $y_right -= $actual_delta_y - $max_delta_y;
				}
			} else {	# negative gradient
				if ($thing_num%2) { $y_right += $actual_delta_y-$max_delta_y;
				} else { $y_left -= $actual_delta_y - $max_delta_y;
				}
			}
		}

		printf "%g %g %g %g %g %g slur\n",
			$x_left, $y_left, $x_right, $y_right, $updown, $staveheight;

		delete $x_start{$thing_type,$isyst,$istave,$thing_num};
		delete $y_start{$thing_type,$isyst,$istave,$thing_num};
	}

	# start a tie or slur, if any
	if ($note_ref->{starttie}) {
		&start_thing('tie', $note_ref->{starttie}, $note_ref->{starttieshift});
	}
	if ($note_ref->{startslur}) {
		&start_thing('slur',$note_ref->{startslur},$note_ref->{startslurshift});
	}
	sub start_thing { my ($thing_type, $thing_num, $thing_shift) = @_;
		if ($thing_num % 2) {  # start tie above (odd numbers)
			my $above_note = $thing_shift*$TieDy + $TieAboveNote;
			if ($stemup && $thing_shift>0) { $above_note += $TieShift; }
			$y_right = $Y + $above_note*$staveheight;
			$y_start{$thing_type,$isyst,$istave,$thing_num}
			 = $Y + $above_note*$staveheight;
			if ($thing_shift) {
				$x_start{$thing_type,$isyst,$istave,$thing_num}
					= $X + 0.5 * $BlackBlobHalfWidth * $staveheight;
			} elsif ($stemup) {
				$x_start{$thing_type,$isyst,$istave,$thing_num}
					= $X + 1.6 * $BlackBlobHalfWidth * $staveheight; # too far?
				if ((! @beamup) && ($currentpulsetext =~ /^smq|^qua|^dsq/)) {
					$x_start{$thing_type,$isyst,$istave,$thing_num} += 
						$BlackBlobHalfWidth * $staveheight;
				}
			} else {
				$x_start{$thing_type,$isyst,$istave,$thing_num} = $X;
			}
		} else {	# start tie below (even numbers)
			my $above_note = $thing_shift*$TieDy - $TieAboveNote;
			if (!$stemup && $thing_shift<0) { $above_note -= $TieShift; }
			$y_start{$thing_type,$isyst,$istave,$thing_num} =
			 $Y + $above_note*$staveheight;
			$x_start{$thing_type,$isyst,$istave,$thing_num}=$X;
		}
	}

	my $options = $note_ref->{options};
	if ($options && ! defined @beamup && ! $Startbeamup
	 && ! defined @beamdown && ! $Startbeamdown) {
		&ps_note_options($X, &ps_y_below_note(), &ps_y_above_note(), $options);
	}
}
sub ps_beat2x { my ($beatssofar,$beatsperpart) = @_;
	my $ipart = 1 + int($beatssofar/$beatsperpart - $eps);
	return ($xpart{$ipart} + ($xpart{$ipart + 1} - $xpart{$ipart}) *
		($beatssofar - $beatsperpart * ($ipart - 1)) / $beatsperpart);
}
sub ps_note_options { my ($x,$ybot,$ytop,$options) = @_; # do -xxx options

	# ensure the option clears the stave lines ...
	my $ystop = $ystave{$isyst,$istave} + $OptionClearance*$staveheight;
	if ($ytop < $ystop) { $ytop = $ystop; }
	my $ysbot = $ystave{$isyst,$istave} - ($OptionClearance+1)*$staveheight;
	if ($ybot > $ysbot) { $ybot = $ysbot; }

	my $y;
	my $dytop = 0.0;   # to space multiple options above the note
	my $dybot = 0.0;   # to space multiple options beneath the note
	$options =~ s{'}{\\'}g;
	$Opt_Cache{$options} ||= [ parse_line('-',1,$options) ];  # 0->1 2.7m
	foreach (@{$Opt_Cache{$options}}) {
		my $option = $_;   # don't clobber the cache
		$option =~ s{\\'}{'}g;
		my $option_is_above = 1;
		if ($option =~ s{,$}{}g) { $option_is_above = 0; }

		my $text = q{}; my $shortoption = q{};
		if ($option eq  'blank' || $option eq  q{}) {
			$shortoption = 'blank';
		} elsif ($option =~  /^([Ibir]s?)(.+)$/) {  # text option
			$shortoption = $1; $text = $2;
		} elsif ($option =~  /^s(.+)$/) {
			$shortoption = 'rs'; $text = $1;
		} elsif ($option =~  /^gs(\d+)$/) {
			$shortoption = 'gs'; $text = $1;
		} elsif ($option =~  /^dim/) {
			$shortoption = 'dim';
		} elsif ($option =~  /^cre/) {
			$shortoption = 'cre';
		} else {
			$shortoption = $option;
			$shortoption =~ tr /,'//d;
			$shortoption = $Options{$shortoption} || $shortoption;
		}

		my $optiondy = $staveheight;
		if (defined $OptionDy{$shortoption}) {
			$optiondy *= $OptionDy{$shortoption};
		} else {
			$optiondy *= $OptionDy;
		}
		if ($text =~ /^[aceimnorsuvwxz]+$/) { $optiondy *= 0.85; }
		if ($option_is_above) {
			$option =~ s{'$}{}g;
			$y = $ytop + $dytop + 0.5*$optiondy;
			$dytop += $optiondy;
		} else {
			$y = $ybot - $dybot - 0.5*$optiondy;
			$dybot += $optiondy;
		}

		if ($shortoption eq 'fermata') {
			if ($option_is_above) {
				printf "%g %g %g fermata\n",  $x, $y, $staveheight;
			} else {
				printf "%g %g %g fermata\n",  $x, $y, 0.0-$staveheight;
			}
		} elsif ($shortoption eq 'gs') {
			printf "$text %g %g %g guitar_string\n", $x, $y, $staveheight;
		} elsif ($Options{$option}) {
			printf "%g %g %g $Options{$option}\n", $x, $y, $staveheight;
		} elsif ($option eq 'blank' || $option eq q{}) {
		} elsif (length $text) {  # text option
			my $font;  my $fontsize=$TextSize*$staveheight;
			if      ($shortoption =~ /^I/) { $font = $BoldItalicFont;
			} elsif ($shortoption =~ /^i/) { $font = $ItalicFont;
			} elsif ($shortoption =~ /^b/) { $font = $BoldFont;
			} else { $font = $RegularFont;
			}
			if ($shortoption =~ /s/) { $fontsize *= $SmallFontRatio; }
			if ($text =~ /^"(.*)"$/) { $text = $1; }   # 2.7m
			$text =~ s/\(/\\(/g;  $text =~ s/\)/\\)/g; # 2.8a
			printf "%g %g /$font %g ($text) centreshow\n", $x, $y, $fontsize;
		} elsif ($option =~ /^cre/ || $option =~ /^dim/) {
		} else {
			warn " line $LineNum: unrecognised option $option\n";
		}
	}
}
sub ps_barline { my ($X, $isyst, $ibar) = @_;
	my $type = $bartype{$isyst,$ibar};
	my $maxstaveheight = $maxstaveheight{$isyst};
	# draws a barline of type $type at $X. Types: 0 = simple, 1 = double,
	# add 2 for end-repeat, 4 for start-repeat, 8 for Segno, 16 for missing
	if ($type > 15) { return; }  # 2.7g
	if ($type > 7) {   # Segno ...
		printf "%g %g %g segno\n", $X + .22*$staveheight,
			$ystave{$isyst,1} + $staveheight{$isyst,1}*$SegnoHeight,
			$maxstaveheight;
		$type -= 8;
	}
	if ($type > 3) {   # begin repeated section ...
		for ($i = 1; $i <= $nstaves{$isyst}; $i++) {
			my $staveheight = $staveheight{$isyst,$i};  # 2.8b
			&ps_repeatmark($isyst,$i,$X+.6*$SpaceForStartRepeat*$staveheight);
		}
		$type -= 4;
	}
	if ($type > 1) {   # end repeated section ...
		for ($i = 1; $i <= $nstaves{$isyst}; $i++) {
			my $staveheight = $staveheight{$isyst,$i};  # 2.8b
			&ps_repeatmark($isyst,$i,$X-0.6*$SpaceForStartRepeat*$staveheight);
		}
		$type -= 2;
	}
	if ($type == 0) {
		for ($i = 1; $i <= $nblines{$isyst}; $i++) {
			printf "%g %g %g %g barline\n", $X, $yblinetop{$isyst,$i},
			 $yblinebot{$isyst,$i}, $maxstaveheight;
		}
		return;
	}
	if ($type == 1) {
		for ($i = 1; $i <= $nblines{$isyst}; $i++) {
			my $staveheight = $staveheight{$isyst,$i};
			printf "%g %g %g %g barline\n", $X + 0.03*$staveheight,  # 2.8b
			 $yblinetop{$isyst,$i}, $yblinebot{$isyst,$i}, 2.0*$maxstaveheight;
			printf "%g %g %g %g barline\n", $X - 0.07*$staveheight,  # 2.8b
			 $yblinetop{$isyst,$i}, $yblinebot{$isyst,$i}, $maxstaveheight;
		}
		return;
	}
	printf "%% ERROR: barline called with type = %d\n", $type;
	return;
}
sub ps_text {  my ($fonttype, $fontsize, $vertpos, $text) = @_;
	if ($Midi) { warn "bug: ps_text called with \$Midi set\n"; return; }
	if ($Xml)  { warn "bug: ps_text called with \$Xml set\n";  return; }

	my $font = $RegularFont;
	if      ($fonttype eq 'b') { $font = $BoldFont;
	} elsif ($fonttype eq 'i') { $font = $ItalicFont;
	} elsif ($fonttype eq 'I') { $font = $BoldItalicFont;
	}

	my ($ytext, $size);
	# remember &text can be called before the first =1 line ...
	my $staveheight = $staveheight{$isyst,$istave}; # timesaver
	$vertpos = $TextBelowStave unless $vertpos;
	if ($istave == 0) {   # above the top stave in the system
		$staveheight = $staveheight{$isyst,1};
		$ytext = $ystave{$isyst,1} + $vertpos*$staveheight;
		$size = $TextSize * $staveheight;
	} elsif ($istave < $nstaves{$isyst}) {   # text lies between staves
		$netgap = $gapheight{$isyst,$istave} - $TextSize*$staveheight;
		$size = 0.5*$TextSize * ($staveheight+$staveheight{$isyst,$istave+1});
		$ytext = $vertpos*$netgap + $ystave{$isyst, $istave+1} + 0.33*$size;
	} else {   # below the bottom stave in the system
		# XXX just TextSize too clumsy: could be lowercase, could be small...
		$ytext = $ystave{$isyst,$istave}-($TextSize+1.0+$vertpos)*$staveheight;
		$size = $TextSize * $staveheight;
	}
	if ($fontsize eq 's') { $size *= $SmallFontRatio;
	} elsif ($fontsize eq 'l') { $size /= $SmallFontRatio;
	}
	# could use /gc, see p.257
	$text =~ s/([^\\])\(/$1\\(/g;  # escape non-escaped ()
	$text =~ s/([^\\])\)/$1\\)/g;
	$text =~ s/^\(/\\(/;  # at start of string too ...
	$text =~ s/^\)/\\)/;

	# interpret ".48 some text" horizontal spacing
	my %str_by_pos; my $pos = 0.0;
	while ($text =~ /^(.*? )??(\.\d{1,3}) (.*)$/) {
		$str_by_pos{$pos} = $1; $pos = $2; $text = $3;
	}
	$str_by_pos{$pos} = $text;
	my ($left, $right);
	foreach $pos (keys %str_by_pos) {  # order doesn't matter !
		# should maybe handle $SpaceRightOfClef,$SpaceForClef,$SpaceForTimeSig,
		# $SpaceAfterKeySig, $SpaceForStartRepeat, $SpaceForEndRepeat,
		# $SpaceAtEndOfBar ?
		if ($pos > $eps && $ibar == 1) {
			$left = $xbar{$isyst,0} +
			($SpaceForClef+$WhiteBlobHalfWidth)*$staveheight;
		} else {
			$left = $xbar{$isyst,$ibar-1} + $WhiteBlobHalfWidth*$staveheight;
		}
		$right = $xbar{$isyst,$ibar} - $WhiteBlobHalfWidth*$staveheight;
		$text = $str_by_pos{$pos};
		next unless $text =~ /\S/;
		printf("%g %g /$font %g (%s) leftshow\n",
			(1.0-$pos)*$left + $pos*$right, $ytext, $size, $text );
	}
}
sub ps_beam { # usage: &ps_beam(@beamup)
	# Draws a beam across, and stems up or down from, a list of events.
	# Each event is expressed by seven TAB-separated items in a string:
	# xstem, ylowblob, yhighblob, qua smq or dsq, up or down,
	# accidental on top (if up) or bottom (if down) note, $options eg tr-ff-.

	# pre-multiply some frequently-used stuff
	my $accidental_before_note
	 = ($AccidentalBeforeNote+$WhiteBlobHalfWidth) * $staveheight;
	my $min_beam_clearance = $MinBeamClearance * $staveheight;
	my $sharp_half_height  = $SharpHalfHeight  * $staveheight;
	my $flat_half_height   = $FlatHalfHeight   * $staveheight;

	my ($x,$ylowblob,$yhighblob,$duration,$direction,$accidental,$options);
	my (@duration, $Direction, @x, @ylowblob, @yhighblob, @accidental, $n);
	my (@options);
	undef $Startbeamup;
	$n = scalar @_; return unless $n;
	if ($n < 2) {
	 warn " ps_beam: only $n stems at bar $ibar stave $istave\n"; return 0;
	}
	my $smallness = $SmallStemRatio;
	foreach $string (@_) {
		($x,$ylowblob,$yhighblob,$duration,$direction,$accidental,$options)
		= split("\t",$string);
		$duration =~ s{\.+$}{};	# ignore dotted for beam-drawing purposes
		if ($duration !~ /^qua|^smq|^dsq/) {
			warn " ps_beam: $string: unknown duration $duration\n"; return 0;
		}
		if ($duration !~ /-s$/) {
			$smallness = 1.0; # only small if all notes under beam are small
		}
		if ($direction !~ /^up|^down/) {
			warn " ps_beam: $string: unknown direction $direction\n";
			return 0;
		}
		if ($Direction) {
			if ($direction ne $Direction) { warn
				" ps_beam can't mix $Direction and $direction\n"; exit 0;
			}
		} else {
			$Direction = $direction;
		}
		push (@x, $x);
		push (@ylowblob, $ylowblob);
		push (@yhighblob, $yhighblob);
		push (@duration, $duration);
		push (@accidental, $accidental);  # $note_ref->{accidental} ?
		push (@options, $options);
	}
	my $smallstaveheight = $staveheight * $smallness;   # for speed
	my $stem_length   = $StemLength*$smallstaveheight;
	my $max_beam_stub = $MaxBeamStub*$smallstaveheight;
	my ($x1,$xn, $ylowblob1,$ylowblobn, $yhighblob1,$yhighblobn, $y1,$yn);
	$x1         = $x[$[];         $xn         = $x[$[+$n-1];
	$ylowblob1  = $ylowblob[$[];  $ylowblobn  = $ylowblob[$[+$n-1];
	$yhighblob1 = $yhighblob[$[]; $yhighblobn = $yhighblob[$[+$n-1];

	if ($Direction =~ /^up/) {
		$y1 = $yhighblob1 + $stem_length;
		$yn = $yhighblobn + $stem_length;

		# impose max beam gradient ...
		my $ymin;   # BUG if $xn == $x1
		if ($yn > $y1) {	# positive gradient
			$ymin = $yn - $MaxBeamGradient * ($xn-$x1);
			if ($y1 < $ymin) { $y1 = $ymin; }
		} else {	# negative gradient
			$ymin = $y1 - $MaxBeamGradient * ($xn-$x1);
			if ($yn < $ymin) { $yn = $ymin; }
		}

		# check the beams don't sink into ledger lines ...  2.7v,2.7x
		my $gap = $BeamSpacing*$smallstaveheight;
		$ymin = $ystave{$isyst, $istave} - $staveheight;
		if ($y1 < $yn) {
			if ($duration[$[] =~ /^smq/)      { $ymin += $gap;
			} elsif ($duration[$[] =~ /^dsq/) { $ymin += 2.0*$gap;
			}
			if ($y1 < $ymin) { $yn = $ymin + 0.5*($yn-$y1); $y1 = $ymin; }
		} else {
			if ($duration[$[+$n-1] =~ /^smq/)      { $ymin += $gap;
			} elsif ($duration[$[+$n-1] =~ /^dsq/) { $ymin += 2.0*$gap;
			}
			if ($yn < $ymin) { $y1 = $ymin + 0.5*($y1-$yn); $yn = $ymin; }
		}

		# check if any intermediate notes are too high ...
		my ($x, $y, $dx, $dy, $dydx, $too_high);
		$dy = $yn - $y1;
		$dx = $xn - $x1;	if ($dx<1.0) { $dx=1.0; }
		$dydx = $dy / $dx;
		$too_high = 0;
		foreach $i (($[+1) .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dydx * ($x-$x1);
			$ymin = $yhighblob[$i] + $min_beam_clearance;
			if ($y < $ymin) { $too_high = 1; last; }
			if ($accidental[$i] ne '-') {
				$x = $x[$i] - $accidental_before_note;
				$y = $y1 + $dydx * ($x-$x1);
				$ymin = $yhighblob[$i]+$min_beam_clearance+$sharp_half_height;
				if ($y < $ymin) { $too_high = 1; last; }
			}
		}
		if ($too_high && $n>2) {
			my $best_fit_gradient = &ps_best_fit_gradient(\@x,\@yhighblob);
			if ((abs $best_fit_gradient) < $MaxBeamGradient) {
				if ($best_fit_gradient > 0.0) {	# positive gradient
					$ymin = $yn - $best_fit_gradient * ($xn-$x1);
					if ($y1 < $ymin) { $y1 = $ymin; }
				} else {	# negative gradient
					$ymin = $y1 + $best_fit_gradient * ($xn-$x1);
					if ($yn < $ymin) { $yn = $ymin; }
				}
			}
		}

		# raise beam if intermediate notes are too high ... XXX
		$dy = $yn - $y1; $dydx = $dy / $dx;
		foreach $i ($[+1 .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dydx * ($x-$x1);
			$ymin = $yhighblob[$i] + $min_beam_clearance;
			if ($y < $ymin) { $y1 += $ymin-$y; $yn += $ymin-$y;}
			if ($accidental[$i] ne '-') {
				$x = $x[$i] - $accidental_before_note;
				$y = $y1 + $dydx * ($x-$x1);
				$ymin = $yhighblob[$i]+$min_beam_clearance+$flat_half_height;
				if ($y < $ymin) { $y1 += $ymin-$y; $yn += $ymin-$y; }
			}
		}
		# print the first (qua) beam anyway ...
		printf "%g %g %g %g %g beam\n", $x1, $y1, $xn, $yn, $smallstaveheight;

		# then print the smq beam (up) where it is needed ...
		foreach $i ($[ .. ($[+$n-1)) {  # ugly... 2.7x +1?
			if ($duration[$i] =~ /^smq|^dsq/) {	# it's needed ...
				if ($i == $[ && $duration[$i+1] !~ /^smq|^dsq/) { # halflngth
					my $stublength = ($x[$i+1] - $x[$i]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
					$x[$i], $y1-$gap, $x[$i]+$stublength,
					$y1-$gap+$dydx*($x[$i]+$stublength-$x1),$smallstaveheight;
				} elsif ($duration[$i-1] =~ /^smq|^dsq/) {	# to previous
					printf "%g %g %g %g %g beam\n",
					$x[$i-1], $y1-$gap+$dydx*($x[$i-1]-$x1),
					$x[$i], $y1-$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				} elsif ($duration[$i+1] !~ /^smq|^dsq/) {	# half-length
					my $stublength = ($x[$i] - $x[$i-1]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
					$x[$i] - $stublength,
					$y1-$gap+$dydx*($x[$i]- $stublength-$x1),
					$x[$i], $y1-$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				}
			}
		}
		# and then print the dsq beam (up) where that is needed ...
		foreach $i ($[ .. ($[+$n-1)) {  # ugly... XXX +1?
			if ($duration[$i] =~ /^dsq/) {
				if ($i == $[ && $duration[$i+1] !~ /^dsq/) { # half-length...
					my $stublength = ($x[$i+1] - $x[$i]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n", $x[$i], $y1-$gap-$gap,
						$x[$i]+$stublength,
						$y1-$gap-$gap+$dydx*($x[$i]+$stublength-$x1),
						$smallstaveheight;
				} elsif ($duration[$i-1] =~ /^dsq/) {  # to the previous ...
					printf "%g %g %g %g %g beam\n", $x[$i-1],
					$y1-$gap-$gap+$dydx*($x[$i-1]-$x1), $x[$i],
					$y1-$gap-$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				} elsif ($duration[$i+1] !~ /^dsq/) {  # half-length ...
					my $stublength = ($x[$i] - $x[$i-1]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n", $x[$i]-$stublength,
					$y1-$gap-$gap+$dydx*($x[$i]-$stublength-$x1), $x[$i],
					$y1-$gap-$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				}
			}
		}
		# print stems ...
		printf "%g %g %g %g notestem\n", $x1, $y1, $ylowblob1, $staveheight;
		&ps_note_options($x1 - $WhiteBlobHalfWidth*$staveheight,
			$ylowblob1 - ($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			$y1 + ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
			$options[$[]);
		# intermediate stems ...
		foreach $i (($[+1) .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dy * ($x-$x1) / $dx;
			printf "%g %g %g %g notestem\n",
			 $x, $y, $ylowblob[$i], $staveheight;
			&ps_note_options($x - $WhiteBlobHalfWidth*$staveheight,
			 $ylowblob[$i]-($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			 $y + ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
			 $options[$i]);
		}
		printf "%g %g %g %g notestem\n", $xn, $yn, $ylowblobn, $staveheight;
		&ps_note_options($xn - $WhiteBlobHalfWidth*$staveheight,
			$ylowblobn - ($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			$yn + ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
			$options[$[+$n-1]);
		undef @beamup;

	} else {	# Direction is down ...
		$y1 = $ylowblob1 - $stem_length;
		$yn = $ylowblobn - $stem_length;

		# impose max beam gradient ... XXX
		my $ymax;
		if ($yn > $y1) {	# positive gradient
			$ymax = $y1 + $MaxBeamGradient * ($xn-$x1);
			if ($yn > $ymax) { $yn = $ymax; }
		} else {	# negative gradient
			$ymax = $yn + $MaxBeamGradient * ($xn-$x1);
			if ($y1 > $ymax) { $y1 = $ymax; }
		}

		# check the beams don't rise into ledger lines ...  2.7v,2.7x
		my $gap = $BeamSpacing*$smallstaveheight;
		$ymax = $ystave{$isyst, $istave};
		if ($y1 > $yn) {
			if ($duration[$[] =~ /^smq/)      { $ymax -= $gap;
			} elsif ($duration[$[] =~ /^dsq/) { $ymax -= 2.0*$gap;
			}
			if ($y1 > $ymax) { $yn = $ymax - 0.5*($y1-$yn); $y1 = $ymax; }
		} else {
			if ($duration[$[+$n-1] =~ /^smq/)      { $ymax -= $gap;
			} elsif ($duration[$[+$n-1] =~ /^dsq/) { $ymax -= 2.0*$gap;
			}
			if ($yn > $ymax) { $y1 = $ymax - 0.5*($yn-$y1); $yn = $ymax; }
		}

		# check if any intermediate notes are too low ...
		my ($x, $y, $dx, $dy, $dydx, $too_low);
		$dy = $yn - $y1;
		$dx = $xn - $x1;	if ($dx<1.0) { $dx=1.0; }
		$dydx = $dy / $dx;
		$too_low = 0;
		foreach $i (($[+1) .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dy * ($x-$x1) / $dx;
			$ymax = $ylowblob[$i] - $min_beam_clearance;
			if ($y > $ymax) { $too_low = 1; last; }
			if ($accidental[$i] ne '-') {
				$x = $x[$i] - $accidental_before_note;
				$y = $y1 + $dydx * ($x-$x1);
				$ymax = $ylowblob[$i]-$min_beam_clearance+$sharp_half_height;
				if ($y > $ymax) { $too_low = 1; last; }
			}
		}
		if ($too_low && $n>2) {
			my $best_fit_gradient = &ps_best_fit_gradient(\@x,\@ylowblob);
			if ((abs $best_fit_gradient) < $MaxBeamGradient) {
				if ($best_fit_gradient > 0.0) {	# positive gradient
					$ymax = $y1 + $best_fit_gradient * ($xn-$x1);
					if ($yn > $ymax) { $yn = $ymax; }
				} else {	# negative gradient
					$ymax = $yn - $best_fit_gradient * ($xn-$x1);
					if ($y1 > $ymax) { $y1 = $ymax; }
				}
			}
		}

		# lower beam if intermediate notes are too low ...
		$dy = $yn - $y1; $dydx = $dy / $dx;
		foreach $i (($[+1) .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dy * ($x-$x1) / $dx;
			$ymax = $ylowblob[$i] - $min_beam_clearance;
			if ($y > $ymax) { $y1 -= $y-$ymax; $yn -= $y-$ymax; }
			if ($accidental[$i] ne '-') {
				$x = $x[$i] - $accidental_before_note;
				$y = $y1 + $dydx * ($x-$x1);
				$ymax = $ylowblob[$i]-$min_beam_clearance+$sharp_half_height;
				if ($y > $ymax) { $y1 -= $y-$ymax; $yn -= $y-$ymax; }
			}
		}

		# print the first (qua) beam anyway ...
		printf "%g %g %g %g %g beam\n", $x1, $y1, $xn, $yn, $smallstaveheight;

		# then print the smq beam (down) where it is needed ...
		my $gap = $BeamSpacing*$smallstaveheight;   # 2.7u
		foreach $i ($[ .. ($[+$n-1)) {
			if ($duration[$i] =~ /^smq|^dsq/) {	# it's needed ...
				if ($i == $[ && $duration[$i+1] !~ /^smq|^dsq/) { # half-length
					my $stublength = ($x[$i+1] - $x[$i]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
					$x[$i], $y1+$gap, $x[$i]+$stublength,
					$y1+$gap+$dydx*($x[$i]+$stublength-$x1), $smallstaveheight;
				} elsif ($duration[$i-1] =~ /^smq|^dsq/) {	# to the previous
					printf "%g %g %g %g %g beam\n",
					$x[$i-1], $y1+$gap+$dydx*($x[$i-1]-$x1),
					$x[$i], $y1+$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				} elsif ($duration[$i+1] !~ /^smq|^dsq/) {	# half-length
					my $stublength = ($x[$i] - $x[$i-1]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
					$x[$i] - $stublength,
					$y1+$gap+$dydx*($x[$i]- $stublength-$x1),
					$x[$i], $y1+$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				}
			}
		}
		# and then print the dsq beam (down) where that is needed ...
		foreach $i ($[ .. ($[+$n-1)) {
			if ($duration[$i] =~ /^dsq/) {	# it's needed ...
				if ($i == $[ && $duration[$i+1] !~ /^dsq/) {  # half-length...
					my $stublength = ($x[$i+1] - $x[$i]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
						$x[$i], $y1+$gap+$gap, $x[$i]+$stublength,
						$y1+$gap+$gap+$dydx*($x[$i]+$stublength-$x1),
						$smallstaveheight;
				} elsif ($duration[$i-1] =~ /^dsq/) {	# to the previous ...
					printf "%g %g %g %g %g beam\n",
						$x[$i-1], $y1+$gap+$gap+$dydx*($x[$i-1]-$x1),
						$x[$i], $y1+$gap+$gap+$dydx*($x[$i]-$x1),
						$smallstaveheight;
				} elsif ($duration[$i+1] !~ /^dsq/) {	# half-length ...
					my $stublength = ($x[$i] - $x[$i-1]) * 0.5;
					if ($stublength > $max_beam_stub) {
						$stublength = $max_beam_stub;
					}
					printf "%g %g %g %g %g beam\n",
					$x[$i] - $stublength,
					$y1+$gap+$gap+$dydx*($x[$i]- $stublength-$x1), $x[$i],
					$y1+$gap+$gap+$dydx*($x[$i]-$x1), $smallstaveheight;
				}
			}
		}
		# print stems ... hmm, this double-prints the options ...
		printf "%g %g %g %g notestem\n", $x1, $y1, $yhighblob1, $staveheight;
		&ps_note_options($x1 + $WhiteBlobHalfWidth*$staveheight,
			$y1 - ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
			$yhighblob1 + ($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			$options[$[]);
		# intermediate stems ...  also print -xxx options in this loop ...
		foreach $i (($[+1) .. ($[+$n-2)) {
			$x = $x[$i]; $y = $y1 + $dy * ($x - $x1) / $dx;
			printf "%g %g %g %g notestem\n",
			 $x, $y, $yhighblob[$i], $staveheight;
			&ps_note_options($x + $WhiteBlobHalfWidth*$staveheight,
			 $y - ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
		 $yhighblob[$i]+($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			 $options[$i]);
		}
		printf "%g %g %g %g notestem\n", $xn, $yn, $yhighblobn, $staveheight;
		&ps_note_options($xn + $WhiteBlobHalfWidth*$staveheight,
			$yn - ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight,
			$yhighblobn + ($OptionClearance+$WhiteBlobHalfHeight)*$staveheight,
			$options[$[+$n-1]);
		undef @beamdown; undef $Startbeamdown;
	}
}
sub ps_keysig { my ($num, $sign, $x) = @_;
	die if $Midi||$Xml;
	my ($y, $dx, @pitches, $ikey, $pitch, $accidental);
	$dx = $AccidentalDxInKeysig * $maxstaveheight{$isyst};
	$x += 0.5 * $dx;
	if ($num < 0)          { $accidental = 'natural'; $num = 0-$num # 2.8b
	} elsif ($sign eq '#') { $accidental = 'sharp';
	} elsif ($sign eq 'b') { $accidental = 'flat';
	} else { return 0;
	}
	if ($clef{$istave} =~ /^treble/) {
		if ($sign eq '#') {		@pitches = ('f','c','g','d','A','e','B');
		} elsif ($sign eq 'b') { @pitches = ('B','e','A','d','G','c','F');
		}
	} elsif ($clef{$istave} eq 'alto') {
		if ($sign eq '#') {		@pitches = ('f','c','g','d','A','e','B');
		} elsif ($sign eq 'b') { @pitches = ('B','e','A','d','G','c','F');
		}
	} elsif ($clef{$istave} eq 'tenor') {
		if ($sign eq '#') {		@pitches = ('f','c','g','d','A','e','B');
		} elsif ($sign eq 'b') { @pitches = ('B','e','A','d','g','c','f');
		}
	} elsif ($clef{$istave} =~ /^bass/) {
		if ($sign eq '#') {		@pitches = ('f','c','g','d','A','e','B');
		} elsif ($sign eq 'b') { @pitches = ('B','e','A','d','G','c','F');
		}
	}
	$ikey = 0;
	while (1) {
		$pitch = shift @pitches;
		printf ("%g %g %g %s\n",
		 $x,&ps_ypitch($pitch),$staveheight,$accidental);
		$x += $dx;
		$xpart{1} += $dx;
		$ikey++;
		last if $ikey >= $num;
	}
	$xpart{1} += $SpaceAfterKeySig * $staveheight;
}
sub ps_rightfoot { my $string = shift;
	die if $Midi||$Xml;
	$remember_header{rightfoot} = $string;
	return unless $string;
	# should escape brackets here
	$string =~ s/([()])/\\$1/g;
	printf "$rmar $footmar /$ItalicFont $HeaderFontSize ($string) rightshow\n";
}
sub ps_leftfoot { my $string = shift;
	die if $Midi||$Xml;
	$remember_header{leftfoot} = $string;
	return unless $string;
	$string =~ s/([()])/\\$1/g;
	printf "$lmar $footmar /$ItalicFont $HeaderFontSize ($string) leftshow\n";
}
sub ps_innerhead { my $string = shift;
	die if $Midi||$Xml;
	$remember_header{innerhead} = $string;
	return unless $string;
	$string =~ s/([()])/\\$1/g;
	if ($pagenum % 2) { printf
		"$lmar $headmar /$ItalicFont $HeaderFontSize ($string) leftshow\n";
	} else { printf
		"$rmar $headmar /$ItalicFont $HeaderFontSize ($string) rightshow\n";
	}
}
sub ps_lefthead { my $string = shift;
	die if $Midi||$Xml;
	$remember_header{lefthead} = $string;
	return unless $string;
	$string =~ s/([()])/\\$1/g;
	printf "$lmar $headmar /$ItalicFont $HeaderFontSize ($string) leftshow\n";
}
sub ps_righthead { my $string = shift;
	die if $Midi||$Xml;
	$remember_header{righthead} = $string;
	return unless $string;
	$string =~ s/([()])/\\$1/g;
	printf "$rmar $headmar /$ItalicFont $HeaderFontSize ($string) rightshow\n";
}
sub ps_pagenum { my $string = shift;
	die if $Midi||$Xml;
	$string =~ s/^\s+//;
	if (! $string) { $pagenum++;
	} elsif ($string =~ /^\d+$/)	{ $pagenum = $string + 0;
	} else { warn " line $LineNum: pagenum $string is not numeric\n"; return 0;
	}
	$remember_header{'pagenum'} = $pagenum;
	if ($pagenum % 2) {	# odd page number
		printf "$rmar $headmar /$BoldFont %g ($pagenum) rightshow\n",
		$HeaderFontSize * 1.2;
	} else {	 # even page number
		printf "$lmar $headmar /$BoldFont %g ($pagenum) leftshow\n",
		$HeaderFontSize * 1.2;
	}
}
sub ps_repeatmark { my ($isyst, $istave, $X) = @_;
	die if $Midi||$Xml;
	printf "%g %g %g repeatmark\n",
		$X, $ystave{$isyst, $istave}, $staveheight{$isyst, $istave};
}
sub ps_finish_ties { my $right = $_[$[];
	if (! $right) { $right = $rmar + $TieOverhang*$staveheight; }  # 2.8s
	return unless defined $nstaves{$isyst}; # defeat -w warning
	foreach $istave (1 .. $nstaves{$isyst}) {
		my ($x_left, $y_left, $x_right, $y_right);
		foreach $itie (1,3,5,7,9) {  # first, ties above
			foreach $thing_type ('slur','tie') {   # 2.7j
				$x_left = $x_start{$thing_type,$isyst,$istave,$itie};
				$y_left = $y_start{$thing_type,$isyst,$istave,$itie};
				if ($x_left && $y_left) {
					$y_right = $y_left;
					$x_right = $right;
					if (($x_right - $x_left) > $staveheight) {
						$x_left  += 0.75 * $BlackBlobHalfWidth*$staveheight;
						$x_right -= $TieAfterNote*$staveheight;
					}
					printf "%g %g %g %g %g 1.0 slur\n", $x_left, $y_left,
					$x_right, $y_right, $staveheight;
					delete $x_start{$thing_type,$isyst,$istave,$itie};
					delete $y_start{$thing_type,$isyst,$istave,$itie};
				}
			}
		}
		foreach $itie (2,4,6,8) {    # then, ties below
			foreach $thing_type ('slur','tie') {   # 2.7j
				$x_left = $x_start{$thing_type,$isyst,$istave,$itie};
				$y_left = $y_start{$thing_type,$isyst,$istave,$itie};
				if ($x_left && $y_left) {
					$y_right = $y_left;
					$x_right = $right;
					if (($x_right - $x_left) > $staveheight) {
						$x_left  += 0.75 * $BlackBlobHalfWidth*$staveheight;
						$x_right -= $TieAfterNote*$staveheight;
					}
					printf "%g %g %g %g %g -1.0 slur\n", $x_left, $y_left,
					$x_right, $y_right, $staveheight;
					delete $x_start{$thing_type,$isyst,$istave,$itie};
					delete $y_start{$thing_type,$isyst,$istave,$itie};
				}
			}
		}
	}
}
sub ps_ypitch { my $pitch = $_[$[];
	# returns the Y coord of the pitch (eg Eb_, c#, f~) on the current stave
	$ystave + &dypitch($pitch) * $staveheight;
}

sub ps_y_above_note { # finds the y for options above the note ...
	my ($y, $ysmb, $fc);
	$fc = ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight;
	if ($higheststemup) {
		$y = $higheststemup + ($StemLength+$OptionClearance) * $staveheight;
	} elsif ($higheststemdown) {
		$y = $higheststemdown + $fc;
	}
	$ysmb = $highestnostem + $fc;   if ($y < $ysmb) { $y = $ysmb; }
	return $y;
}
sub ps_y_below_note { # finds the y for options below the note ...
	my ($y, $ysmb, $fc);
	$fc = ($OptionClearance+$WhiteBlobHalfHeight) * $staveheight;
	if ($loweststemdown < 999) {   # magic number; was set to 1000 initially
		$y = $loweststemdown - ($StemLength+$OptionClearance) * $staveheight;
	} elsif ($loweststemup < 999) {
		$y = $loweststemup - $fc;
	} else {
		# if loweststemdown & loweststemup = 1000, lowestnostem should be set
		$y = 1000;
	}
	$ysmb = $lowestnostem - $fc;   if ($y > $ysmb) { $y = $ysmb; }
	return $y;
}


sub ps_rest { my ($currentpulse, $symbol, $X) = @_;
	# currentpulse is (dsq|smq|qua|cro|min|smb|bre)3?\.?\.?
	# symbol is rest|rest,|rest,,|rest,,,|rest'|rest''|rest'''
	my $options;
	($symbol,$options) = split(/-/, $symbol, 2);  # for rest-fermata etc

	my $dy = -0.5;  # default middle stave-line
	if      ($symbol =~ /'''$/) { $dy =  1.0;
	} elsif ($symbol =~ /''$/)  { $dy =  0.5;
	} elsif ($symbol =~ /'$/)   { $dy =  0.0;
	} elsif ($symbol =~ /,,,$/) { $dy = -2.0;
	} elsif ($symbol =~ /,,$/)  { $dy = -1.5;
	} elsif ($symbol =~ /,$/)   { $dy = -1.0;
	}
	my $Y = $ystave + $dy*$staveheight;

	if ($currentpulse =~ /^smb/) {
		$Y += 0.25 * $staveheight; $dy += 0.25;  # 4th stave-line
		printf "%g %g %g smbrest\n",     $X, $Y, $staveheight;
		if ($dy>0.2 || $dy <-1.2) {  # 2.7t
			printf "%g %g %g ledger\n",  $X, $Y, $staveheight;
		}
	} elsif ($currentpulse =~ /^min/) {
		printf "%g %g %g minimrest\n",   $X, $Y, $staveheight;
		if ($dy>0.2 || $dy <-1.2) {  # 2.7t
			printf "%g %g %g ledger\n",  $X, $Y, $staveheight;
		}
	} elsif ($currentpulse =~ /^cro/) {
		printf "%g %g %g crochetrest\n", $X, $Y, $staveheight;
	} elsif ($currentpulse =~ /^qua/) {
		printf "%g %g %g quaverrest\n",  $X, $Y, $staveheight;
	} elsif ($currentpulse =~ /^bre/) {
		printf "%g %g %g breverest\n",   $X, $Y, $staveheight;
	} elsif ($currentpulse =~ /^dsq/) {
		printf "%g %g %g demisemiquaverrest\n", $X, $Y, $staveheight;
	} else {
		printf "%g %g %g semiquaverrest\n", $X, $Y, $staveheight;
	}
	# print the dot, if any
	if ($currentpulse =~ /\.\.$/) {
		my $x_plus  = $X + $DotRightOfNote * $staveheight; 
		# should only raise dot if note on line ...
		my $y_minus = $Y + $DotAboveNote * $staveheight; 
		printf ("%g %g %g doubledot\n", $x_plus, $y_minus, $staveheight);
	} elsif ($currentpulse =~ /\.$/) {
		my $x_plus  = $X + $DotRightOfNote * $staveheight; 
		# should only raise dot if note on line ...
		my $y_minus = $Y + $DotAboveNote * $staveheight; 
		printf ("%g %g %g dot\n", $x_plus, $y_minus, $staveheight);
	}
	if ($options) {
		&ps_note_options($X,&ps_y_below_note(),&ps_y_above_note(),$options);
	}
}
sub ps_blank { my ($currentpulse, $symbol, $X) = @_;
	my $options;
	($symbol,$options) = split(/-/, $symbol, 2);  # for blank-fermata etc
	if ($options) {
		&ps_note_options($X,&ps_y_below_note(),&ps_y_above_note(),$options);
	}
}

sub ps_ledger_lines { my ($X, $dy) = @_;
	# draws ledger lines if $dy > 0.2 above top of stave, or <-1.2 below top
	if (! defined $X) { print "% BUG: ps_ledger_lines: \$X undef\n"; return; }
	if (! defined $dy) {print "% BUG: ps_ledger_lines \$dy undef\n"; return; }
	my $yl;  # the height of the ledger line, rather than the note
	my $Y;   # the absolute height of the ledger line on the page
	if ($dy > 0.2) {	# ledger line(s) above stave
		$yl = 0.25;
		while (1) {
			$Y = $ystave + $staveheight * $yl;
			printf "%g %g %g ledger\n", $X, $Y, $staveheight;
			$yl += 0.25;
			last if $yl > ($dy + 0.1);
		}
	} elsif ($dy < -1.2) {	# ledger line(s) below stave
		$yl = -1.25;
		while (1) {
			$Y = $ystave + $staveheight * $yl;
			printf "%g %g %g ledger\n", $X, $Y, $staveheight;
			$yl -= 0.25;
			last if $yl < ($dy - 0.1);
		}
	}
}

sub ps_best_fit_gradient { my ($x_ref, $y_ref) = @_;
	my ($sigma_x, $sigma_y, $sigma_xy, $sigma_xsquared);
	my $i = $[; my $n = scalar @{$x_ref};
	foreach my $x (@{$x_ref}) {
		my $y = $y_ref->[$i];
		$sigma_x  += $x;    $sigma_y  += $y;
		$sigma_xy += $x*$y; $sigma_xsquared += $x*$x;
		$i++;
	}
	my $denominator = $n*$sigma_xsquared-$sigma_x*$sigma_x;
	if (abs $denominator < $eps) { $denominator = $eps; }
	return ($n*$sigma_xy-$sigma_x*$sigma_y)/$denominator;
}

__END__
%%Creator: muscript version $Version
%%EndComments
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This music was typeset by muscript version $Version. Muscript was written %
% by Peter Billam, and is available from http://www.pjb.com.au/muscript %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%%BeginProlog
%%BeginResource: procset muscript
/blackblob {	% usage: x y staveheight blackblob
	gsave 3 1 roll translate
	dup $BlackBlobHalfWidth mul exch $BlackBlobHalfHeight mul scale newpath
	0 0 1 0 360 arc fill grestore
} bind def

/whiteblob {	% usage: x y staveheight whiteblob
	gsave 3 1 roll translate 0.14 setlinewidth
	dup $WhiteBlobHalfWidth mul exch $WhiteBlobHalfHeight mul scale newpath
	0 0 1 280 30 arc fill  0 0 1 100 210 arc fill
	0 0 1 0 360 arc stroke  grestore
} bind def

/breve {   % usage: x y staveheight breve
	gsave 3 1 roll translate $WhiteBlobHalfWidth mul dup scale newpath
	0.1 setlinewidth  -1.2 -1 moveto -1.2 1 lineto  1.2 -1 moveto
	1.2 1 lineto stroke newpath 0.3 setlinewidth
	-1.2 -0.4 moveto 1.2 -0.4 lineto -1.2 0.4 moveto 1.2 0.4 lineto
	stroke  grestore
} bind def

/dot {	% usage: x y staveheight dot
	gsave 3 1 roll translate dup scale newpath
	0 0 0.04 0 360 arc fill grestore
} bind def

/doubledot {	% usage: x y staveheight doubledot
	gsave 3 1 roll translate dup scale newpath
	0 0 0.04 0 360 arc fill newpath 0.2 0 0.04 0 360 arc fill grestore
} bind def

/stave {	% usage: x_left x_right y_topline staveheight stave
	/staveheight exch def /first exch def /x_right exch def /x_left exch def
	/second first staveheight 0.25 mul sub def
	/third  first staveheight 0.5  mul sub def
	/fourth first staveheight 0.75 mul sub def
	/fifth  first staveheight sub def
	.015 staveheight mul setlinewidth newpath
	x_left first  moveto x_right first  lineto 
	x_left second moveto x_right second lineto
	x_left third  moveto x_right third  lineto
	x_left fourth moveto x_right fourth lineto
	x_left fifth  moveto x_right fifth  lineto stroke
} bind def

/ledger {	% usage: x y staveheight ledger
	/staveheight exch def /y exch def /x exch def
	/x_left x staveheight 0.28 mul sub def
	/x_right x staveheight 0.28 mul add def
	.015 staveheight mul setlinewidth
	newpath x_left y moveto x_right y lineto stroke % grestore
} bind def

/barline {	% usage: x y_top y_bot staveheight barline
	0.02 mul setlinewidth /y_bot exch def /y_top exch def /x exch def
	newpath x y_bot moveto x y_top lineto stroke
} bind def

/notestem {	% usage: x y_top y_bot staveheight notestem
	0.02 mul setlinewidth /y_bot exch def /y_top exch def /x exch def
	newpath x y_bot moveto x y_top lineto stroke
} bind def

/quaverstemup { % usage: x y_top y_bot staveheight quaverstemup
	/staveheight exch def /y_bot exch def /y_top exch def /x exch def
	staveheight 0.02 mul setlinewidth
	newpath x y_bot moveto x y_top lineto stroke
	gsave x y_top translate staveheight dup 0.85 mul scale
	quavertail grestore
} bind def

/quaverstemdown { % usage: x y_top y_bot staveheight quaverstemdown
	/staveheight exch def /y_bot exch def /y_top exch def /x exch def
	staveheight 0.02 mul setlinewidth
	newpath x y_bot moveto x y_top lineto stroke
	gsave x y_bot translate staveheight 1.2 mul -0.8 staveheight mul scale
	quavertail grestore
} bind def

/quavertail {
	newpath 0 0 moveto 0	 -0.10 0	 -0.14 0.17 -0.33 curveto
	0.27 -0.40 0.25 -0.70 0.15 -0.80 curveto
	0.23 -0.70 0.24 -0.38 0	 -0.28 curveto closepath fill
} bind def

/beam { % usage: x_mid_left y_mid_left x_mid_right y_mid_right staveheight beam
	/staveheight exch def /y_mid_right exch def /x_mid_right exch def
	/y_mid_left exch def /x_mid_left exch def
	/halfbeamwidth staveheight $BeamWidth mul 0.5 mul def
	newpath
	x_mid_left  y