summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
authorAkira Kakuto <kakuto@fuk.kindai.ac.jp>2022-03-07 21:25:07 +0000
committerAkira Kakuto <kakuto@fuk.kindai.ac.jp>2022-03-07 21:25:07 +0000
commitc65f64773377dd048b7caf1109018f922736db93 (patch)
treeb7a1bf82d80f0774b3e7cf4b47150261126ba6bb /Build
parent2637d7b411708629b7d8e69753bc94cb77f7e5c3 (diff)
pmx-2.9.8a
git-svn-id: svn://tug.org/texlive/trunk@62494 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
-rw-r--r--Build/source/utils/README2
-rw-r--r--Build/source/utils/pmx/ChangeLog4
-rw-r--r--Build/source/utils/pmx/TLpatches/ChangeLog4
-rw-r--r--Build/source/utils/pmx/TLpatches/TL-Changes6
-rwxr-xr-xBuild/source/utils/pmx/configure20
-rw-r--r--Build/source/utils/pmx/pmx-src/ChangeLog8
-rw-r--r--Build/source/utils/pmx/pmx-src/Makefile.am6
-rw-r--r--Build/source/utils/pmx/pmx-src/Makefile.f2c4
-rwxr-xr-xBuild/source/utils/pmx/pmx-src/pmx.test13
-rw-r--r--Build/source/utils/pmx/pmx-src/pmx298.for (renamed from Build/source/utils/pmx/pmx-src/pmx294.for)52164
-rw-r--r--Build/source/utils/pmx/pmx-src/pmxab.c53829
-rw-r--r--Build/source/utils/pmx/pmx-src/scor2prt.c3080
-rw-r--r--Build/source/utils/pmx/pmx-src/scor2prt.for3263
-rw-r--r--Build/source/utils/pmx/pmx-src/tests/barsant.midbin3071 -> 3071 bytes
-rw-r--r--Build/source/utils/pmx/pmx-src/tests/barsant.pml3
-rw-r--r--Build/source/utils/pmx/pmx-src/version.ac2
-rw-r--r--Build/source/utils/pmx/version.ac2
17 files changed, 56361 insertions, 56049 deletions
diff --git a/Build/source/utils/README b/Build/source/utils/README
index 0709aa39b6b..eb426bbb75e 100644
--- a/Build/source/utils/README
+++ b/Build/source/utils/README
@@ -23,7 +23,7 @@ lacheck - maintained here, by us
m-tx 0.63a - checked 29apr18
https://ctan.org/pkg/m-tx/
-pmx 2.9.4a - checked 30jan21
+pmx 2.9.8a - checked 08mar22
https://ctan.org/pkg/pmx/
ps2eps 1.70 - checked 03jul21
diff --git a/Build/source/utils/pmx/ChangeLog b/Build/source/utils/pmx/ChangeLog
index 56c1eb40559..03ac406bb11 100644
--- a/Build/source/utils/pmx/ChangeLog
+++ b/Build/source/utils/pmx/ChangeLog
@@ -1,3 +1,7 @@
+2022-03-08 Akira Kakuto <kakuto@jcom.zaq.ne.jp>
+
+ * Import pmx 2.9.8a.
+
2021-01-30 Akira Kakuto <kakuto@w32tex.org>
* Import pmx 2.9.4a.
diff --git a/Build/source/utils/pmx/TLpatches/ChangeLog b/Build/source/utils/pmx/TLpatches/ChangeLog
index 6fa8be3a67b..72e3b9cfbaa 100644
--- a/Build/source/utils/pmx/TLpatches/ChangeLog
+++ b/Build/source/utils/pmx/TLpatches/ChangeLog
@@ -1,3 +1,7 @@
+2022-03-08 Akira Kakuto <kakuto@jcom.zaq.ne.jp>
+
+ * import pmx-2.9.8a.
+
2021-01-30 Akira Kakuto <kakuto@w32tex.org>
* import pmx-2.9.4a.
diff --git a/Build/source/utils/pmx/TLpatches/TL-Changes b/Build/source/utils/pmx/TLpatches/TL-Changes
index 713f61b08c5..f2b919d0748 100644
--- a/Build/source/utils/pmx/TLpatches/TL-Changes
+++ b/Build/source/utils/pmx/TLpatches/TL-Changes
@@ -1,6 +1,6 @@
-Changes applied to the pmx-2.9.4a tree as obtained from:
+Changes applied to the pmx-2.9.8a tree as obtained from:
http://www.ctan.org/tex-archive/support/pmx/
Remove:
- Makefile.in aclocal.m4 arith.h configure depcomp install-sh
- missing test-driver
+ Makefile.in aclocal.m4 arith.h compile configure depcomp
+ install-sh missing test-driver
diff --git a/Build/source/utils/pmx/configure b/Build/source/utils/pmx/configure
index 14f8c50dd38..c6d553bd836 100755
--- a/Build/source/utils/pmx/configure
+++ b/Build/source/utils/pmx/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.71 for pmx (TeX Live) 2.9.4a.
+# Generated by GNU Autoconf 2.71 for pmx (TeX Live) 2.9.8a.
#
# Report bugs to <tex-k@tug.org>.
#
@@ -611,8 +611,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='pmx (TeX Live)'
PACKAGE_TARNAME='pmx--tex-live-'
-PACKAGE_VERSION='2.9.4a'
-PACKAGE_STRING='pmx (TeX Live) 2.9.4a'
+PACKAGE_VERSION='2.9.8a'
+PACKAGE_STRING='pmx (TeX Live) 2.9.8a'
PACKAGE_BUGREPORT='tex-k@tug.org'
PACKAGE_URL=''
@@ -1313,7 +1313,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures pmx (TeX Live) 2.9.4a to adapt to many kinds of systems.
+\`configure' configures pmx (TeX Live) 2.9.8a to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1380,7 +1380,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of pmx (TeX Live) 2.9.4a:";;
+ short | recursive ) echo "Configuration of pmx (TeX Live) 2.9.8a:";;
esac
cat <<\_ACEOF
@@ -1477,7 +1477,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-pmx (TeX Live) configure 2.9.4a
+pmx (TeX Live) configure 2.9.8a
generated by GNU Autoconf 2.71
Copyright (C) 2021 Free Software Foundation, Inc.
@@ -1865,7 +1865,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by pmx (TeX Live) $as_me 2.9.4a, which was
+It was created by pmx (TeX Live) $as_me 2.9.8a, which was
generated by GNU Autoconf 2.71. Invocation command line was
$ $0$ac_configure_args_raw
@@ -4408,7 +4408,7 @@ fi
# Define the identity of the package.
PACKAGE='pmx--tex-live-'
- VERSION='2.9.4a'
+ VERSION='2.9.8a'
printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h
@@ -6464,7 +6464,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by pmx (TeX Live) $as_me 2.9.4a, which was
+This file was extended by pmx (TeX Live) $as_me 2.9.8a, which was
generated by GNU Autoconf 2.71. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6523,7 +6523,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
-pmx (TeX Live) config.status 2.9.4a
+pmx (TeX Live) config.status 2.9.8a
configured by $0, generated by GNU Autoconf 2.71,
with options \\"\$ac_cs_config\\"
diff --git a/Build/source/utils/pmx/pmx-src/ChangeLog b/Build/source/utils/pmx/pmx-src/ChangeLog
index 3453c44fc50..e5389c77f5c 100644
--- a/Build/source/utils/pmx/pmx-src/ChangeLog
+++ b/Build/source/utils/pmx/pmx-src/ChangeLog
@@ -1,3 +1,11 @@
+2.98
+ Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...)
+2.97
+ Fix problem with beaming after new movement command
+2.96 and 2.95
+ replace and '\','/'. and '"' with chax();
+ eliminate do loops with shared last line
+ delete superfluous comments in source
2.94
Allow moving dots on main and chord note in 2-note termolos
Add definitions of \hbp and \hbpp to pmx.tex
diff --git a/Build/source/utils/pmx/pmx-src/Makefile.am b/Build/source/utils/pmx/pmx-src/Makefile.am
index 8d03490b750..b9e781a1b93 100644
--- a/Build/source/utils/pmx/pmx-src/Makefile.am
+++ b/Build/source/utils/pmx/pmx-src/Makefile.am
@@ -2,7 +2,9 @@
## You may freely use, modify and/or distribute this file.
##
-INCLUDES = -I$(srcdir)/libf2c
+AUTOMAKE_OPTIONS = subdir-objects
+
+AM_CPPFLAGS = -I$(srcdir)/libf2c
bin_PROGRAMS = pmxab scor2prt
@@ -236,7 +238,7 @@ PATCHES = libf2c/patch-01-binary libf2c/patch-03-DOS-line-endings \
## pmx.test
EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \
tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx
-EXTRA_DIST += scor2prt.for pmx294.for
+EXTRA_DIST += scor2prt.for pmx298.for
EXTRA_DIST += $(PATCHES)
EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c
EXTRA_DIST += pmx.tex
diff --git a/Build/source/utils/pmx/pmx-src/Makefile.f2c b/Build/source/utils/pmx/pmx-src/Makefile.f2c
index 3020abf71a4..f90a009171e 100644
--- a/Build/source/utils/pmx/pmx-src/Makefile.f2c
+++ b/Build/source/utils/pmx/pmx-src/Makefile.f2c
@@ -1,7 +1,7 @@
all: pmxab.c scor2prt.c
-pmxab.c: pmx294.for
- f2c -g -\!bs < pmx294.for > pmxab.c
+pmxab.c: pmx298.for
+ f2c -g -\!bs < pmx298.for > pmxab.c
scor2prt.c: scor2prt.for
f2c -g -\!bs < scor2prt.for > scor2prt.c
diff --git a/Build/source/utils/pmx/pmx-src/pmx.test b/Build/source/utils/pmx/pmx-src/pmx.test
index 4055a6e47ed..adba6cfab89 100755
--- a/Build/source/utils/pmx/pmx-src/pmx.test
+++ b/Build/source/utils/pmx/pmx-src/pmx.test
@@ -1,11 +1,20 @@
#! /bin/sh
-# Copyright (C) 2012 Peter Breitenlohner <tex-live@tug.org>
+# Copyright (C) 2021 Bob Tennent <rdt@cs.queensu.ca>
# You may freely use, modify and/or distribute this file.
rm -f barsant* pmxaerr.dat
+if test -r "$srcdir/tests/barsant.pmx"; then
+ : # standalone pmx
+elif test -r "$srcdir/pmx-src/tests/barsant.pmx"; then
+ srcdir=$srcdir/pmx-src # in TL
+else
+ echo "$0: cannot find tests/barsant.pmx" >&2
+ exit 1
+fi
-cp $test_src/barsant.pmx .
+
+cp "$test_src/barsant.pmx" . || exit 1
failed=
diff --git a/Build/source/utils/pmx/pmx-src/pmx294.for b/Build/source/utils/pmx/pmx-src/pmx298.for
index 73537dcc8a9..dfa03633d2a 100644
--- a/Build/source/utils/pmx/pmx-src/pmx294.for
+++ b/Build/source/utils/pmx/pmx-src/pmx298.for
@@ -1,26085 +1,26079 @@
- program pmxab
-c
-c This program, PMX, developed by Don Simons
-c (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with
-c MusiXTeX and TeX, its purpose is to allow the user to create high-quality
-c typeset musical scores by including a sequence of PMX commands in an ASCII
-c input file.
-c
-c This program is free software: you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation, either version 3 of the License, or
-c (at your option) any later version.
-c
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-c GNU General Public License for more details.
-c
-c You should have received a copy of the GNU General Public License
-c along with this program. If not, see <http://www.gnu.org/licenses/>.
-c
-c
- character*9 date
- character*5 version,versionc
- common /comver/ versionc
-c
-c To compile with gfortran:
-c 1. Merge all files using copy *.for epmx[nnnn].for
-c 2. Search and replace all character*65536 with character*131072
-c 3. Comment/uncomment getarg lines
-c 4. gfortran -O pmx[nnnn].for -o pmxab.exe
-c
-c To do
-c Correct Rainer's email address in manual
-c Linesplit (\\) in h
-c Tt at start of a movement.
-c Toggle midi on or off; allow midi only.
-c Page number printed on 1st page even if 1 system.
-c Still need inserted space for chordal accidentals
-c Voicewise transposition.
-c better segno
-c coda
-c duevolte
-c Fix xtup bracket direction in 2-line staves?? (maybe leave as is)
-c Sticky ornaments with shifts.
-c Deal with Werner's vertical spacing thing associated with title.
-c Multiple ties in midi
-c Werner's missing c in MIDI due to start/stop ties on same note.
-c Beams with single 64ths
-c 128ths and/or dotted 64ths
-c Close out MIDI with integral # of beats?
-c Increase ast dimensions or redo logic.
-c Does slur direction get set for user-defined single-note stem dir'ns?
-c Transpose by sections.
-c Optimization loop over sections only
-c Command-line option to read nbarss in. Write out nbarss when optimizing.
-c (or just read from .plg?)
-c Beams over bar lines.
-c 2-digit figures
-c A real coule (slanted line between notes in a chord)
-c Dotted slurs for grace notes.
-c Undotted chord notes with dotted main note.
-c Forced line break without line number
-c Fix dot moving when 2nds in chord get flipped
-c To do: increase length on notexq in dodyn
-c 2.94
-c Allow moving dots on main and chord note in 2-note termolos
-c Add definitions of \hbp and \hbpp to pmx.tex
-c 2.91
-c Tweak: insert \stdstemfalse before every user-shortened or lengthened stem.
-c This cancels defaul extensions to middle line and also (with 'L') allows
-c stems that are longer than 4.66 but still don't reach middle line.
-c Allow alteration of number height in multibar rest, option n.
-c Fix bug introduced in 2.89 so that the "o" in "mo800" is now OK.
-c 2.90
-c Many tweaks to allow gaps at end or middle of a system using
-c L[n]S[x] and LC[y]. New pmx.tex.
-c 2.88
-c Comment out print*,"Changed pathname to..." since it was going
-c iteration when optimizing linebreaks with the undocumented option Ao.
-c Add nv back in as argument for getmidi, so loop transferring data
-c from midivel to midvelc can be executed. This corrects bug and
-c allows per-instrument change in midi velocities at the start
-c of any block
-c Add subroutine inst2chan to transfer midi data as noted above. Works with
-c Iv but buggy when used with IT and Ib
-c 2.87
-c Allow changes to and from octave treble clef. Instrument with it
-c must only have one staff.
-c Some fixes for beam multiplicity changes at staff jumps. Must still
-c use inline for mult. increase at downward staff jump. See sjb.pmx.
-c 2.84
-c Bug fix: dots in chordal seconds
-c Bug fix: Initialize ihornb for non-beamed, down xtup
-c Bug fix: When using "AT" with 2-note x3c rD.
-c 2.83
-c Fix problems when changing to or from octave treble clef.
-c Fix beaming (or not) and number location for xtups with
-c multiple rests. Still some problems with number height but
-c can be band-aided with number height tweak option.
-c Tweak error messages for options on "R" command.
-c Allow forced beam height and slope tweaks with 2-note tremolos
-c Allow chordal note with 2-note tremolos, adding dots as needed.
-c Fix call to ncmid in beamstrt when setting start height for beam of
-c 2-note trem, by changing arg from ivx to iv
-c 2.82
-c bugfix: beams with rests, not confused with xtups.
-c x option after slur index to allow slurs to go from one voice to another.
-c x option also for ties
-c 2.81
-c Allow string of rests to end xtup
-c in chordal half-note 2-note tremolo, make chord notes open.
-c 2.80
-c Add 2-note tremolos
-c 2.78
-c Expand bufq to 131072 bytes
-c Expand maxblks tp 9600
-c Allow up to 75 pages
-c Index postscript hairpins from 1 up instead of by voice #.
-c Add option 'o' to forced beam for open notehead (\hb); set ipl(3)
-c Add option T[n], n=1,2,3 for single stem tremolo
-c 2.77
-c Enable AV+/-x+/-y to add vskip bigh before or after \eject
-c 2.76
-c 2.75
-c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and
-c 2 or 3 flags on shortened note.
-c 2.74
-c Bugfix: allow "0" as argument of @ command on lyrics string.
-c Check for and allow "\ in centered page headings with P command.
-c Check for and allow "\ in text dynamics with D command.
-c For lyrics string starting in xtuplet, insert check for inputting musixlyr.
-c For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam
-c starts with a blank rest, put '\sk' into the TeX.
-c To enable high-to-both beamed etup staff-crossing chord, for blank
-c rest at start of forced beam, shift \sk's from before to after \ib..;
-c so \ib is at start and note in upper voice has a beam to connect to.
-c Expand range of vertical xtup number shift, now stored in mult(16-22)
-c Check for and allow \" within lyrics strings, for umlauts.
-c 2.73 (160121)
-c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as
-c inline TeX. Replace all '~' inside "..." and not preceded with '\', by
-c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\
-c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ",
-c add (as type 2 string) '\\input musixlyr \'
-c After inputting pathname, change any '\' to '/', for Linux compatibility.
-c 2.72 (160110)
-c Really finalize \mbrest...go back to 3 args to deal with clef changes.
-c Fine tune centered whole bar rests to deal with clef changes
-c Fix bug in wsclef when >1 staff per instrument, since \setclef
-c needs to know instrument and specify clefs on all staves for that
-c instrument. Ones that were not changed by user will not be printed,
-c and will be kept the same as before.
-c Fix bug with arpegii from one voice to another in same staff.
-c 2.71 (151226)
-c Finalize mbrest mods
-c 2.705
-c Fix error message
-c 2.704 (140614)
-c Octave treble clef
-c Make horizontal ornament shift (ornhshft) floating
-c 2.703 (140323)
-c Option v[-]n at end of any figure will alter figdrop for rest of system
-c 2.702
-c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v"
-c 2.701
-c oC = coda (\code{10})
-c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote)
-c oG = new seqno
-c To do: fix grace note spacing problem (partially done)
-c 2.622
-c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes
-c Kn[+/-...] \ignorenats at signature changes
-c Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs
-c before checking and setting pitch levels levson() and levsoff()
-c Define midisig separately from isig. Put in common commidisig.
-c Use for explicit midi signature and for accid corrections to midi piches
-c in addmidi.
-c 2.621
-c Make keyboard rest option work in xtuplets. Created subroutine
-c chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd.
-c 2.620
-c Allow user-defined rest height tweaks at start of beam.
-c 2.619
-c At movement break, change \nbinstruments in \newmovement macro; add
-c 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for
-c to remove call to newnoi and change call to \newmovement
-c 2.618
-c Add option Ac[l,4] to set vert and horiz size and offsets to properly
-c center page for letter or a4 paper.
-c 2.617
-c In g1etnote, change if-check for note to use index(...) instead
-c of ichar(charq) since it was messing up gfortran optimizer
-c After pmxa, search for and remove penultimate line <blank><blank>/
-c because it was screwing up linux-compiled versions
-c Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...)
-c 2.616 (111110)
-c Allow hairpins to span multiple notes groups (gulps).
-c 2.615+ (110810)
-c Fix midi when some instruments are transposed, by subtracting
-c iTransAmt(instno(iv)) from pitch values sent to via addmidi in
-c make2bar.for (for main notes) and docrd (for chord notes)
-c 2.615 (110725)
-c Fig bug with size-setting (in topfile) when instrument has >1 staves
-c 2.615 (110724)
-c Make AS[0|-|s|t]... really set sizes
-c 2.614
-c Mod notex.for to fix Terry's bug with raised dotted rests (caused
-c by double-hboxing).
-c 2.613
-c Bugfix: In pmxa, change "do while" limit to keep from overwriting instno.
-c 2.612
-c Enhance AS to allow s or t for smallsize or tinysize
-c 2.611
-c Error trap for "D" before any notes in a block.
-c 2.610
-c Instrument-wise key changes and transposition (incomplete)
-c 2.603
-c 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors
-c following reading in an include file.
-c 101121 Added some error messages in g1etset.for setup data
-c 2.602
-c Correct slur indexing in linebreakslurs.
-c Account for comment lines in line count for error messages
-c 2.601
-c Bug fix: allow 24 slurs with graces
-c 2.60 Changes made make it really big
-c increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o
-c major reprogramming, and 16 may also be a problem (icmm)
-c nm=24 (voices) done
-c 24 slurs done
-c 24 simultaneous beams (Replace index 24 by 0, so get 0-23)
-c bufq*131072 (gfortran only)
-c getarg syntax (gfortran only)
-c 2.523+
-c Fix voice numbering for normal dynamics and text dynamics
-c 2.523
-c Version of bigpmx first posted to Hiroaki's web site.
-c 2.522
-c 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it.
-c With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices.
-c 5/13/10 Fix log2 function
-c 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length.
-c 2.521+
-c 091025 Enable dotting 2nd part of linebreak slur or tie.
-c To adjust barno height due to linebreak slur, use \bnrs instead of
-c explicitly redefining \raisebarno (pmxb)
-c 2.521
-c Bugfix
-c 2.520
-c 090519 Enable ligfonts (special figured bass characters)
-c 2.519
-c Fix another bug which kept \sk from being output so misaligned some notes.
-c 2.518
-c Fix bugs: referencing fig data, char declaration for member of
-c common/comfig/
-c 2.517
-c Allow figures in voice 1 + any one other.
-c 2.516
-c Allow figures in voice #2
-c 2.515+ to do: Change manual and activate rule against clef change in voice #2.
-c 2.515
-c 071222 Changes in getnote to allow auto forced beams to start anywhere.
-c 071206 In make2bar, shift fermataup7 to left over centered pause.
-c 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line
-c staff (it was screwing up vertical justification).
-c n34 for tweaks to midi durations of quarter note septuplets.
-c To do: In ref250.tex, the tables where 's,t,)' is explained, the line
-c [+,- i] ... Vertical adjustment of the start of second segment
-c should it be replaced by
-c [s +,- i] ... Vertical adjustment of the start of second segment
-c 2.514
-c Changes in make2bar to get horizontal spacing right when normal grace
-c follows after grace
-c Changes in dograce to get octaves right for any material entered inside
-c \gaft, which shields transpose register changes from the outside world.
-c 2.513
-c In make1bar, near end, for forced beams starting with a rest, copy hgt and
-c slope tweaks to ALL notes after first, not just the second one, so if
-c there's more than one rest at start the tweaks are still observed.
-c In beamid and beamend, add stand-alone triply-flagged notes for xtups.
-c 2.512
-c Near end of pmxb, fix error trap to allow redundant 'RD'
-c Enable multiplicity down-up '][' within xtup.
-c 2.511
-c Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by
-c adjusteskz as in bar 7 of barsant.
-c 2.510a
-c Test: remove restriction on tempo changes in MIDI macros
-c Send to CM for beta testing.
-c 2.509+
-c To do: Correct manual on AS. "-" is for smaller staves.
-c 2.510
-c Forgot to declare litq, voltxtq as character in subroutine getgrace
-c 2.509
-c Corrected small bug in arpeggio shifting (ivx <= iv in call putarp)
-c 2.508
-c Allow graces in xtups. New subroutine getgrace.
-c 2.507
-c To do: Raise/lower figures.
-c To do: Add 24, 29 to list of musicsizes in manual
-c New sub adjusteskz to account for ask's when computing lengths of
-c brackets for unbeamed xtups, slopes and horizontal posn's of number
-c Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags
-c Add look-left option for keyboard rests, "L" in rest command, set iornq(30)
-c 2.506
-c Fix bug with AK, when simultaneous rests have same duration, use defaults.
-c 2.505
-c Keyboard rests AK
-c 2.504
-c Space after normal grace: option X[n]
-c Fixed og when nv .ne. noinst, by using sepsymq instead of '&'
-c (To do) length of xtup bracket when there is added non-collision space.
-c Trap musicsize if .ne. 16,20,24,29.
-c 2.503
-c Enable arpeggio left shift with ?-x
-c To do: In manual, arpeggio over 2 staves.
-c Allow musicsize of 24 and 29. Had to define meter font size explicitly,
-c also change font size for text dynamics, but not much else so far.
-c Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn
-c was called, causing error in printing replacement number.
-c 2.502
-c Incorporate Dirk Laurie's patch to use { , } , for ties.
-c Figure height adjustment: append +[n]
-c Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?)
-c 2.501
-c Readjust horizontal offset back to .8 in LineBreakTies
-c Fix zero-subscript (iudorn) in putorn
-c 2.50
-c Increase number of text-dynamics (dimension of txtdynq) per block
-c from 12 to 41.
-c Slur option n to override altered default curvature.
-c Allow default ps slur curvature tweaks with Ap+/-c
-c 2.416
-c Increase length of textdynq from 24 to 128
-c (Todo) Add comment in manual about blank lines at end.
-c Configuration file: Define subroutine getpmxmod, check path in environment
-c variable pmxmoddir, check existence, read lines into bufq after setup.
-c Increase dimension on idynn in dodyn from 4 to 10 for max number
-c of marks in a bar
-c Increase allowable # of lines from 2000 to 4000.
-c (To do) Replace definition of \liftpausc per Olivier.
-c (To do) Fix extraneous error message if RD is placed at very end.
-c 2.415
-c Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt
-c instead of redefining \xnum. Change font used to \smallfont (as for
-c normal xtups,
-c Allow slur to start on rest.
-c 2.414
-c Correct bug in crdacc when adding accidental to boundary causes number of
-c segments to decrease
-c Special rule for 3-accidental chords: If no 2nds, place them in order
-c top, bottom, middle.
-c 2.413
-c Correct bugs in chordal accidentals, related to left-shifted noteheads
-c (a) Special problems with downstem when main note needs shifting
-c (b) Assign 0 rank to boundary segs due to left-shifted noteheads
-c 2.412
-c Change default horiz shift of start of seg 2 of linebreak slurs:
-c -.7 for slurs, -1.2 for ties,
-c Use height of start of seg 1 slur itself for end of 1 and start of 2.
-c 2.411
-c "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2.
-c "s" option in start of slur/tie as precursor to vert/horiz tweaks for end
-c of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2.
-c With "Apl", curvature adjustments on starting slur command apply to seg 1,
-c those on ending command to seg 2.
-c 2.410
-c "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine
-c \xnum, \unbkt, \ovbkt.
-c "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is
-c flag, mult(5-9) is tweak value+16
-c 2.409
-c Bugfix in docrd for MIDI: Use original pitch in case main/chord were
-c switched due to 2nds.
-c Remove "o" from error message for "A" command.
-c New syntax: optional instrument number separator ":" in movement
-c break command to precede a 2-digit instrument.
-c Conditional output formats for \setname at movement break to allow
-c instrument numbers >9.
-c Bugfix in coding to raise barno due to slur over line break (pmxb)
-c Move date/version data statement in pmxab to a better place.
-c 2.408
-c Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar).
-c Bug fix in \liftPAusep in notex.for and in pmx.tex
-c Character variables for version and date
-c For up-stem single graces slurred to down-stem, shift slur start left by
-c 0.8 so slur doesn't get too short.
-c Initialize and slide mult, same as other full-program variables in /all/.
-c 2.407
-c Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n,
-c 2.406
-c Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing
-c equalization).
-c Put dimensions of double sharps and flats in crdacc (for chords).
-c Bugfix: Use sepsymq in LineBreakTies(..) instead of '&'
-c Use only first 4 bits of mult for multiplicity+8, so rest can be used
-c for other stuff.
-c Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict.
-c 2.405: Not published but saved for safety.
-c Option Aph to write \special{header=psslurs.pro} top of each page, so
-c dviselec will work OK.
-c 2.404
-c Allow slur to end on rest, but not start on a rest. Efaults height
-c of ending is default height of start (before any automatic or user-
-c defined djustments). User may adjust height as normal from default.
-c 2.403
-c Bugfix: turn off repeated beaming patterns.at end of non-last voice.
-c 2.402
-c Automatic repeated forced beams. Start with "[:" End with next explicit
-c forced beam or end of input block.
-c Increase # of forced beams per line of music per input block from 20 to 40
-c 2.401
-c Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies.
-c Makes 1st part normal shape, and starts 2nd part a little further left.
-c Enable arpeggios in xtuplets. Had to make time itar(narp) a real.
-c 2.40
-c Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap.
-c Fix non-ps-slur input to \midslur (third signed integer). Do not reverse
-c sign for down-slurs.
-c 2.359
-c Add error exit subroutine stop1 to make exit status g77-compatible..
-c Absolute octave on xtup chord note was 2 octave too high, fixed in getnote
-c Fermata on vertically shifted rest: special trap in putorn() to set height.
-c Correct multiple grace note spacing for small staves (in dograce,
-c define wheadpt1 depending on staff size)
-c 2.358
-c Allow curvature corrections at start of postscript slur, in dopsslur()
-c Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust
-c Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h]
-c Make t[ID] act like s[ID]t, most mods in spsslur().
-c Add spsslur() to read in data for ps slurs, call from getnote.
-c In beamstrt, save args for SetupB in common comipb to save them for
-c 2nd call when xtup starts with rest
-c Add spacing for ornament ")" as if it were accidental, in make2bar().
-c Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur()
-c Horiz. shift start of ps grace slur, 2 places in dograce().
-c Horiz shift end of grace slur in endslur()
-c Make st slurs into postscript ties. Separate subroutine dopsslur(),
-c Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.)
-c Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn.
-c 2.357a
-c Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote
-c 2.357
-c Increase dimension for # of lit TeX strings from 52 to 83.
-c Allow blank rest in middle of xtuplet. Only mods in g*etnote().
-c 2.356
-c Increased some dimensions from 30 to 40 to allow up to 40 pages.
-c In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt().
-c Fix parsing of "f,h,H,HH" in sslur.
-c Fix bug with cdot, note-level for slur termination (in getnote)
-c 2.355
-c Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)],
-c n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues
-c Make midi recognize ps ties in doslur.
-c Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote
-c to get octave right.
-c 2.354
-c With postscript slurs, make t-slurs real ties by inserting replacement
-c macros \tieforisu, etc, defined in pmx.tex
-c Check for open cresc or decresc at end of input block, using list[de]cresc
-c Hairpin syntax conditional on postscript slurs. Backup to fill in start
-c level, using new backfill(...). Separate height tweaks for
-c start and finish.
-c 2.353
-c K-0+n to transpose by half step (rather than just change key)
-c Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of
-c \mbrest's
-c Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end
-c of input block before movement break, and at start of block after
-c movement break, using \newmovement rather than \setzalaligne, since
-c former already redefines \stoppiece. In second case, set rptfg2='z'.
-c Make clefq(nm) common between pmxb and getnote; change references in
-c getnote at 'M' to array elements, setting all new clefs as you go.
-c 2.352
-c Remove \parskip redefinition from pmx.tex; write it into TeX file when
-c "Ae" is invoked.
-c Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine
-c \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH',
-c translate them thru mapping to (1,4,5,6) as \midslur params, then let
-c \psforts translate them back to ps slur macors.
-c 2.351
-c Number slurs from 0 up instead of 11 down, anticipating postscript slurs.
-c Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size.
-c Increase length of basenameq to 44 characters everywhere.
-c Increase dimension of mcpitch (midi-chord-pitch) to 20.
-c Set default systems per page to 1 if nv>7
-c In pmxb, move place where isystpg is reset to 0, so that \eject gets
-c written when there is just one system per page.
-c 2.35
-c Cautionary accidentals with 'c' anywhere in note symbol.
-c NEW pmx.tex with \resetsize to set size to normal or small depending on
-c current \internote. Used with new coding in dograce() to get right
-c new size in case user has \setsize'ed some lines to \smallvalue. For
-c \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font.
-c Affects pmx.tex.
-c Continuation figure with fractional length. May now mix with other figures.
-c If another figure follow Cont-fig, separate with colon.
-c 2.342
-c Bugfix in getnote to recognize relative octave shift in grace at start of
-c input block.
-c In make2bar, initialize islhgt=0 earlier than before (possible solution
-c to Suse g77 compile problem that I could not reproduce)..
-c Bugfix in beamstrt & beamn1 for r2x6 c4D d d d
-c 2.341
-c Syntax check: Forced page break page number must be > than previous.
-c Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb.
-c 2.34
-c New pmx.tex with redefined liftpausc
-c Bug fix with dotted, non-beamed xtups.
-c 2.332
-c Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads.
-c Allow arbitrary pos. input to W in g1etnote and getnote.
-c 2.331
-c Bug-fix in dodyn(..): typo on length of arg of txtdyn
-c 2.33
-c Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata()
-c 2.321
-c Rescale accidental shifts. Still use 7 bits but now map (0,127)
-c onto (-1.,5.35)
-c Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups
-c 2.32 (Noticed after posting)
-c Prohibit "/" as figure.
-c 2.32 (Posted)
-c Tidied up accidentals in chords, do spacing.
-c Still to do:
-c check for "(" on chord notes in spacing algo
-c small accids
-c double accids
-c autoshift slurs
-c 2.310
-c Extra call to precrd ahead of spacing chk, and single-note crd/acc
-c shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time.
-c 2.309
-c Alternate algo for accid shifts in chords.
-c 2.308
-c Auto horiz. notehead shifting added to precrd.
-c 2.307
-c Auto shifting of multiple accidentals in chords.
-c "Ao" in main chord note to keep accidentals in order. Set nacc(28).
-c If there are any manual main or chord note shifts, then
-c If any manual shift is preceded by "A" then
-c 1. Auto-shifting proceeds
-c 2. "A"-shifts add to autoshifts
-c 3. non-"A" shifts are ignored!
-c Else (>0 man shifts, none has "A")
-c No auto-ordering, No autoshifts,
-c End if
-c End if
-c 2.306
-c Initialize legacy note level to middle C in case user forgets to set
-c octave.
-c Shift xtup note?
-c Shift in elemskips rather than noteheads?
-c 2.305
-c Stop pmxb from multiple endvolta's at start of new page.
-c 2.304
-c "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on
-c for multiple notes in the voice, "S:" last shortened note.
-c 2.303
-c vshrink stuff all OK? Description is in pmxb.
-c 2.302
-c Toggle vshrink with "Av". vshrink normally kicks in when \interstaff
-c hits 20. This still needs work.
-c Add " /" to last line if last char is not % or /.
-c 2.301
-c Check in beamn1 for single note before multiplicity down-up.
-c allow '.PMX' as well as '.pmx'
-c 2.299
-c Correct typo in pmxb involving PMXbarnotrue.
-c Replacement printed number for xtup: Unsigned integer after 'n' after 'x'
-c Minor upgrade parsing xtuplet options 'x...'
-c Correct dimension of nxtinbm in make2bar.
-c 2.298
-c Account for doubled xtup notes in subroutine getx (user-defined spaces),
-c by adding ndoub as an argument..
-c 2.297
-c Created and solved compiler problem. Put drawbm(NM) in its own common.
-c Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar
-c when \centerbar is used.
-c Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX
-c use right 2nd and 3rd args for \mbrest when key, meter, or clef changes.
-c 2.296
-c Correct printed numbers for forced beams with multiple xtups. For each beam
-c make list in setupb by voice of eloff (h-offset) and mtupv (printed #)
-c Increase lengths of jobname and infileq by 20 characters
-c Enable whole notes and breves as 1st or last note of xtup in beamn1 and
-c beamend, and wholes in beamid.
-c 2.295
-c Midi balance Ib[n1]:[n2]:...[nn]
-c Single-slope beam groups [...]-[...]
-c Trap "i" unless after accidental (main notes, xtups, chord notes)
-c 2.294
-c Unequal xtups with "D" to double a note in an xtup.
-c As above, "F" will (a) increase multiplicity by 1 for marked note and next
-c one and (b) add a dot to the first one.
-c Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on
-c when "." is encountered, then correcting beam start time.(end of getnote)
-c MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]...
-c 2.293
-c Check for single notes spanning bar lines.
-c Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup
-c must be set in make2bar since beamstrt is not called, fixing problem with
-c dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix
-c problem when >2 staves.
-c Add nodur to args of dodyn, so can check if stemless and avoid height tweak
-c Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak
-c 2.292a
-c Undo syntax check for Type 2 or 3 TeX string starting in column 1.
-c Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?!
-c 2.292
-c Allow comments in xtuplets
-c Enable multiple octave jumps in grace notes.
-c Allow dynamics in xtuplets.
-c Fix bug in getdyn searching for end of text string (correct length of lineq
-c to 128)
-c Fix bug in dodyn, must ignore horiz. interaction tweak for
-c user-text (idno = 0)
-c Syntax check for Type 2 or 3 TeX string starting in column 1
-c (NOTE: later undone!)
-c Syntax check for page number > npages at forced line break.
-c 2.291
-c Fix error in AS command (accid spacing for small systems), making only
-c one spec per staff, nv total.
-c Stop using MIDI channel 10
-c 2.29
-c Fix error in console output format for # of bytes used in MIDI file.
-c Fix bug in dograce so no space is added between grace and main note when
-c there is a MIDI-only accidental.
-c Fix bug so oes?+4 works. It was too ugly to explain.
-c ...Different ways of storing accidental specs on input and output.
-c No longer zap \writezbarno in special situations.
-c Fix bug in dyntxt level on rest
-c Line spacing equalization. Add macros \starteq, \endeq, \spread, etc.
-c Activate with Ae. (Maybe later could input alternate values for
-c \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1
-c in the page, and \endeq on 1st note of next-to-last line in page.
-c 2.28
-c Flip direction of forced beam "[f..."
-c Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30)
-c Fix bug in sliding ip's for txtdyn's
-c In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99)
-c 2.27
-c Comment out lines in dodyn checking number of dynamic marks found. Voice
-c order may not be monotonic if two lines on a staff.
-c Literal dynamic: D"[text]"
-c 2.26
-c Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn,
-c increasing dimension of idynn to 4 to allow 4 symbols on same note.
-c Increase voltxtq length from 10 to 20.
-c AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough
-c accounting for ast's is done by defining effective headwidth
-c whead1 in makebar2 to be 0.8*whead.
-c 2.25
-c Fix logic bug with sepsym's when # of instruments changes.
-c Slight increases in default offsets for hairpin starts after "p"
-c 2.24
-c Hairpins D< or D> as toggle.
-c Many automatic position tweaks for letter-group dynamics and hairpins.
-c 2.23
-c Continued rhythmic shortcuts: space followed by "." or ","
-c 2.22
-c In call to doslur, change tno(...) to tnote(...). This was only
-c used when checking to slurs per stem directions, and should have been
-c the note duration all along.
-c MIDI-only accidental, bit 17 in nacc, or 27 in icrdat.
-c Use "i" anywhere in note symbol.
-c 2.21
-c Increase from 20 to 30 dimensions for movement breaks and midi sections.
-c Fix out-of-order declarations per mutex comments
-c Add "Bad error" and "Kluging" messages to log file.
-c 2.197
-c add /comips/ to save tie-check midi variables
-c For spacing of clef changes at start of input block, changed integer time
-c lastnodur to prevtn, so it works with xtups. Possible incompatibility!
-c 2.196
-c Fix Ickbug with time check in ncmid()
-c Interchange \fermataup7 and \pausec to get proper alignment
-c Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX.
-c Add defn's of \hsp, \hspp to pmx.tex
-c Fix pre-slurs on xtup chord notes.
-c Fixed raised PAuse, define \liftPAuse
-c Replace \zbreve\sk with \breve.
-c Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what
-c about "o" and 1 as shorthand for 16???? Search for "Kluge"
-c Added "vo" (voice) as MIDI instrument 55
-c Allow 3-digit page numbers (search for "toppageno")
-c Fix bug caused by prior fix (cancelling accid after bar line was ignored).
-c Fix double accids in chords
-c 2.194
-c Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if
-c block.
-c Add meter to MIDI file with every pause
-c Purify FORTRAN?
-c 2.193
-c Increased # of in-line TeX strings from 36 to 52.
-c Fix entry of # of bytes in header of tempo/meter/key track to allow >255.
-c 2.191
-c Event track: Tempos, meters, keys all together. Data in comevent
-c 2.15
-c Pretty good midi capability. Still no attention to slurs on chord notes.
-c 2.11
-c 11 Dec 99 c rm1
-c 11 Dec 99 "oes?", "oe?"
-c 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes
-c 11 Dec 99 Error message for shifted, repeated ornaments.
-c 2.10 (Version 2.1)
-c Fix bug with lowdot and xtuplets
-c 2.09
-c Fix bug with multiple ornament heights over beams, when one is . or _
-c Error message from pmxa if rest on last note of xtup.
-c Enable 12 slurs.
-c Reinstate multiple rests at start of xtup.
-c 2.07
-c Combine consecutive type-1 TeX strings.
-c \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's.
-c Fixed breve chord notes in docrd
-c Check irest(28) as well as vxtup when setting nodur for chord notes, since
-c vxtup isn't set until 1st *main* note in xtup
-c Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing.
-c 2.06+
-c Make deterministic the beam slope calculation when there are an even # of
-c slopes in list and middle two are equal magnitude but opposite sign.
-c pmxa Trap for "o:" before 1st note in block
-c Partial bug fix for 64th notes in xtuplets.
-c Make ixrest a vector, since with new time scheme may not finish xtup in
-c same notes block.
-c Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb)
-c 2.06
-c Account for changes in nv when computing \interstaff. Add a counter
-c nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever
-c setting isysflb(iflb). Note nv can only change at a forced line break.
-c Note also, iflb starts at 0!
-c 2.05
-c Automatic start of new notes group with part 2 of staff-jump beam
-c In make1bar, set irest bit 29 of lowest-voice note at same time,
-c use as flag when making notes groups.
-c For now, remove dummy blank line at end...it zaps terminal repeats.
-c 2.02
-c Fixed slur-counting bug for multiple, slurred, aftergraces.
-c 2.01
-c Increase to ask(1400)
-c Increase max forced page breaks to 18
-c Define pausc for centered pause
-c 2.0a
-c Insert dummy blank line at very end to handle input files w/o terminal CR-LF
-c pmx03r
-c Option m[n] in S symbol to change musicsize (for parts)
-c Double dotted rests now work.
-c Write file name to log file
-c Check existence of input file
-c Allow 24-char jobname, may end with ".pmx"
-c Comment out time stuff
-c Replace 3-argument getarg with 2-argument + iargc
-c Fix bug with negative noinst due to nint<=int replacement
-c move lovation of iv in isdat1 to allow iv>7.
-c Set nm=12
-c pmx03q
-c replace int(x+.001) with nint(x)
-c Write TeX file name to screen and to pml.
-c Replace char(...) with chax(...) to sovle msdev bug.
-c Bug fix: macro terminations when M is on a line by itself.
-c Bug fix: don't accumulate space for XS in pmxa.
-c Streamline Macros: use pointers to bufq instead of scratch files
-c pmx03p
-c Store input file in single character array bufq.
-c lbuf(i)*2 is length of line i
-c ipbuf is position just before next line to be read.
-c pmx03
-c Optimize read/writes
-c pmx02
-c Fix line count (for errors) when there are saved macros
-c pmx01
-c In optimize mode, open/close macros (Watch out for residual zz files!)
-c Command line input
-c Option Ao to optimize, otherwise normal processing
-c
-ccccccc
- parameter (nks=125,nm=24,mv=24576,maxblks=9600)
- character*128 lnholdq
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /comevent/ miditime,lasttime
- logical slmon,dbltie
- common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
- * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
- * slmon(0:nm),dbltie
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
- integer*2 iinsiv
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- common /commus/ musize,whead20
- integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks)
- real*4 poe0(nks),poe(nks)
- logical isfirst,optimize
- logical*4 fexist
- character*44 jobname
- character*47 infileq
- common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
- * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
- * idum,itsofar(nm),nib(nm,15),nn(nm),
- * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
- logical rest,firstline,newmeter
- common /comdiag/ n69(0:nm),n34(0:nm)
- logical mmacrec,gottempo
- common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
- * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
- * mmacrec,gottempo
- common /truelinecount/ linewcom(20000)
-c
-c Added 130302 only to get nsperi from g1etnote, for use in midi setup
-c
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- logical lastchar,fbon,issegno,isheadr,isvolt
-c
-c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing
-c nmidsec section starts and stops based on PLAYING macros (not recording).
-c
-ccccccccccccccccccccccccc
-c
- data date /'17 Mar 20'/
- data version /'2.94'/
-c
-ccccccccccccccccccccccccc
- data maxit,ncalls /200,0/
- data isfirst /.true./
-c itstart = mytime()
- versionc = version
-c
-c Initialize midi parameters
-c
- gottempo = .false.
- ismidi = .false.
- debugmidi = .false.
- relacc = .false.
- mmacrec = .false.
- nmidsec = 1
- mgap = 10
- miditime = 0
- lasttime = 0
- nmidcrd = 0
- nusebl = 0
- notmain = .false.
- do 3 ivx = 1 , nm
- twoline(ivx) = .false.
- midinst(ivx) = 6
- midivel(ivx) = 127
- midibal(ivx) = 64
- miditran(ivx) = 0
-3 continue
- do 12 icm = 0 , nm
- imidi(icm) = 0
- restpend(icm) = .false.
- trest(icm) = 0.
- levson(icm) = 0
- levsoff(icm) = 0
- slmon(icm) = .false.
- naccbl(icm) = 0
- n69(icm) = 0
- n34(icm) = 0
- msecstrt(icm,1) = 1
-12 continue
-c
-c End of midi parameter initialization
-c
- musize = 0
- optimize = .false.
- numargs = iargc()
- if (numargs .eq. 0) then
- print*,'You could have entered a jobname on the command line,'
- print*,' but you may enter one now:'
- read(*,'(a)')jobname
- numargs = 1
- else
-c call getarg(1,jobname,idum) ! May need to replace this w/ next line
- call getarg(1,jobname)
- end if
-10 ljob = lenstr(jobname,44)
- if (ljob .gt. 44) then
- print*,'Jobname is too long. Try again.'
- call stop1()
- else if (ljob .eq. 0) then
- print*,'No was jobname entered. Try again.'
- call stop1()
- else if (numargs .eq. 2) then
- if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then
- optimize = .true.
-c call getarg(2,jobname,idum) ! May need to replace this w/ next line
- call getarg(2,jobname)
- numargs = 1
- go to 10
- else
- print*,'Illegal option on command line'
- call stop1()
- end if
- end if
-c
-c Strip ".pmx" if necessary
-c
- ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
- if (ndxpmx .gt. 0) then
- jobname = jobname(1:ndxpmx-1)
- ljob = ljob-4
- end if
-c
-c Check for existence of input file
-c
- infileq = jobname(1:ljob)//'.pmx'
- inquire(file=infileq,EXIST=fexist)
- if (.not.fexist) then
- inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist)
- if (.not.fexist) then
- print*,'Cannot find file '//infileq
- call stop1()
- else
- infileq = jobname(1:ljob)//'.PMX'
- end if
- end if
-c
-c Open a log file
-c
- open(15,file=jobname(1:ljob)//'.pml')
- call printl('This is PMX, Version '//version//', '//date)
- ljob4 = ljob
- call printl('Opening '//infileq)
- open(18,file=infileq)
-c
-c Copy input file into common buffer
-c
- ipbuf = 0
- linewcom(1) = 1
- do 8 ilbuf = 1 , maxblks
- ncomments = 0
-14 read(18,'(a)',end=9)lnholdq
- lbuf(ilbuf) = lenstr(lnholdq,128)
- if (lbuf(ilbuf) .eq. 0) then
-c
-c Blank line. Make it a single blank with length 1
-c
- lbuf(ilbuf) = 1
- lnholdq = ' '
- end if
-c
-c Now line has at least one non blank character. Check for comment
-c As of Version 260, do not copy comments into bufq
-c But need to count %'s for error messaging
-c if (lnholdq(1:1).eq.'%') go to 14
- if (lnholdq(1:1).eq.'%') then
- ncomments = ncomments+1
- go to 14
- end if
-c
-c When here, have counted all preceding comments and have a real line
-c
- if (ilbuf .gt. 1) then
- linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments
- else
- linewcom(1) = 1+ncomments
- end if
- if (ipbuf+lbuf(ilbuf).gt.131072) then
- print*,'Too many characters in file, stopping'
- call stop1()
- end if
- bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq
- ipbuf = ipbuf+lbuf(ilbuf)
-8 continue
- call printl('Too many lines in input file')
- call stop1()
-9 continue
-c
-c Insert dummy line to handle input files w/o CR-LF at end.
-c
- nlbuf = ilbuf-1
-c nlbuf = ilbuf
-c bufq(ipbuf+1:ipbuf+3) = ' / '
-c lbuf(nlbuf) = 3
- close(18)
- do 6 numit = 1 , maxit
- if (optimize) call printl('Starting an iteration')
-c
-c When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0.
-c Otherwise, nbars0 is the input
-c When islast=.false., pmxb only returns poe's, otherwise does whole job
-c
- call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize)
- if (.not.optimize) then
- if (ismidi) then
-c
-c This was moved here from writemidi 130302 to allow midivel,bal,tran, to be
-c set up here as functions of instrument rather than iv (staff).
-c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv)
-c
- nstaves = 0
- ivt = 0
- do 16 iinst = 1 , nm
- nstaves = nstaves+nsperi(iinst)
- do 17 ivtt = 1 , nsperi(iinst)
- ivt = ivt+1
- iinsiv(ivt) = iinst
-17 continue
- if (nstaves .eq. nv) go to 18
-16 continue
- print*,'Screwup!'
- call stop1()
-18 continue
-c
-c Set up channel numbers for midi.
-c
- numchan = 0
- do 11 iv = nv , 1 , -1
- if (twoline(iv)) then
- midchan(iv,2) = numchan
- numchan = numchan+1
- end if
- midchan(iv,1) = numchan
- numchan = numchan+1
-11 continue
-c
-c numchan will now be the number of channels, but max channel # is numchan-1
-c
-c Set up velocities, balances, and midi-transpositions
-c
- do 13 iv = nv , 1 , -1
- if (twoline(iv)) then
-c 130302 Make these functions of instrument rather than staff (iv)
-c midvelc(midchan(iv,2)) = midivel(iv)
-c midbc(midchan(iv,2)) = midibal(iv)
-c midtc(midchan(iv,2)) = miditran(iv)
- midvelc(midchan(iv,2)) = midivel(iinsiv(iv))
- midbc(midchan(iv,2)) = midibal(iinsiv(iv))
- midtc(midchan(iv,2)) = miditran(iinsiv(iv))
- end if
-c midvelc(midchan(iv,1)) = midivel(iv)
-c midbc(midchan(iv,1)) = midibal(iv)
-c midtc(midchan(iv,1)) = miditran(iv)
- midvelc(midchan(iv,1)) = midivel(iinsiv(iv))
- midbc(midchan(iv,1)) = midibal(iinsiv(iv))
- midtc(midchan(iv,1)) = miditran(iinsiv(iv))
-13 continue
- end if
-c
-c TEMPORARY!!!
-c
- write(15,*)'nlbuf: ',nlbuf
- ip1 = 1
- do 10000 ilb = 1 , nlbuf
-c write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb),
-c * bufq(ip1:ip1+lbuf(ilb)-1),
-c * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)),
-c * k=min(3,lbuf(ilb)),1,-1)
- ip1 = ip1+lbuf(ilb)
-10000 continue
- iplast = ip1-1
-c
-c Check to see if (1) last line is "<blank><blank>/" and (2) next to last
-c line is "/"
-c
- if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then
- if (bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.'/') then
- print*,'Removing last line of "<blank><blank>/"'
- write(15,*)'Removing last line of "<blank><blank>/"'
- nlbuf = nlbuf-1
- end if
- end if
-c
- call pmxb(.true.,poe0,ncalls,optimize)
- if (ismidi) then
-c
-c Write midi file
-c
- open(51,file=jobname(1:ljob)//'.mid')
- if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm')
- call printl(' ')
- call printl('Writing '//jobname(1:ljob)//'.mid')
- call writemidi(jobname,ljob)
- end if
- close(15)
- stop
- end if
- write(15,*)'nlbuf: ',nlbuf
- ip1 = 1
- call pmxb(.false.,poe0,ncalls,optimize)
- call poestats(nsyst,poe0,poebar0,devnorm0)
-c
-c Save initial deviation and line breaks for later comparison
-c
- if (numit .eq. 1) then
- devpmx = devnorm0
- do 20 isys = 1 , nsyst
- nbari(isys) = nbars0(isys)
-20 continue
- end if
- call sortpoe(nsyst,poe0,ipoe)
- do 1 iupord = nsyst , 1 , -1
- isysu = ipoe(iupord)
- print*,'isysu=',isysu
- write(15,*)'isysu=',isysu
-c
-c Skip if system isysu has poe0 < avg or isysd has poe0 > avg
-c
- if (poe0(isysu).lt.poebar0) go to 1
- do 5 idnord = 1 , nsyst
- isysd = ipoe(idnord)
- if (isysu.eq.isysd .or. nbars0(isysd).eq.1
- * .or. poe0(isysd).gt.poebar0) go to 5
- do 2 isyst = 1 , nsyst
- nbars(isyst) = nbars0(isyst)
- if (isyst .eq. isysu) then
- nbars(isyst) = nbars(isyst)+1
- else if (isyst .eq. isysd) then
- nbars(isyst) = nbars(isyst)-1
- end if
-2 continue
- call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize)
- call pmxb(.false.,poe,ncalls,optimize)
- call poestats(nsyst,poe,poebar,devnorm)
- if (devnorm .lt. devnorm0) then
- devnorm0 = devnorm
- poebar0 = poebar
- do 4 isys = 1 , nsyst
- nbars0(isys) = nbars(isys)
- poe0(isys) = poe(isys)
-4 continue
- print*,'Improved with iup,idown,devnorm:',
- * isysu,isysd,devnorm0
- write(15,*)'Improved with iup,idown,devnorm:',
- * isysu,isysd,devnorm0
- write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
- write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
- call sortpoe(nsyst,poe0,ipoe)
- go to 6
- end if
-5 continue
-1 continue
-c
-c If we get here, must have gone thru all switches and found nothing better,
-c so done!
-c
- go to 7
-6 continue
-7 continue
- print*,'Optimum located, numit:',numit,', ncalls:',ncalls
- write(15,*)'Optimum located, numit:',numit,', ncalls:',ncalls
- print*,'Final error:',devnorm0,', initial error:',devpmx
- write(15,*)'Final error:',devnorm0,', initial error:',devpmx
- print*,'Percentage improvement:',100.*(1-devnorm0/devpmx)
- write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx)
- call printl('Initial bars/system:')
- write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
- write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
- call printl('Final bars/system:')
- write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
- write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
- call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
- call pmxb(.true.,poe0,ncalls,optimize)
- close(15)
- end
- subroutine accsym(nacc,acsymq,lacc)
- character*3 acsymq
- iacc = iand(nacc,7)
- if (iacc .eq. 1) then
- acsymq = 'fl'
- lacc = 2
- else if (iacc .eq. 2) then
- acsymq = 'sh'
- lacc = 2
- else if (iacc .eq. 3) then
- acsymq = 'na'
- lacc = 2
- else if (iacc .eq. 5) then
- acsymq = 'dfl'
- lacc = 3
- else if (iacc .eq. 6) then
- acsymq = 'dsh'
- lacc = 3
- else
- print*,'bad accidental: ',iacc
- end if
- return
- end
- subroutine addask(taskn,waskn,elaskn,
- * fixednew,scaldold,tglp1,scfac,isudsp)
- parameter (nm=24)
- logical isudsp
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- common /comtol/ tol
- scoarg = scaldold*scfac
- if (isudsp) then
-c
-c Find which udsp we're dealing with
-c
- do 1 iudsp = 1 , nudsp
- if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2
-1 continue
- print*,'You should note BEEE here in addask!'
- call stop1()
-2 continue
-c
-c Fixednew and scaldold must not be changed, since udsp's are already included
-c in fsyst from pmxa, and udsp don't involve scaled space..
-c
- if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c Must add user-defined space to what's there already.
-c
- wask(naskb) = wask(naskb)+udsp(iudsp)
- else
-c
-c This place has no other space.
-c
- naskb = naskb+1
- task(naskb) = taskn
- wask(naskb) = udsp(iudsp)
- elask(naskb) = 0.
- end if
- else
-c 130330 start
- oldwask = 0.
- oldelask = 0.
-c 130330 end
-c
-c This is a normal space, no effect if smaller than existing space
-c
- if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
-c
-c We already put in some space at this time
-c Check if new one needs more space than old one at same time
-c
- if (waskn .gt. wask(naskb)) then
-c
-c 130330 We were double counting the larger space when it came 2nd
-c Need to fix but don't see how yet. Assume times came in order and
-c that last naskb defined spaces that need updating
-c
- oldwask = wask(naskb)
- oldelask = elask(naskb)
-c End of 130330 insertions
- naskb = naskb-1
- else
- return
- end if
- end if
- naskb = naskb+1
- task(naskb) = taskn
- wask(naskb) = waskn
- elask(naskb) = elaskn
-c 130330 start
-c fixednew = fixednew+waskn
-c scaldold = scaldold+elaskn
- fixednew = fixednew+waskn-oldwask
- scaldold = scoarg+elaskn-oldelask
-c 130330 end
- end if
- return
- end
- subroutine addblank(noteq,lnoten)
- character*8 noteq
- character*1 tchar
- tchar = noteq(1:1)
- noteq = ' '//tchar
- lnoten = 2
- return
- end
- subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd)
- parameter (nm=24)
- integer nfb(nm)
- common /comtol/ tol
- real*4 t1fb(nm,20),t2fb(nm,20)
- character*1 ulfbq(nm,20)
- ifbadd = 1
- nfb(iv) = nfb(iv)+1
- do 1 ifb = nfb(iv)-1 , 1 , -1
- if (tnew .lt. t1fb(iv,ifb)-tol) then
- t1fb(iv,ifb+1) = t1fb(iv,ifb)
- t2fb(iv,ifb+1) = t2fb(iv,ifb)
- ulfbq(iv,ifb+1) = ulfbq(iv,ifb)
- else
- ifbadd = ifb+1
- go to 2
- end if
-1 continue
-2 continue
- t1fb(iv,ifbadd) = tnew
- ulfbq(iv,ifbadd) = 'x'
- return
- end
- subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest)
-c subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest)
- parameter(nm=24,mv=24576)
- integer*2 mmidi,itk(25)
- integer*4 itiesav(5,100)
- character*1 notenumq
- logical endrest,eximacc,it1found
- logical rest
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
- integer*2 iinsiv
- logical slmon,dbltie
- common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
- * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
- * slmon(0:nm),dbltie
- common /comevent/ miditime,lasttime
- common /comdiag/ n69(0:nm),n34(0:nm)
-c common /commidisig/ midisig(nm)
-c
-c Following variables are local but must be saved. I hope they are.
-c (3/18/00) With g77 they are not, so add a common block here.
-c
-c integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12)
- integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15)
- common /comips/ ipslon,lusebl,jusebl
-c data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/
- data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
-c
-c Cancel out barline accidentals if there's a rest.
-c
- if (rest) naccbl(icm) = 0
-c
-c Special path to insert dummy rest at end of a section
-c
- if (endrest) go to 20
-c
- do 7 ion = 0 , nmidcrd
-c
-c check if this is only to get pitch of a chord note
-c
- if (notmain) go to 6
-c
-c check for rest
-c
- if (rest) then
-c
-c Will not put in a note, but must update timing
-c
- if (.not.restpend(icm)) then
-c
-c First rest in sequence, save the time
-c
- restpend(icm) = .true.
- trest(icm) = time
- else
- trest(icm) = trest(icm)+time
- end if
-c
-c Note: code checkers don't like the above due to calling addmidi(trest(icm))
-c but this only happens if rest at end of section (endrest=.true.) (called
-c from getmidi(), in which case these above lines are bypassed.
-c
- call chkimidi(icm)
- return
- end if
-c
-c time tics
-c
- if (imidi(icm).gt.0 .and. ion.eq.0) then
- idur = mgap
- else
- idur = 0
- end if
- if (restpend(icm)) then
- restpend(icm) = .false.
- idur = idur+nint(15*trest(icm))
- end if
-c
-c time to start of note
-c
- idurvar = isetvarlen(idur,nby2on)
- if (nby2on .gt. 4) then
- print*,'You got >4 bytes, something is bogus.'
- call stop1()
- end if
- imidi(icm) = imidi(icm)+1
- do 2 i = 1 , nby2on
-c
-c imidi points to cell before highest (leftmost) byte. Start with lowest byte
-c at far right, fill in backwards
-c
- mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256)
- if (nby2on .gt. 1) idurvar = idurvar/256
-2 continue
- imidi(icm) = imidi(icm)+nby2on-1
-c
-c Note-on signal
-c
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = 9*16+icmm(icm)
-c
-c Entry point for chord note pitch determination
-c
-6 continue
-c
-c Get midi pitch. On chord iteration, only do this first time (main note),
-c since pitch was already computed for nonmain chord notes.
-c
- if (ion .eq. 0) then
- ipsav = nolev*12./7+11
- ipsav0 = ipsav
- if (midisig .ne. 0) then
-c
-c Adjust for signature
-c
- notenumq = char(48+mod(nolev,7))
- if (midisig.ge.index('4152630',notenumq)) then
- ipsav = ipsav+1
- else if (-midisig.ge.index('0362514',notenumq)) then
- ipsav = ipsav-1
- end if
- end if
-c
-c Deal with accidentals.
-c
-c iacc 0 1 2 3 4 5 6 7
-c effect X fl sh na X dfl dsh X
-c iashft X -1 1 0 X -2 2 X
-c
- jacc = 0
- eximacc = .false.
- if (iacc .gt. 0) then
-c
-c Adjust key-sig-adjusted pitch for explicit accidental (and exit)
-c
- jacc = iashft(iacc)
- eximacc = .true.
- if (.not.relacc) jacc = jacc+ipsav0-ipsav
-c
-c (Above) Shift applies to diatonic pitch but will be added to adjusted one
-c
- else if (naccim(icm) .gt. 0) then
-c
-c Possible implicit accidental from earlier in the bar
-c Check for prior accid in this bar at this note level
-c
- do 3 kacc = 1 , naccim(icm)
- if (laccim(icm,kacc) .eq. nolev) then
- jacc = jaccim(icm,kacc)
- eximacc = .true.
- if (.not.relacc) jacc = jacc+ipsav0-ipsav
- go to 4
- end if
-3 continue
-4 continue
- end if
-c
-c Must split off the following if block from those above because chord
-c notes can cause naccim>0, forcing us to miss other chord note's
-c accross-bar-line accidental
-c
- if (naccbl(icm).gt.0 .and. .not.eximacc) then
-c
-c Possible carryover accid from prior bar (or prior same-pitch note).
-c
- do 21 kacc = 1 , naccbl(icm)
- if (laccbl(icm,kacc) .eq. nolev) then
- jacc = jaccbl(icm,kacc)
-c
-c Since we are *using* the bar-line accid, must flag it to be saved for next.
-c
- nusebl = nusebl+1
- jusebl(nusebl) = jacc
- lusebl(nusebl) = nolev
- if (.not.relacc) jacc = jacc+ipsav0-ipsav
- go to 22
- end if
-21 continue
-22 continue
- end if
- ipsav = ipsav+jacc
- end if
- if (notmain) then
- mcpitch(nmidcrd) = ipsav
-c
-c Save pitch for tie checks
-c
- if (levson(icm).eq.nolev.and..not.slmon(icm))
- * ipslon(icm) = ipsav
- else
- imidi(icm) = imidi(icm)+1
- if (ion.eq.0) then
- mmidi(icm,imidi(icm)) = ipsav
- if (levson(icm).eq.nolev.and..not.slmon(icm))
- * ipslon(icm) = ipsav
- else
- mmidi(icm,imidi(icm)) = mcpitch(ion)
- end if
- end if
- if (ion .eq. 0) then
-c
-c Only record accids for non-chords, main chord note during chord iteration
-c and chordnotes on first call but not during iteration
-c
- if (iacc.gt.0) then
-c
-c Set marker for accidental for possible continuations later this bar
-c but first check and clear earlier ones on same note.
-c
- do 23 kacc = 1 , naccim(icm)
- if (laccim(icm,kacc) .eq. nolev) then
- do 24 macc = kacc , naccim(icm)-1
- laccim(icm,macc) = laccim(icm,macc+1)
- jaccim(icm,macc) = jaccim(icm,macc+1)
-24 continue
- go to 25
- end if
-23 continue
- go to 26
-25 continue
- naccim(icm) = naccim(icm)-1
-26 continue
-c
-c Flag new accidental
-c
- naccim(icm) = naccim(icm)+1
- laccim(icm,naccim(icm)) = nolev
- jaccim(icm,naccim(icm)) = iashft(iacc)
- end if
-c
-c Bail if this is a chord note on the first call (from docrd)
-c
- if (notmain) then
- call chkimidi(icm)
- return
- end if
- end if
-c
-c Vel
-c
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = midvelc(icm)
- call chkimidi(icm)
-7 continue
-c
-c For tie checks
-c
- if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm)
-c
-c Entry point for special rests at section ends (endrest=T)
-c
-20 continue
-c
-c Now insert all the ends
-c
- do 8 ioff = 0 , nmidcrd
- if (ioff .eq. 0) then
-c
-c time to end
-c
- idur1 = nint(15*time)
- if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then
- idur = idur1-mgap
- else
- idur = idur1
- end if
-c
-c Deal with roundoff problems with 7-tuplets on half or quarters
-c
- if (idur1 .eq. 69) then
- n69(icm) = n69(icm)+1
-c if (mod(n69(icm)+6,7) .gt. 3) idur = 58
- if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1
- else if (idur1 .eq. 34) then
- n34(icm) = n34(icm)+1
- if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1
- end if
- idurvar = isetvarlen(idur,nby2off)
- if (nby2off .gt. 4) then
- print*,'You got >4 bytes, something is bogus.'
- call stop1()
- end if
- imidi(icm) = imidi(icm)+1
- call chkimidi(icm)
- do 1 i = 1 , nby2off
- mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256)
- if (nby2off .gt. 1) idurvar = idurvar/256
-1 continue
- imidi(icm) = imidi(icm)+nby2off-1
- else
-c
-c Inserting end of chord note, delta time is 0
-c
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = 0
- end if
-c
-c Note off
-c
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = 8*16+icmm(icm)
-c
-c Pitch
-c
- imidi(icm) = imidi(icm)+1
- if (ioff .eq. 0) then
- mmidi(icm,imidi(icm)) = ipsav
- else
- mmidi(icm,imidi(icm)) = mcpitch(ioff)
- end if
-c
-c Vel
-c
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = 0
- call chkimidi(icm)
- if (endrest) then
- return
- end if
-8 continue
- naccbl(icm) = nusebl
- if (nusebl .gt. 0) then
-c
-c Fix tables of "bar-line" accids that are saved due to consecutive notes.
-c
- do 30 kacc = 1 , nusebl
- laccbl(icm,kacc) = lusebl(kacc)
- jaccbl(icm,kacc) = jusebl(kacc)
-30 continue
- nusebl = 0
- end if
-c
-c Begin tie checks
-c
- if (slmon(icm)) then
-c
-c Prior note had a slur start
-c
- if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then
-c
-c We have a tie! (Assumed there would be no accidental on tie-ending note)
-c Make a list of times of all events back to the one starting at imidso+1,
-c which is at or before where the tie started. Ident tie start and stop by
-c comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie)
-c Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial
-c time.
- nsav4tie = 0
- imidt = imidso(icm)
-10 nsav4tie = nsav4tie+1
- itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes)
- imidt = imidt+nbytes
- do 11 j = 1 , 3
- itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j)
-11 continue
- imidt = imidt+3
- if (nsav4tie .eq. 1) then
- itiesav(5,1) = itiesav(1,1)
- else
- itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+
- * itiesav(5,nsav4tie-1)
- end if
- if (imidt .ne. imidi(icm)) go to 10
-c
-c Find which two pitches agree with saved slur pitch.
-c
- it1found = .false.
- do 12 it2 = 1 , nsav4tie
- if (itiesav(3,it2) .eq. ipslon(icm)) then
- if (it1found) go to 13
- it1 = it2
- it1found = .true.
- end if
-12 continue
- call printl(
- * 'Program error, tied notes, send source to Dr. Don')
- it1 = nsav4tie+1
- it2 = nsav4tie+1
-13 continue
-c
-c List the positions we want to keep
-c
- jsav = 0
- do 14 isav = 1 , nsav4tie
- if (isav.eq.it1 .or. isav.eq.it2) go to 14
- jsav = jsav+1
- itk(jsav) = isav
-14 continue
- nsav4tie = nsav4tie-2
-c
-c Now dump events it1 & it2, recompute times, restack mmidi.
-c
- imidi(icm) = imidso(icm)
- do 15 isav = 1 ,nsav4tie
- if (isav .eq. 1) then
- idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes)
- else
- idurvar = isetvarlen(itiesav(5,itk(isav))-
- * itiesav(5,itk(isav-1)),nbytes)
- end if
- imidi(icm) = imidi(icm)+1
- do 16 i = 1 , nbytes
- mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256)
- if (nbytes .gt. 1) idurvar = idurvar/256
-16 continue
- imidi(icm) = imidi(icm)+nbytes-1
- do 17 i = 2 , 4
- imidi(icm) = imidi(icm)+1
- mmidi(icm,imidi(icm)) = itiesav(i,itk(isav))
-17 continue
-15 continue
- end if
- slmon(icm) = .false.
- levsoff(icm) = 0
- if (.not.dbltie) levson(icm) = 0
- end if
- if (levson(icm).gt.0) slmon(icm) = .true.
- if (nmidcrd .gt. 0) nmidcrd = 0
- call chkimidi(icm)
- return
- end
- subroutine addstr(notexq,lnote,soutq,lsout)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink
- character*(*) notexq
- character*80 soutq
- if (lsout+lnote .gt. 72) then
- if (islast) write(11,'(a)')soutq(1:lsout)//'%'
- lsout = 0
- end if
- if (lsout .gt. 0) then
- soutq = soutq(1:lsout)//notexq(1:lnote)
- else
- soutq = notexq(1:lnote)
- end if
- lsout = lsout+lnote
- return
- end
- subroutine adjusteskz(ib,istart,poenom)
-c
-c For block ib, this adds accidental spaces to eskz, for use in getting
-c length of xtup bracket and slopes of brackets and beams.
-c
- parameter (nm=24)
- common /comas1/ naskb,task(40),wask(40),elask(40)
- integer*4 istart(80)
- common /comnsp/ space(80),nb,prevtn(nm),
- * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig
- common /comeskz2/ eskz2(nm,200)
- common /comtol/ tol
- common /comntot/ ntot
- inmin = istart(ib)+1
- do 10 iaskb = 1 , naskb
- if (task(iaskb) .lt. to(istart(ib))-tol) go to 10
- eskadd = wask(iaskb)/poenom-elask(iaskb)
- do 11 in = inmin , ntot
- if (to(in) .gt. task(iaskb)-tol) then
- eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd
- if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1
- else
- inmin = inmin+1
- end if
-11 continue
-10 continue
- return
- end
- subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
- logical figbass,ispoi,topmods,istype0,done,isbbm
- common /comhsp/ hpttot(176)
- common /compoi/ ispoi
- common /combbm/ isbbm
- common /comas3/ ask(2500),iask,topmods
- character*40 pathnameq
- character*44 basenameq
- character*1 sq,chax
- character*129 outq
- sq = chax(92)
- open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex')
-c
-c Transfer first 5 lines of main internal TeX file
-c
- do 11 il = 1 , 5
- call moveln(11,12,done)
-11 continue
- if (istype0) then
-c
-c Transfer literal TeX stuff from special scratch file
-c
- rewind(17)
-10 call moveln(17,12,done)
- if (.not.done) go to 10
- close(17)
- end if
-c
-c Transfer next 2 lines from main scratch file
-c
- do 3 il = 1 , 2
- call moveln(11,12,done)
-3 continue
- if (ispoi) write(12,'(a)')sq//'input musixpoi'
- if (isbbm) write(12,'(a)')sq//'input musixbbm'
- if (figbass) then
-c
-c Transfer .fig data from scratch (unit 14) into external .tex (unit 12)
-c
-4 call moveln(14,12,done)
- if (.not.done) go to 4
- close(14)
- end if
- iask = 0
- ihs = 0
-1 read(11,'(a129)',end=999)outq
-c
-c Hardspaces.
-c
- if (outq(1:5) .eq. sq//'xard') then
- ihs = ihs+1
- outq(2:2) = 'h'
- write(outq(12:15),'(f4.1)')hpttot(ihs)
- lenout = 19
- go to 9
- end if
-c
-c This part hard-wires ask's into new .tex file as ast's
-c
-2 indxask = index(outq,sq//'ask')
- if (indxask .ne. 0) then
- iask = iask+1
- call putast(ask(iask),indxask,outq)
- go to 2
- end if
- lenout = llen(outq,129)
-9 continue
- write(12,'(a)')outq(1:lenout)
-c
-c If this is the line with "readmod", check for topmods.
-c
- if (topmods .and. outq(2:8).eq.'readmod') then
- topmods = .false.
- rewind(16)
- do 7 il = 1 , 1000
- read(16,'(a129)',end=8)outq
- lenout = llen(outq,129)
-c
-c We inserted the '%' in subroutine littex, to guarantee including blank.
-c
- write(12,'(a)')outq(1:lenout)
-7 continue
-8 continue
- close(16)
- end if
- go to 1
-999 close(11)
- close(12)
- return
- end
- subroutine backfill(iunit,oldq,lenold,newq,lennew)
-c
-c In iunit, looks backward for oldq, overwrites newq
-c Safest if both are same length!
-c
- character*128 lineq(200),nowq
- character*(*) oldq,newq
- linesback = 0
-1 continue
- backspace(iunit)
- read(iunit,'(a)')nowq
- ndx = index(nowq,oldq(1:lenold))
-c
-c Save the line just read
-c
- linesback = linesback+1
- lineq(linesback) = nowq
- if (ndx .eq. 0) then
- backspace(iunit)
- go to 1
- end if
-c
-c If here, it's replacement time.
-c
- lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew)
- * //nowq(ndx+lenold:128)
- backspace(iunit)
- do 2 line = linesback , 1 , -1
- write(iunit,'(a128)')lineq(line)
-2 continue
- return
- end
- subroutine beamend(notexq,lnote)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq,ulqq,chax
- logical beamon,firstgulp,figbass,figchk,flipend,btest,
- * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comoct/ noctup
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
- character*4 tempq
- character*8 noteq
- character*79 notexq
- ip = ipo(jn)
- multip = iand(mult(ivx,ip),15)-8
- lnote = 0
- if (ixrest(ivx) .eq. 4) then
-c
-c This is the LAST note in the xtup (i.e., all rests before). Make single.
-c
- nodur(ivx,ip) = 2**(4-multip)
- call notex(notexq,lnote)
- ixrest(ivx) = 0
- return
- end if
- nole = nolev(ivx,ip)
-c
-c Check for special situations with 2nds (see precrd)
-c
- if (btest(nacc(ivx,ip),30)) then
- nole = nole - 1
- else if (btest(nacc(ivx,ip),31)) then
- nole = nole + 1
- end if
-c
-c Terminate indented beams for 2-note tremolo if needed
-c
- if (btest(irest(ivx,ip-1),2) .and.
- * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then
- nindent = igetbits(irest(ivx,ip-1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- addoff = -1-.5*nindent
- else
- addoff = 1+.5*nindent
- endif
-c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx)
- addoff = addoff+.0822*islope(ivx)
- if (addoff .lt. -.05) then
- write(tempq,'(f4.1)')addoff
- else
- write(tempq,'(f4.2)')addoff
- end if
- notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{'
- * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))//
- * '0}}'
- lnote = 46
- end if
- if (.not.drawbm(ivx)) then
-c
-c Xtuplet with no beam, just put in the right kind of note
-c
- if (btest(irest(ivx,ip),0)) then
-c
-c Rest at end of unbeamed xtup
-c
- lnote = 3
- if (btest(islur(ivx,ip),29)) then
- notexq = sq//'sk'
-c
-c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for
-c a blank rest ending xtup, but hopefully returning from here will handle it.
-c
- return
- else if (multip .eq. 0) then
- notexq = sq//'qp'
- else if (multip .eq. -1) then
- notexq = sq//'hp'
- else if (multip .eq. 1) then
- notexq = sq//'ds'
- else if (multip .eq. 2) then
- notexq = sq//'qs'
- else
- notexq = sq//'hs'
- end if
-c
-c 180106 Deal with possible level tweak
-c
- nole = mod(nolev(ivx,ip)+50,100)-50
- if (nole .ne. 0) then
- if (abs(nole) .lt. 10) then
- noteq = chax(48+abs(nole))
- lnoten = 1
- else
- write(noteq(1:2),'(i2)')abs(nole)
- lnoten = 2
- end if
- if (nole .gt. 0) then
- notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
- * //notexq(1:lnote)
- else
- notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
- * //notexq(1:lnote)
- end if
- lnote = 16+lnoten+lnote
- end if
- return
- end if
- if (btest(islur(ivx,ip),30)) then
-c
-c Forced stem direction
-c
- ndsav = nodur(ivx,ip)
- nodur(ivx,ip) = 2**(4-multip)
- if (btest(nacc(ivx,ip-1),27))
- * nodur(ivx,ip)=nodur(ivx,ip)/2
- call notex(notexq,lnote)
- nodur(ivx,ip) = ndsav
- else
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
-c
-c To reduce confusion due to this early update of lnote, do it
-c below, separately in each case/
-c lnote = lnoten+3
- if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c Prior note is not regular-dotted
-c
- if (btest(irest(ivx,ip-1),2) .and.
- * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then
-c
-c Unbeamed tremolo with indented beams. Put termination in right here
-c
- nindent = igetbits(irest(ivx,ip-1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- addoff = -1-.5*nindent
- else
- addoff = 1+.5*nindent
- endif
-c
-c Is there an islope here, for unbeamed?
-c
- if (addoff .lt. -.05) then
- write(tempq,'(f4.1)')addoff
- else
- write(tempq,'(f4.2)')addoff
- end if
- notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//
- * 'hbox{'
- * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))//
- * '0}}'
- lnote = 46
- end if
- if (multip .eq. 0) then
- if (btest(irest(ivx,ip-1),2) .and.
- * nodur(ivx,ip).gt.24) then
-c
-c 2nd note of unbeamed half-note trem; make open
-c But it's not clear if unbeamed half-note tremolo is Kosher,
-c so don't worry about stem lengths here now.
-c
- if (lnote .eq. 0) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
- else
- notexq = notexq(1:46)//
- * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
- lnote = 46
- end if
- else
- if (btest(irest(ivx,ip-1),2) .and.
- * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
-c
-c Need a dot.
-c
- lnote = 46
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
-c
-c Insert stemlength stuff here for unbeamed dotted tremolo.
-c May later combine with below to avoid repeat. But need to
-c return to normal stem length after note is set.
-c
- nindent = igetbits(irest(ivx,ip-1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- slen = (4.5+nindent+nolev1(ivx)-nole
- * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
- * *islope(ivx)/slfac)*.6667
- else
- slen = (4.5+nindent-nolev1(ivx)+nole
- * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
- * *islope(ivx)/slfac)*.6667
- end if
- write(tempq,'(f4.1)')slen
- notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote)
- lnote = lnote+10
- end if
-c
-c Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem
-c (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot)
-c
- if (btest(irest(ivx,ip-1),2)) then
- if (lnote .eq. 0) then
-c notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//'p'
- * //noteq(1:lnoten)
- else
- notexq = notexq(1:lnote)//sq//'q'
-c * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- * //ulq(ivx,ibmcnt(ivx))//'p'//noteq(1:lnoten)
- end if
-c lnote = lnote+3+lnoten
- lnote = lnote+4+lnoten
- else
- if (lnote .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
- * //noteq(1:lnoten)
- else
- notexq = notexq(1:lnote)//sq//'q'
- * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- end if
- lnote = lnote+3+lnoten
- end if
- if (btest(irest(ivx,ip-1),2) .and.
- * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
- notexq = notexq(1:lnote)//sq//'slz'
- lnote=lnote+4
- end if
- end if
- else if (btest(irest(ivx,ip-1),2)) then
-c
-c 2nd note of unbeamed quarter or 8th trem; make quarter note
-c Get stemlength change
-c
- lnote = 46
- nindent = igetbits(irest(ivx,ip-1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- slen = (4.5+nindent+nolev1(ivx)-nole
- * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
- * *islope(ivx)/slfac)*.6667
- else
- slen = (4.5+nindent-nolev1(ivx)+nole
- * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
- * *islope(ivx)/slfac)*.6667
- end if
- write(tempq,'(f4.1)')slen
- notexq = notexq(1:46)//sq//'slx{'//tempq//'}'
- lnote = lnote+10
-c if (lnote .eq. 0) then
-c notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-c else
-c notexq = notexq(1:46)//
-c * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
-c end if
-c
-c
-c Check for dotted unbeamed tremolo
-c
- if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
-c
-c Need a dot
-c
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
- if (lnote .eq. 0) then
- notexq = sq//'pt'//noteq(1:lnoten)
- else
- notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten)
- end if
- lnote = lnote+3+lnoten
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
- end if
- notexq = notexq(1:lnote)//
- * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
-c * //sq//'stemcut'
- * //sq//'slz'
-c lnote=lnote+3+lnoten+8
- lnote=lnote+3+lnoten+4
- else if (multip .eq. -1) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- lnote = lnoten+3
- else if (multip .eq. 1) then
- notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- lnote = lnoten+3
- else if (multip .eq. 2) then
- notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- lnote = lnoten+4
- else if (multip .eq. 3) then
- notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
- lnote = lnoten+5
- else if (multip .eq. -2) then
- notexq = sq//'wh'//noteq(1:lnoten)
- lnote = lnoten+3
- else if (multip .eq. -3) then
- notexq = sq//'breve'//noteq(1:lnoten)
- lnote = lnoten+6
- else
- print*
- print*,'(Error in beamend, send source to Dr. Don)'
- call stop1()
- end if
- else
-c
-c Prior note is regular-dotted so this one is halved
-c
- lnote = lnoten+3
- if (multip .eq. 0) then
- notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
- else if (multip .eq. -1) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
- else if (multip .eq. -2) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
- else if (multip .eq. 1) then
- notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq
- lnote = lnoten+4
- else if (multip .eq. 2) then
- notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq
- lnote = lnoten+5
- end if
- end if
- end if
- return
- end if
-c
-c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just
-c skipping the call in that case.
-c
- if (.not.btest(irest(ivx,ip),0)) then
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- end if
-c call notefq(noteq,lnoten,nole,ncmid(iv,ip))
-c lnote = 0
-c
-c New way, with flipend, which was computed in beamstrt.
-c
- if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then
- ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
- flipend(ivx) = .false.
- end if
- if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then
-c
-c This is not a one-noter from beam-jump. Check if multiplicity has increased
-c
- if (btest(irest(ivx,ip-1),0)) then
-c
-c Prior note is a rest, check one before that
-c
- mp = iand(mult(ivx,ip-2),15)-8
- else
- mp = iand(mult(ivx,ip-1),15)-8
- end if
- if (multip .gt. mp) then
-c
-c Assume 1-3, 2-3, or 1-2
-c
- do 2 imp = multip , mp+1 , -1
- call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
-2 continue
- else if (btest(nacc(ivx,ip-1),27)) then
-c
-c 2nd member of dotted xtup
-c
- call ntrbbb(multip+1,'t',
- * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
- end if
- end if
-c
-c Beam termination and direction analysis
-c
- if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then
-c
-c This is the end of the first segment in a jump-beam. ivbj1=ivx will be number
-c of the jump-beam. ivbj2 will be tested along with isbjmp to see if in the
-c voice of the 2nd part of jumped beam. (May need special treatment for
-c multi-segment jump-beams
-c
- isbjmp = .true.
- ivbj1 = ivx
- multbj1 = iand(15,mult(ivx,ip)-8)
- ivbj2 = 0
- end if
- if (.not.btest(irest(ivx,ip),23)) then
-c
-c This is either a normal beamend or end of a sequence of jump-beam segments,
-c (170409) or rest at end of xtup
-c so some sort of termination is required
-c
- ulqq = ulq(ivx,ibmcnt(ivx))
- if (.not.isbjmp .or. ivx.ne.ivbj2) then
- if (btest(irest(ivx,ip),0)) then
-c
-c Xtup ends with rest
-c
- if (multip .eq. 1) then
- notexq = sq//'ds'
- lnote = 3
- else if (multip .eq. 2) then
- notexq = sq//'qs'
- lnote = 3
- else if (multip .eq. 3) then
- notexq = sq//'hs'
- lnote = 3
- end if
-c
-c 170801 Borrowed from main rest entry way down below to get level adjustment:
-c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different???
-c "... Now raise if necc."
-c
- if (btest(islur(ivx,ip),29)) then
-c
-c Blank rest
-c
- notexq = sq//'sk'
- lnote = 3
- else if (nole .ne. 0) then
-c
-c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with
-c nolev=-4 but expected 100+/-. Try to fix.
-c
- if (abs(nole).lt.30) nole = 100+nole
-c
- if (abs(nole-100) .lt. 10) then
- noteq = chax(48+abs(nole-100))
- lnoten = 1
- else
- write(noteq(1:2),'(i2)')abs(nole-100)
- lnoten = 2
- end if
-c ??? if (nole .gt. 0) then
- if (nole .gt. 100) then
- notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
- * //notexq(1:lnote)
- else
- notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
- * //notexq(1:lnote)
- end if
- lnote = 16+lnoten+lnote
- end if
- return
- else
-c
-c Normal termination
-c
- call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
- end if
- else
-c
-c Terminate a sequence of jump-beam segments.
-c
- ulqq = chax(225-ichar(ulqq))
- call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote)
- end if
- end if
-c
-c Check for end of 2nd seg of staff-jump xtup chord blank rest
-c
-c if (isbjmp.and.ivx.eq.ivbj2
- if (isbjmp
- * .and.btest(islur(ivx,ip),29)) then
- notexq = notexq(1:lnote)//sq//'sk'
- return
- end if
-c
-c And now the note, checking for open-head beamed tremolo
-c
- if (btest(irest(ivx,ip-1),2)) then
-c
-c Check for dotted tremolo
-c
- if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
-c
-c Need a dot
-c
- if (nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
-c
-c Solid notehead
-c
- notexq = notexq(1:lnote)//sq//'qbp'
- else
-c
-c Assuming open notehead and nodur = 48
-c
- notexq = notexq(1:lnote)//sq//'hbp'
- end if
- lnote = lnote+4
- else
- if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'hb'
- else
- notexq = sq//'hb'
- end if
- else
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
- end if
- end if
- lnote = lnote+3
- end if
- else
-c
-c No tremolo
-c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
- end if
- lnote = lnote+3
- end if
- isdotm = .false.
- if (.not.vxtup(ivx)) then
- if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
- if (.not.btest(iornq(ivx,ip),13)) then
- notexq = notexq(1:lnote)//'p'
- else
- notexq = notexq(1:lnote)//'m'
- isdotm = .true.
- end if
- lnote = lnote+1
- end if
- end if
-c
-c 5/25/08 Allow >12
-c 5/9/10 Up to 24; replace 24 with 0
-c
- if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
- call istring(mod(ivx,24),tempq,len)
- else
- call istring(mod(ivbj1,24),tempq,len)
- end if
- if (isbjmp .and. ivx.eq.ivbj2
- * .and..not.btest(irest(ivx,ip),23)) isbjmp=.false.
- notexq = notexq(1:lnote)//tempq(1:len)
- lnote = lnote+len
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (isdotm) then
- if (lnoten .eq. 1) then
- notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
- lnote = lnote+3
- else
- notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
- lnote = lnote+1
- end if
- end if
- return
- end
- subroutine beamid(notexq,lnote)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq,ulqq,chax
- logical beamon,firstgulp,figbass,figchk,flipend,btest,
- * isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm
- character*79 notexq
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comoct/ noctup
- common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- character*8 noteq
- character*4 tempq
- lnote = 0
- ip = ipo(jn)
- nole = nolev(ivx,ip)
-c
-c Check for special situations with 2nds (see precrd)
-c
- if (btest(nacc(ivx,ip),30)) then
- nole = nole - 1
- else if (btest(nacc(ivx,ip),31)) then
- nole = nole + 1
- end if
- if (.not.btest(irest(ivx,ip),0)) then
- multip = iand(mult(ivx,ip),15)-8
-c if (btest(islur(ivx,ip-1),3)) multip = multip+1
-c
-c (Above test OK since must have ip>1). Double dotted note preceding
-c
-c Move the following, because can't ask for note until after checking for
-c embedded xtup with number, due to ordering/octave feature.
-c
-c call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
- end if
- if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true.
- if (vxtup(ivx)) then
-c
-c In an xtup
-c
- if (btest(irest(ivx,ip),0)) then
-c
-c Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK
-c
- nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8))
- call notex(notexq,lnote)
-c
-c Re-zero so next note does not get confused
-c
- nodur(ivx,ip) = 0
- return
- end if
- if (.not.drawbm(ivx)) then
-c
-c Xtuplet with no beam, just put in the right kind of note
-c
- if (btest(islur(ivx,ip),30)) then
-c
-c Forced stem direction
-c
- ndsav = nodur(ivx,ip)
- nodur(ivx,ip) = 2**(4-multip)
- if (btest(nacc(ivx,ip),19) .or.
- * btest(nacc(ivx,ip),27)) then
- nodur(ivx,ip)=3*nodur(ivx,ip)/2
- else if (btest(nacc(ivx,ip-1),27)) then
- nodur(ivx,ip)=nodur(ivx,ip)/2
- end if
- call notex(notexq,lnote)
- nodur(ivx,ip) = ndsav
- else
-c
-c Use ulq for stem direction
-c
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- lnote = 3
- if (.not.btest(nacc(ivx,ip-1),27)) then
-c
-c Prior note of xtup is not regular-dotted
-c
- if (multip .eq. 0) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. -1) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. 1) then
- notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. 2) then
- notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
- lnote = 4
- else if (multip .eq. 3) then
- notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
- lnote = 5
- else if (multip .eq. -2) then
- notexq = sq//'wh'
- end if
- if (btest(nacc(ivx,ip),27)) then
-c
-c This xtup note is regular dotted non-beamed xtup
-c
-c notexq = notexq(1:3)//'p'
-c lnote = 4
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
- else
-c
-c Prior note of xtup is regular-dotted so this one is halved
-c
- if (multip .eq. 2) then
- notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
- lnote = 5
- else if (multip .eq. 1) then
- notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
- lnote = 4
- else if (multip .eq. 0) then
- notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. -1) then
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. -2) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
- end if
- end if
- notexq = notexq(1:lnote)//noteq
- lnote = lnote+lnoten
- end if
- return
- else if (nodur(ivx,ip).eq.0) then
-c
-c In the beamed xtup but not the last note
-c
- if (nodur(ivx,ip-1).gt.0) then
-c
-c Embedded Xtup, mult>0, starts here. Put in number if needed
-c
- nxtinbm(ivx) = nxtinbm(ivx)+1
- iud = 1
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1
-c
-c Get ip#, notelevel of middle note (or gap) in xtup
-c
- ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2
- xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
- * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
- if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+
- * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
- * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
- iflop = 0
- if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud
- iup = iud+2*iflop
- if (btest(irest(ivx,ip),14)) then
- iup = -iup
- iflop = 0
- if (iud*iup .lt. 0) iflop = iup
- end if
-c
-c Place number if needed
-c
- if (.not.btest(islur(ivx,ip),31)) then
- mprint = igetbits(nacc(ivx,ip),5,22)
- if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
- call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
- * nolev1(ivx),islope(ivx),slfac,
- * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
- * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
- * mult(ivx,ip),.false.)
- end if
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- else
-c
-c Intermediate note of xtup
-c
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- end if
- else
-c
-c Last note of xtup (but not last note of beam!)
-c
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- end if
- else if (btest(irest(ivx,ip),0)) then
- call notex(notexq,lnote)
- return
- else
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- end if
-c
-c Check for string of rests up to and including last note in xtup.
-c
-c Replace next 2 lines to keep from doing this block
-c when in second part of staff-jumping chordal xtup. This fix could
-c break some unaccounted non-chordal staff-jum xtup situations.
-c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and.
-c * .not.btest(irest(ivx,ip),0)) then
- if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and.
- * .not.btest(irest(ivx,ip),0) .and.
- * .not.(isbjmp.and.ivx.eq.ivbj2)) then
-c
-c This note is not a rest but next is a rest. Do rests continue to
-c end of xtup, where nodur>0
-c
- do 3 ipnow = ip+1 , ip+24
- if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup
- if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest
-c
-c If I don't go to 5, know next note IS a rest!
-c
-3 continue
-4 continue
- call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
- notexq = notexq(1:lnote)//sq//'qb'
- lnote = lnote+3
- call istring(ivx,tempq,len)
- notexq = notexq(1:lnote)//tempq(1:len)
- lnote = lnote+len
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- return
-5 continue
-c
-c Check if multiplicity changes in a way requiring action,
-c unless (160211) it's blank rest on start of 2nd seg of joined beam
-c
- else if(.not.btest(irest(ivx,ip-1),24)
- * .or..not.btest(islur(ivx,ip-1),29)) then
- ipleft = ip-1
- if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1
- if (.not.btest(islur(ivx,ipleft),20)) then
- multl = iand(15,mult(ivx,ipleft))-8
- else
- multl = 1
- end if
- mub = multip - multl
- ipright = ip+1
- if (btest(irest(ivx,ipright),0)) ipright = ipright+1
- if (.not.btest(islur(ivx,ip),20)) then
- multr = iand(15,mult(ivx,ipright))-8
- else
- multr = 1
- end if
- mua = multr-multip
- if (mub.gt.0 .or. mua .lt. 0) then
-c
-c Multiplicity has increased from left or will decrease to right. Need action.
-c
- if (isbjmp .and. ivx.eq.ivbj2) then
- ivb = ivbj1
- ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
- else
- ivb = ivx
- ulqq = ulq(ivx,ibmcnt(ivx))
- end if
- if (mua .ge. 0) then
- call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote)
-c
-c Test for next note being blank rest, assuming staff-crossing
-c xtup chord
-c
- else if (multl .ge. multr .and.
- * .not.btest(islur(ivx,ip+1),29)) then
- do 1 im = multip , 1+multr, -1
- call ntrbbb(im,'t',ulqq,ivb,notexq,lnote)
-1 continue
-c else
-c Test for next note being blank rest, assuming staff-crossing
-c xtup chord
-c
- else if (.not.btest(islur(ivx,ip+1),29)) then
- do 2 im = 1+multr, multip
- call ntrbbb(im,'r',ulqq,ivb,notexq,lnote)
-2 continue
- call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote)
- end if
- else if (ip .gt. 1) then
-c
-c Check for 2nd member of dotted xtup
-c
- if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t',
- * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
- end if
- end if
-c
-c Now put in the note
-c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
- end if
- lnote = lnote+3
- isdotm = .false.
- if (isdotted(nodur,ivx,ip)) then
-c
-c rule out ')'
-c
- if (.not.btest(iornq(ivx,ip),13)) then
- if (.not.btest(islur(ivx,ip),3)) then
- notexq = notexq(1:lnote)//'p'
- else
-c
-c Double dot
-c
- notexq = notexq(1:lnote)//'pp'
- lnote = lnote+1
- end if
- else
- notexq = notexq(1:lnote)//'m'
- isdotm = .true.
- end if
- lnote = lnote+1
- else if (btest(nacc(ivx,ip),19)
- * .or. btest(nacc(ivx,ip),27)) then
-c
-c Special dotted notation for 2:1 xtup, or normal dot in xtup
-c
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
-c
-c 5/25/08 Allow >12
-c
- if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
-c call istring(mod(ivx,12),tempq,len)
- call istring(mod(ivx,24),tempq,len)
- else
-c call istring(mod(ivbj1,12),tempq,len)
- call istring(mod(ivbj1,24),tempq,len)
- end if
- notexq = notexq(1:lnote)//tempq(1:len)
- lnote = lnote+len
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (isdotm) then
- if (lnoten .eq. 2) then
- notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
- lnote = lnote+3
- else
- notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
- lnote = lnote+1
- end if
- end if
- return
- end
- subroutine beamn1(notexq,lnote)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,btest,
- * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
- logical gotnote
- common /comoct/ noctup
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*8 noteq,tempq,numq
- character*79 notexq
- gotnote = .false.
- lnoten = 0
- ip1 = ipo(jn)
- multip = iand(15,mult(ivx,ip1))-8
- if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
- lnote = 0
-c
-c The rest was already written in beamstrt, so just get out of here
-c
- return
- end if
- nole = nolev(ivx,ipo(jn))
-c
-c Check for special situations with 2nds (see precrd)
-c
- if (btest(nacc(ivx,ipo(jn)),30)) then
- nole = nole - 1
- else if (btest(nacc(ivx,ipo(jn)),31)) then
- nole = nole + 1
- end if
- if (vxtup(ivx) .and. .not.drawbm(ivx)) then
-c
-c Xtuplet with no beam, just put in the right kind of note
-c
- if (btest(islur(ivx,ip1),30)) then
-c
-c Forced stem direction
-c
- ndsav = nodur(ivx,ip1)
- nodur(ivx,ip1) = 2**(4-multip)
- if (btest(nacc(ivx,ip1),19) .or.
- * btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2
- call notex(notexq,lnote)
- nodur(ivx,ip1) = ndsav
- else
- call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
- gotnote = .true.
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- lnote = 3
- if (multip .le. 0) then
- if ((btest(irest(ivx,ip1),2) .and.
- * nodur(ivx,ip1+1).ge.32)
- * .or. multip .eq. -1) then
-c
-c 1st note of unbeamed half-note trem; make open
-c
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. -2) then
- notexq = sq//'wh'
- else
- notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
- end if
-c
-c Check for dot
-c
- if (btest(irest(ivx,ip1),2) .and.
- * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then
-c
-c Need a dot. already called addblank for noteq
-c
- if (lnote .eq. 0) then
- notexq = sq//'pt'//noteq(1:lnoten)
- lnote = 3+lnoten
- else
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
- end if
-c
-c Insert the stemlength calcs here for dotted, unbeamed.
-c Later may combine with below to avoid repeat.
-c
- if (btest(irest(ivx,ip1),2)) then
- nindent = igetbits(irest(ivx,ip1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- slen = (4.5+nindent+nolev1(ivx)-nole
- * -.4*islope(ivx)/slfac)*.6667
- else
- slen = (4.5+nindent-nolev1(ivx)+nole
- * +.4*islope(ivx)/slfac)*.6667
- end if
- write(tempq,'(f4.1)')slen
- notexq = sq//'slx{'//tempq(1:4)//'}'//
- * notexq(1:lnote)
- lnote = lnote+10
- end if
- else if (btest(irest(ivx,ip1),2)) then
-c
-c 1st note of unbeamed quarter or 8th trem, make a quarter note
-c
-c Stem length calcs here. The .2 factor is empirical, but
-c slfac accounts for musicsize.
-c
- nindent = igetbits(irest(ivx,ip1),2,5)
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- slen = (4.5+nindent+nolev1(ivx)-nole
- * -.4*islope(ivx)/slfac)*.6667
- else
- slen = (4.5+nindent-nolev1(ivx)+nole
- * +.4*islope(ivx)/slfac)*.6667
- end if
- write(tempq,'(f4.1)')slen
- notexq = sq//'slx{'//tempq(1:4)//'}'//
- * sq//'q'//ulq(ivx,ibmcnt(ivx))
- lnote = 13
-c
-c Check for dotted 2-note trem; prepend dot to notexq if needed
-c
- if (nodur(ivx,ip1+1).eq.12 .or.
- * nodur(ivx,ip1+1).eq.24) then
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
- notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote)
- lnote = lnote+3+lnoten
- call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
- gotnote = .true.
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
- end if
- else if (multip .eq. -1) then
- notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. 1) then
- notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
- else if (multip .eq. 2) then
- notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
- lnote = 4
- else if (multip .eq. 3) then
- notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
- lnote = 5
- else if (multip .eq. -2) then
- notexq = sq//'wh'
- else if (multip .eq. -3) then
- notexq = sq//'breve'
- lnote = 6
- else
- print*
- print*,'(Error in beamn1, send source to Dr. Don)'
- call stop1()
- end if
- if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then
-c notexq = notexq(1:3)//'p'
-c lnote = 4
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
- notexq = notexq(1:lnote)//noteq
- lnote = lnote+lnoten
- end if
- return
- end if
-c
-c Check if mult. decreases from 1st note to 2nd
-c
- if (ibm2(ivx,ibmcnt(ivx)).gt.ip1
- * .or. btest(islur(ivx,ip1),20)) then
-c
-c More than one note or single-note before a multiplicity-down-up "]["
-c
- if (btest(islur(ivx,ip1),20)) then
- multr = 1
- else if (.not.btest(irest(ivx,ip1+1),0)) then
- multr = iand(15,mult(ivx,ip1+1))-8
- else
- multr = iand(15,mult(ivx,ip1+2))-8
- end if
- lnote = 0
-c
-c Check if staff-jumper
-c
- if (isbjmp .and. ivbj2.gt.0) then
- ivxp = ivbj1
- else
- ivxp = ivx
- end if
- if (multr .lt. multip) then
- do 1 im = multip , multr+1 , -1
-c
-c Right-shifted 'termination'
-c
- if (isbjmp .and. ivbj2.gt.0) then
-c
-c Jump beam
-c
- call ntrbbb(im,'t',ulq(ivxp,ibmcnt(ivx)),
- * ivxp,notexq,lnote)
- else
-c
-c Same staff
-c
- call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivxp,notexq,lnote)
- end if
-1 continue
- end if
- end if
-c
-c Check for beamed, dotted 2-note tremolo
-c
- if (btest(irest(ivx,ip1),2) .and.
- * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- gotnote = .true.
- if (lnoten .eq. 1) then
- noteq = ' '//noteq(1:1)
- lnoten = 2
- end if
- end if
-c
-c Put in the note, but check first for open-head beamed tremolo.
-c
- if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then
-c
-c 2-note open head tremolo
-c
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'hb'
- else
- notexq = sq//'hb'
- end if
- else
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'qb'
- else
- notexq = sq//'qb'
- end if
- end if
- lnote = lnote+3
- if (btest(irest(ivx,ip1),2) .and.
- * (nodur(ivx,ip1+1).eq.24.or.nodur(ivx,ip1+1).eq.12
- * .or.nodur(ivx,ip1+1).eq.48)) then
-c
-c 2-note trem on dotted note
-c
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
-c
-c Check for dot
-c
- isdotm = .false.
- if (.not.vxtup(ivx)) then
- nd = nodur(ivx,ipo(jn))
- if (nd.ne.0) then
- if (2**log2(nd).ne.nd) then
- if (.not.btest(iornq(ivx,ip1),13)) then
- if (.not.btest(islur(ivx,ip1),3)) then
- notexq = notexq(1:lnote)//'p'
- else
-c
-c Double dot
-c
- notexq = notexq(1:lnote)//'pp'
- lnote = lnote+1
- end if
- else
- notexq = notexq(1:lnote)//'m'
- isdotm = .true.
- end if
- lnote = lnote+1
- end if
- end if
- else if (btest(nacc(ivx,ip1),19) .or.
- * btest(nacc(ivx,ip1),27)) then
-c
-c In an xtup with special 2:1 notation with a dot on 1st note, or normal dot
-c
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
-c
-c Do the number; 0 if 12
-c 5/25/08 allow >12
-c
- if (.not.btest(irest(ivx,ip1),24)) then
- call istring(mod(ivx,24),numq,len)
- else
-c
-c 1st note of staff-jumping beam
-c
- call istring(mod(ivbj1,24),numq,len)
- end if
- notexq = notexq(1:lnote)//numq(1:len)
- lnote = lnote+len
- if (.not.gotnote) then
- call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
- end if
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (isdotm) then
- if (lnoten .eq. 1) then
- notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
- lnote = lnote+3
- else
- notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
- lnote = lnote+1
- end if
- end if
- return
- end
- subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- character*40 restq
- character*79 inameq
- logical beamon,firstgulp,figbass,figchk,btest,
- * isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm
- common /comeskz2/ eskz2(nm,200)
- common /comoct/ noctup
- common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c The following is just to save the outputs from SetupB for the case of
-c xtups starting with a rest, where beamstrt is called twice.
-c
- common /comipb/ nnb,sumx,sumy,ipb(24),smed
- character*1 chax
- character*8 noteq
- character*79 notexq,tempq
- integer nornb(nm),ihornb(nm,24)
- real*4 space(80),squez(80)
- logical novshrinktop,cstuplet,usexnumt,writebrests
- common /comnvst/ novshrinktop,cstuplet
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- character*10 figq
- common /xjbeambrests/ nbrests
- writebrests = .true.
- ibc = ibmcnt(ivx)
- ipb1 = ibm1(ivx,ibc)
- multb = iand(15,mult(ivx,ipb1))-8
- ip = ipo(jn)
- lnote = 0
- nvtrem = 0 ! Vertical adjustment beams for tremolo
-c
-c Compute slopes and note offsets from start of beam. Inside SetupB, for each
-c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also
-c gets islope(ivx), transferred in common.
-c
- if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21))
- * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx))
-c
-c Will always come past here after entering beamstrt for 2-note tremolo, and
-c slope will have been computed, even for unbeamed. So start the indented
-c beams here. The indented tremolo bars will be added to the notexq output
-c string, under the tacet assumption that there is no horizontal shift
-c enacted by the action just before and after the call to beamstrt.
-c
- if (btest(irest(ivx,ipb1),2) .and.
- * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then
- nindent = igetbits(irest(ivx,ipb1),2,5)
- tempq = sq//'roffset{.7}{'//sq//'ib'
- ltemp = 16
- if (nindent .eq. 2) then
- tempq = tempq(1:16)//'b'
- ltemp = 17
- else if (nindent .eq. 3) then
- tempq = tempq(1:16)//'bb'
- ltemp = 18
- end if
-c
-c Use beam # 0 for indented beams
-c
- tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0'
- ltemp = ltemp+2
-c
-c Get adjustment to nolev1 for main beam based on nindent
-c
- if (ulq(ivx,ibc) .eq. 'u') then
- nvtrem = nindent-1
- else
- nvtrem = 1-nindent
- end if
-c
-c Get numerical position of initiation for main beam. Will adjust height at
-c closing to account for nindent
-c
- numinit = nolev1(ivx)-ncmid(iv,ipb1)+4
-c
-c Get forced beam height tweak, apply here for indented beams
-c
- iadj = igetbits(ipl(ivx,ipb1),6,11)-30
- if (iadj .ne. -30) numinit = numinit+iadj
- if (numinit.ge.0 .and. numinit.le.9) then
- write(noteq,'(i1)') numinit
- lnoten = 1
- else
- write(noteq,'(a1,i2,a1)')'{',numinit,'}'
- lnoten = 4
- end if
- tempq = tempq(1:ltemp)//noteq(1:lnoten)
- ltemp = ltemp+lnoten
-c
-c Now do the slope.
-c 170408 Baseline is in islope(ivx). Apply slope tweak if present.
-c
- numinit = islope(ivx)
- iadj = igetbits(ipl(ivx,ipb1),6,17)-30
- if (iadj .ne. -30) numinit = numinit+iadj
- if (numinit.ge.0 .and. numinit.le.9) then
- write(noteq,'(i1,a1)') numinit,'}'
- lnoten = 2
- else
- write(noteq,'(a1,i2,a2)')'{',numinit,'}}'
- lnoten = 5
- end if
- tempq = tempq(1:ltemp)//noteq(1:lnoten)
- ltemp = ltemp+lnoten
- notexq = tempq
- lnote = ltemp
- end if
- if (btest(nacc(ivx,ip),21)) then
-c
-c This is start of later segment of single-slope beam group so use slope and
-c height from prior beam. Slope is already OK.
-c
- issb(ivx) = issb(ivx)+1
- nolev1(ivx) = lev1ssb(ivx,issb(ivx))
- end if
-c
-c Move this up to before indented beams for tremolo
-c lnote = 0
- drawbm(ivx) = .true.
- if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then
- vxtup(ivx) = .true.
- nxtinbm(ivx) = nxtinbm(ivx)+1
-c
-c irest(28)=>Xtup starts on this note. Set up for xtuplet.
-c Number goes on notehead side at middle note (or gap) of xtup, unless that
-c puts it in staff, then it flops to stem (or beam) side.
-c __ __
-c | | | O | |
-c O | | O
-c |___| O |__| |
-c
-c iud -1 -1 1 1 ...stem direction
-c iflop 0 1 -1 0 ...direction of flop
-c iup -1 1 -1 1 ...direction of number and bracket
-c
- iud = 1
- if (ulq(ivx,ibc) .eq. 'u') iud = -1
-c
-c Get ip#, note level of middle note (or gap) in xtup
-c
- ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2
-c
-c 130129 If middle note is a rest, go to next note. Note last note cannot
-c be a rest
-c
-14 continue
- if (btest(irest(ivx,ipmid),0)) then
- ipmid = ipmid+1
- go to 14
- end if
- xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
- * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
- if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+
- * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
- * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
- iflop = 0
- if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud
- iup = iud+2*iflop
- if (btest(irest(ivx,ipb1),14)) then
-c
-c Alter iud, iflop, iup to flip number/bracket. (Stare at above pic)
-c
- iup = -iup
- iflop = 0
- if (iud*iup .lt. 0) iflop = iup
- end if
-c
-c Determine if a beam is to be drawn.
-c Had problem w/ half-note 2-note xtups always F, so add a test
-c
- if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then
- drawbm(ivx) = .true.
- go to 6
- end if
- do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc)
- if (iand(15,mult(ivx,ipp))-8 .le. 0) then
- drawbm(ivx) = .false.
- go to 6
- end if
-5 continue
- drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18)
-6 continue
-c
-c Are we using tuplet.tex?
-c
- usexnumt = cstuplet .and. .not.drawbm(ivx)
-c
-c Check for single note xtup 171217
-c
- if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then
- drawbm(ivx) = .false.
- end if
-c
-c Place xtup number if needed
-c
- if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then
- mprint = igetbits(nacc(ivx,ip),5,22)
- if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
-c Stab in the dark! Note: tried setting unbeam flag islur18 but no go.
- if (nnb .eq. 1) then
- xnlmid = nolev1(ivx)
- islope(ivx) = 0
-c
-c Move up, outside number check block, so all 1-note xtups ar unbeamed
-c drawbm(ivx) = .false.
-c
- end if
- call putxtn(mprint,iflop,multb,iud,wheadpt,
- * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1),
- * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)),
- * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
- end if
- if (.not.drawbm(ivx)) then
-c
-c Xtuplet with no beam
-c
- if (.not.btest(islur(ivx,ipb1),31)) then
-c
-c Number printing has not been suppressed, so put in the bracket.
-c scale = stretch factor for bracket if there are asx's
-c xnsk = length of the bracket in \noteskips = (\elemskips)/(eon)
-c
- xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1)
- * -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib))
- if (iup .eq. 1) then
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'ovbkt'
- else
- notexq = sq//'ovbkt'
- end if
- else
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//sq//'unbkt'
- else
-c
-c Introduced 12/5/98, req'd due to possible presence of in-line TeX
-c
- notexq = sq//'unbkt'
- end if
- end if
- lnote = lnote+6
- if (iline.eq.1) then
- smed = smed/(1.-fracindent)
- end if
- xslope = 1.8*smed*slfac
- islope(ivx) = nint(xslope)
- nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1))
- if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1
- if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4
- levbracket = nolev1(ivx)
- if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1
- call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1))
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
- lnote = lnote+lnoten+1
- if (xnsk .lt. 0.995) then
- write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk
- lnote = lnote+4
- else if (xnsk .lt. 9.995) then
- write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk
- lnote = lnote+4
- else
- write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk
- lnote = lnote+5
- end if
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- if (btest(mult(ivx,ipb1),4)) then
-c
-c Tweak slope of bracket
-c
- islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16
- end if
- if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- if (islope(ivx) .lt. -9) then
- write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx)
- lnote = lnote+3
- else
- write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx)
- lnote = lnote+2
- end if
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- else
- write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx)
- lnote = lnote+1
- end if
-c
-c Done with bracket
-c
- end if
- if (ixrest(ivx) .eq. 1) then
-c
-c Put in the rest. Possible problem: Rest is a spacing char, but between
-c beamstrt and beamn1 some non-spacing chars. are inserted.
-c
-c 130126 Deal with vertical shifts of rest starting xtuplet
-c
- lrest = 3
- if (btest(islur(ivx,ip),29)) then
- restq = sq//'sk'
-c if (multb .eq. 0) then
- else if (multb .eq. 0) then
- restq = sq//'qp'
- else if (.not.drawbm(ivx).and.multb.eq.1) then
- restq = sq//'ds'
- else if (.not.drawbm(ivx).and.multb.eq.2) then
- restq = sq//'qs'
- else if (.not.drawbm(ivx).and.multb.eq.3) then
- restq = sq//'hs'
- else
- restq = sq//'hpause'
- lrest = 7
- end if
- if (btest(nacc(ivx,ipb1),18) .and.
- * btest(nacc(ivx,ipb1),19)) then
-c
-c VERY special case of rest at start of F-tuplet, needs dot
-c
- restq = sq//'pt4'//restq(1:lrest)
- lrest = lrest+4
- end if
-
- nole = mod(nolev(ivx,ip)+20,100)-20
-c if (nole .eq. 0) then
- if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then
-c
-c Rest blank or is not raised
-c
- notexq = notexq(1:lnote)//restq
- lnote = lnote+lrest
- else
- if (abs(nole) .lt. 10) then
- tempq = chax(48+abs(nole))
- ltemp = 1
- else
- write(tempq(1:2),'(i2)')abs(nole)
- ltemp = 2
- end if
- if (nole .gt. 0) then
- tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote'
- else
- tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote'
- end if
- ltemp = 16+ltemp
- notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest)
- lnote = lnote+ltemp+lrest
- end if
-c
-c No need to come back through this subroutine (as would if rest starts bar
-c & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing.
-c
- ixrest(ivx) = 0
- end if
- return
- end if
-c
-c End if block for non-beamed xtup start...note we returned
-c
- if (ixrest(ivx) .eq. 1) then
-c
-c Insert rest at start of beamed xtup. See above note for possible problem.
-c But first check if blank rest and if in forced beam (assuming xtuplet),
-c and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*'
-c
- if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then
- nbrests = nbrests+1
- writebrests = .false.
- else
- nodur(ivx,ipb1) = 2**(4-multb)
- call notex(tempq,ltemp)
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//tempq(1:ltemp)
- else
- notexq = tempq(1:ltemp)
- end if
- lnote = lnote+ltemp
- end if
-c
-c Re-zero just in case!
-c
- nodur(ivx,ipb1) = 0
- ibm1(ivx,ibc) = ibm1(ivx,ibc)+1
-c
-c See if next note is a non-rest
-c
- if (.not.btest(irest(ivx,ipb1+1),0)) then
- ixrest(ivx) = 2
- else
-c
-c Suppress reprinting xtup number next time through beamstrt
-c
- islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31)
-c
-c Set new xtup start flag
-c
- irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28)
- end if
- return
- end if
- end if
-c
-c Just ended if block for xtups
-c
- if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then
-c
-c Move actual note writing to beamend
-c
- ixrest(ivx) = 4
- return
- end if
- if (issb(ivx) .eq. 0) then
-c
-c 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed
-c
- iadj = igetbits(ipl(ivx,ipb1),6,11)-30
- if (iadj .ne. -30) then
- nolev1(ivx) = nolev1(ivx)+iadj
- do 2 isssb = 1 , nssb(ivx)
- lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj
-2 continue
- end if
- iadj = igetbits(ipl(ivx,ipb1),6,17)-30
- if (iadj .ne. -30) then
- islope(ivx) = islope(ivx)+iadj
- if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx))
- if (nssb(ivx) .gt. 0) then
-c
-c Cycle thru non-rest notes in SSBG, looking for bmstrts.
-c
- isssb = 0
- do 4 inb = 2, nnb
- if (btest(nacc(ivx,ipb(inb)),21)) then
-c
-c Beam segment start. New start level
- isssb = isssb+1
- lev1ssb(ivx,isssb) =
- * lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac
- end if
-4 continue
- end if
- end if
- end if
- iadj = igetbits(islur(ivx,ipb1),2,27)
- addbrack = .false.
- if (btest(ipl(ivx,ipb1),30)) then
-c
-c Check for altered starting polarity. Only in forced beams. Nominal start
-c level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.).
-c
- if (ulq(ivx,ibc).eq.'u' .and.
- * nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then
- if (lnote .eq. 0) then
- notexq = sq//'loff{'
- else
- notexq = notexq(1:lnote)//sq//'loff{'
- end if
- lnote = lnote+6
- addbrack = .true.
- else if (ulq(ivx,ibc).eq.'l' .and.
- * nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then
- if (lnote .eq. 0) then
- notexq = sq//'roff{'
- else
- notexq = notexq(1:lnote)//sq//'roff{'
- end if
- lnote = lnote+6
- addbrack = .true.
- end if
-c
-c Check end level for possible flipping in forced beam. Have to do it
-c here since with multiple voices, xelsk will not be preserved.
-c
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
- bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac
- flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc))
- else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then
- bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac
- flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
- end if
- end if
- multbb = multb+iadj
-c
-c Tremolo starting?
-c
- if (btest(irest(ivx,ipb1),2)) multbb =
- * igetbits(irest(ivx,ipb1),2,3)
- call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote)
-c
-c Put in name of start level and slope, after correcting nolev1 if xtup
-c started with a rest.
-c
- if (ixrest(ivx).eq.2) nolev1(ivx) =
- * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac)
-c
-c Add adjustment nvtrem to main beam to account for tremolo indented beams
-c
- call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1))
- if (islope(ivx) .lt. 0) then
- notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
- lnote = lnote+4+lnoten
- write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}'
- else
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+1+lnoten
- write(notexq(lnote:lnote),'(i1)')islope(ivx)
- end if
-c
-c Check for beam-thk fine-tuning
-c
- if (iadj .gt. 0) then
- do 1 imp = multb+iadj , multb+1 , -1
- call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote)
-1 continue
- end if
-c
-c If we shifted, must close with right bracket
-c
- if (addbrack) then
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
-c
-c Add in \sk's for very special case of staff-crossing xtup chords
-c Assumes we are in lower (first) voice of up-to-both beamed xtup
-c that starts with blank rests (notes in upper voice here).
-c
- if (nbrests.gt.0 .and. writebrests) then
- do 7 isk = 1 , nbrests
- notexq = notexq(1:lnote)//chax(92)//'sk'
- lnote = lnote+3
-7 continue
- nbrests = 0
- end if
-c
-c Get 'floor' zmin for figures
-c Note: Will not come thru here on 1st note of unbeamed xtup, so figure height
-c won't be adjusted. If anyone ever needs that, need to duplicate this
-c functionality up above, before exiting.
-c
- if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then
- if (ivx .eq. 1) then
- ivf = 1
- else
- ivf = ivxfig2
- end if
- zmult = 1.2*(multb-1)
- ymin = 100.
- do 3 inb = 1, nnb
- if (isfig(ivf,ipb(inb))) then
- if (ulq(iv,ibc) .eq. 'u') then
- ybot = nolev(iv,ipb(inb))
- else
- ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx)
- * -stemlen-zmult
- end if
- ymin = min(ymin,ybot)
- end if
-3 continue
- maxdrop = ncmid(iv,ipb1)-4-ymin+5.01
- ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop)
- end if
-c
-c Compute ornament levels if needed
-c
- NomOrnLev = ncmid(iv,ipb1)+5
- iorn = 0
- do 8 inb = 1 , nnb
- ip = ipb(inb)
- if (.not.btest(iornq(ivx,ip),23)) go to 8
- if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then
-c
-c letter-dynamic or hairpin ending under down-beamed
-c
- iorn = iorn+1
- ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
- * -1.2*(multb-1)
- ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
- else if (.not.btest(ipl(ivx,ip),10)) then
-c
-c Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F
-c 15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD
-c
-c Non-chord. There IS an ornament. Need ihornb only if upbeam, and if
-c ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.)
-c
- if (ulq(ivx,ibc).eq.'u' .and.
- * iand(iornq(ivx,ipb(inb)),4163566).gt.0) then
- iorn = iorn+1
- iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
- ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
- * +1.2*(multb-1)
- ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
- end if
- else
-c
-c In a chord. Orn may be on main note or non-main or both. Set ihornb if
-c upbeam and highest note has orn, or down beam and lowest. Find 1st chord note
-c
- do 10 icrd1 = 1 , ncrd
- if (iand(255,icrdat(icrd1)) .eq. ip .and.
- * iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11
-10 continue
-11 continue
-c
-c Find outermost note, min or max depending on beam direction ulq. xto is true
-c if there's an ornament on that note. Expand orn list to include ._, since if
-c on extreme chord note in beam, will move.
-c So ornaments are all except 0,4,13 (,g,)
-c
- levx = nolev(ivx,ip)
- xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0
- icrdx = 0
- do 12 icrd = icrd1 , ncrd
- if (iand(255,icrdat(icrd)) .ne. ip .or.
- * iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13
- levc = iand(127,ishft(icrdat(icrd),-12))
- if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or.
- * (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then
- levx = levc
- icrdx = icrd
- xto = iand(icrdorn(icrd),4186094).gt.0
- end if
-12 continue
-13 continue
-c
-c If there's orn on extreme note, do stuff
-c
- if (xto) then
- iorn = iorn+1
- if (ulq(ivx,ibc) .eq. 'u') then
- ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
- * +1.2*(multb-1)
- ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
- else
- ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
- * -1.2*(multb-1)
- ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
- end if
- if (icrdx .eq. 0) then
-c
-c Affected ornament is on main note
-c
- iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
- else
- icrdorn(icrdx) = ibset(icrdorn(icrdx),22)
- end if
- end if
- end if
-8 continue
-c
-c Henceforth nornb will be a counter.
-c
- if (iorn .gt. 0) nornb(ivx)=1
- if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0
- return
- end
- block data
- parameter (nm=24)
- common /comtol/ tol
- common /comtrans/ cheadq
- common /compage/ widthpt,ptheight,hoffpt,voffpt,
- * nsyst,nflb,ibarflb(0:40),
- * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
- * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
- * nistaff(0:40)
- common /cblock/
- * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
- * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
- common /cominbot/ inbothd
- logical usefig
- common /comstart/ facmtr
- character*60 cheadq
- character*120 instrq,titleq,compoq
- logical headlog
- common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
- * inhead
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
- common /combmh/ bmhgt,clefend
- common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
- * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
- * idynda2(99),levhssav(nm),listcresc,listdecresc
- character*128 txtdynq
- logical kbdrests
- common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /comsize/ isize(nm)
-c
- data tol /.001/
- data cheadq
- * /' '/
- data gslfac /9./
- data instrq,titleq,compoq,headlog /3*' ',.false./
-c
-c meter space (pts) = xb4mbr = musicsize*facmtr
-c
- data facmtr /0.55/
- data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt
- * / 1.3333,.4 , .7 , .3 , 0.2 , 2.0 , 1.0 ,
- * .7,.7 ,.9 ,.5 ,2.3 ,1.1 /
- data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac
- * / 1.32 , 2.25 , 0.47 , 0.83 , 0.17 , 0.5 , 1.7 /
- data rtshfac / 1.0 /
- data isize /nm*0/
-c
-c From other
-c
- data ptheight,widthpt,hoffpt,voffpt,
- * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
- * xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh
- * / 740. , 524. , 0., 0.,
- * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12.,
- * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 /
- data fracsys /30*0./
- data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1,
-c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
- * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
- * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3,
- * -0.3,0.3 /
- data kbdrests /.false./,
- * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/
- data EarlyTransOn, LaterInstTrans /2*.false./
- data iInstTrans /nm*0/
- data iTransAmt /nm*0/
- end
- subroutine catspace(space,squez,nnsk)
- parameter (nkb=3999,maxblks=9600)
- common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
- * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
- * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
- common /comtol/ tol
-c logical gotclef
- do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
- if (abs(space-durb(iptr)) .lt. tol) then
- if (abs(squez-sqzb(iptr)) .lt. tol) then
-c
-c Increment pre-existing entry
-c
- nnpd(iptr) = nnpd(iptr)+nnsk
- return
- end if
- end if
-16 continue
-c
-c Didn't find current duration & squez, so add a new entry.
-c No particular reason to keep in order, so add at the end.
-c
- nnpd(nptr(ibarcnt+1)) = nnsk
- durb(nptr(ibarcnt+1)) = space
- sqzb(nptr(ibarcnt+1)) = squez
- nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
- return
- end
- character*1 function chax(n)
-c
-c The only reason for this seemingly do-nothing function is to get around an
-c apparent bug in the Visual Fortran Standard Edition 5.0.A compiler!
-c
- chax = char(n)
- return
- end
- subroutine checkdyn(lineq,iccount,ibar)
- character*128 lineq
- character*1 durq,chax
- character*4 dynsymq
- logical txtdyn
- txtdyn = .false.
-c
-c On entry, iccount is on "D"
-c
- if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c Dynamic text
-c
-
- istart = iccount+2 ! 1 past 1st quote
-3 continue
- iend = index(lineq(istart:128),'"')
- if (lineq(istart+iend-2:istart+iend-2) .eq. '\') then
- istart = iccount+iend+2
- go to 3
- end if
- if (iend .eq. 0) then
- call errmsg(lineq,iccount+1,ibar,
- * 'Dynamic text must be terminated with double quote!')
- call stop1()
- end if
-c
-c Set iccount to character after 2nd ", and set ipm
-c
-c iccount = iccount+iend+2
- iccount = istart+iend
- ipm = index('- +',lineq(iccount:iccount))
- if (ipm .eq. 0) then
- call errmsg(lineq,iccount,ibar,
- * 'Expected "-", "+", or blank here!')
- call stop1()
- end if
- else
-c
-c Expect ordinary dynamic
-c
- do 1 iend = iccount+2 , 128
- ipm = index('- +',lineq(iend:iend))
- if (ipm .gt. 0) go to 2
-1 continue
-2 continue
- if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then
- call errmsg(lineq,iend-1,ibar,
- * 'Wrong length for dynamic mark!')
- call stop1()
- end if
- read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
- * dynsymq
- idno = (index(
- * 'ppppppp pp p mp mf f fp sfz ff fff ffff< > ',
- * dynsymq)+3)/4
- if (idno .eq. 0) then
- call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!')
- call stop1()
- end if
- iccount = iend
- end if
- if (ipm .ne. 2) then
-c
-c There is a vertical shift, have "+" or "-"
-c
- iccount = iccount+1
- if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then
- call errmsg(lineq,iccount,ibar,
- * 'Expected integer here for vertical offset!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- idno = nint(fnum)
- if (idno .gt. 63) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Vertical offset for dynamic mark must be (-63,63)!')
- call stop1()
- end if
- ipm = index('- +',durq)
- if (ipm .eq. 0) then
- call errmsg(lineq,iccount,ibar,
- * 'Expected "+", "-", or blank here!')
- call stop1()
- end if
- if (ipm .ne. 2) then
-c
-c There is a horizontal shift
-c
- iccount = iccount+1
- if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then
- call errmsg(lineq,iccount,ibar,
- * 'Expected number here for horizontal offset!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- idno = nint(10*fnum)
- if (idno .gt. 255) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Horizontal offset for dynamic mark must be (-25.5,25.5)!')
- call stop1()
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibar,
- * 'There should be a blank here!')
- call stop1()
- end if
- end if
-c
-c iccount should be on the blank at the end of the entire symbol
-c
- end if
- return
- end
- subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
-c subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp,
-c * icashft)
- logical found1,iscacc,isarp,btest
- integer icrdat(193)
- found1 = .false.
-c
-c icashft will be max left shift of accid's in chord notes.
-c Used only for spacing checks.
-c Will include left shift of chord note itself.
-c Rezero after use.
-c
- do 18 icrd = 1 , ncrd
-c
-c This if block cycles thru all chord notes on ivx,ip; then returns.
-c
- if (iand(255,icrdat(icrd)) .eq. ip .and.
- * iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then
- found1 = .true.
- iscacc = iscacc .or.
- * (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27))
-c
-c Accid on this chord note, and it's not midi-only.
-c
-c irshft = igetbits(icrdot(icrd),7,20)
-cc
-cc Include increment for notehead shift
-cc
-c if (btest(icrdat(icrd),23)) then
-c if (irshft .eq. 0) then
-c irshft = 44
-c else
-c irshft=irshft-20
-c end if
-c end if
-c if (irshft .ne. 0) then
-cc
-cc Accid on chord note is shifted. Include only left shift, in 20ths.
-cc
-c if (irshft .lt. 64) icashft = max(icashft,64-irshft)
-c end if
-c end if
- isarp = isarp .or. btest(icrdat(icrd),25)
- else if (found1) then
- return
- end if
-18 continue
- return
- end
- subroutine chkimidi(icm)
- parameter (nm=24,mv=24576)
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- if (imidi(icm) .ge. mv) then
- print*
- print*,'Midi file is too long! It will be corrupted or worse'
- write(*,'(a6,2x,4i8)')
- * 'imidi:',imidi(0),imidi(1),imidi(2),imidi(3)
- end if
- return
- end
- subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx,
-c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult)
- * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl)
- parameter (nm=24)
- integer*4 nn(nm),islur(nm,200),irest(nm,200),
- * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8),
- * ivmx(nm,2),mult(nm,200),ipl(nm,200)
-c
-c On 130127 put this code, formerly in make2bar right before calling notex for
-c a single note/rest, into this subroutine, so the same logic could also be
-c with the calls to beamstrt/mid/end to adjust height of rests in xtups if the
-c keyboard rest option is selected
-c
-c mode=1 if called as before, 2 if for an xtup. Only affects check for
-c quarter rests, which will fix later.
-c
-c Get reference level: next following note if no intervening blank rests,
-c otherwise next prior note. Relative to bottom line.
-c
-c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
- if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then
-c
-c Not the last note and not "look-left" for level
-c
- do 8 kkp = ip+1 , nn(ivx)
- if (btest(islur(ivx,kkp),29)) go to 4
- if (.not.btest(irest(ivx,kkp),0)) then
- levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
- go to 9
- end if
-8 continue
- end if
-4 continue
-c
-c If here, there were no following notes or came to a blank rest, or
-c "look-left" option set. So look before
-c
-c if (ip .eq. 1) go to 2 ! Get out if this is the first note.
- if (ip .eq. 1) return ! Get out if this is the first note.
- do 3 kkp = ip-1, 1, -1
- if (.not.btest(irest(ivx,kkp),0)) then
- levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
- go to 9
- end if
-3 continue
-c go to 2 ! Pretty odd, should never be here, but get out if so.
- return ! Pretty odd, should never be here, but get out if so.
-9 continue
-c
-c Find note in other voice at same time
-c
- iupdown = sign(1,ivx-nv-1)
- ivother = ivmx(iv,(3-iupdown)/2)
- tother = 0.
- do 5 kkp = 1 , nib(ivother,ibar)
- if (abs(tother-tnow) .lt. tol) go to 6
- tother = tother+nodur(ivother,kkp)
-5 continue
-c
-c If here, then no note starts in other voice at same time, so set default
-c
- levother = -iupdown*50
- go to 7
-6 continue
-c
-c If here, have just identified a simultaneous note or rest in other voice
-c
- if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
- levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
- else
- if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
-c
-c Rest in other voice has same duration, get out (so defualt spacing is used)
-c
-c go to 2
- return
- end if
- levother = -iupdown*50
- end if
-7 continue
- if (mode.eq.1) then
- indxr = log2(nodur(ivx,ip))+1
- else
-c nodu = 2**(4-(iand(mult(ivx,ip),15)-8))
- indxr = 4-(iand(mult(ivx,ip),15)-8)+1
- end if
- if (iupdown .lt. 0) then
- levtop = levtopr(indxr)
- iraise1 = levother-levtop-3 ! Based on other note
- iraise2 = levnext-levtop ! Based on following note
- if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
- iraise = min(iraise1,iraise2)
- if (mod(iraise+50,2).eq.1 .and.
- * iraise+levtop.gt.-1) iraise = iraise-1
- else
- levbot = levbotr(indxr)
- iraise1 = levother-levbot+3
- iraise2 = levnext-levbot
- if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
- iraise = max(iraise1,iraise2)
- if (mod(iraise+50,2).eq.1 .and.
- * iraise+levbot.le.9) iraise = iraise-1
- end if
- nolev(ivx,ip) = 100+iraise
- return
- end
- subroutine chklit(lineq,iccount,literr)
- character*128 lineq
- character*1 charq,chax
- literr = 0
- itype = 1
-17 call g1etchar(lineq,iccount,charq)
- if (charq .eq. chax(92)) then
- itype = itype+1
- if (itype .gt. 3) then
- literr = 1
- return
- end if
- go to 17
- end if
- lenlit = itype
-18 call g1etchar(lineq,iccount,charq)
- if (charq.eq.chax(92)) then
- call g1etchar(lineq,iccount,charq)
- if (charq .ne. ' ') then
-c
-c Starting a new tex command withing the string
-c
- lenlit = lenlit+2
- if (lenlit .gt. 128) then
- literr = 2
- return
- end if
- go to 18
- end if
- else
- lenlit = lenlit+1
- if (lenlit .gt. 128) then
- literr = 2
- return
- end if
- go to 18
- end if
- return
- end
- subroutine chkpm4ac(lineq,iccount,nacc,moved)
-c
-c Called after getting +/-/</> in a note (not rest). iccount is on the +-<>.
-c Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits
-c 10-16) if < or >, horiz and vert (bits 4-9) if two consecutive signed
-c numbers. If moved=.true., iccount on exit is on end of last number.
-c If moved=.false., iccount still on +/-
-c
- logical moved,ishorz
- character*128 lineq
- character*1 durq
- if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and.
- * index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then
-c
-c Prior char was accid & next is #; this may be start of accidental shift.
-c Must test for "." above in case we get "<" or ">"
-c
- ipm = index('- +< >',lineq(iccount:iccount))-2
- if (lineq(iccount+1:iccount+1).eq.'.' .and.
- * index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then
-c
-c Rare case of [accid][+/-].[letter]. Bail out
-c
- moved = .false.
- return
- end if
- ishorz = ipm .gt. 1
-c
-c Save iccount in case it's not accid shift and we have to reset.
-c
- icsav = iccount
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (ishorz .or. index('+-',durq).gt.0) then
-c
-c This has to be accidental shift. Set vert. shift.
-c
- if (.not.ishorz) then
-c
-c +/- syntax, both shifts set, vertical first
-c
- call setbits(nacc,6,4,int(ipm*fnum+32.5))
- ipm = index('- +',durq)-2
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- else
-c
-c </> syntax, only horiz set
-c
- ipm = ipm-3
- end if
-c
-c Set horiz. shift
-c
- call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35)))
- iccount = iccount-1
- moved = .true.
- else
-c
-c False alarm. Reset everything and flow onward
-c
- moved = .false.
- iccount = icsav
- end if
- else
-c
-c Either prior char was not 'sfn' or next was not digit, so take no action
-c
- moved = .false.
- end if
- return
- end
- subroutine clefsym(isl,notexq,lnote,nclef)
-c
-c Returns string calling Don's TeX macro \pmxclef, for drawing small clefs.
-c
- character*(*) notexq
- character*1 chax
- nclef = iand(ishft(isl,-12),7)
- if (nclef .eq. 0) then
-c
-c treble
-c
- nlev = 2
- else if (nclef .gt. 6) then
-c
-c French violin
-c
- nlev = 0
- else if (nclef .lt. 5) then
-c
-c C-clef
-c
- nlev = 2*nclef-2
- else
-c
-c F-clef
-c
- nlev = 2*nclef-6
- end if
- notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7))
- * //chax(48+nlev)
- lnote = 10
- return
- end
- subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime,
- * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
-c
-c nacc = accidental bitmap for main note
-c naccid = # of accid's in chord
-c micrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c nolevm = level of main note
-c segrb(1|2,.) x|y-coord of right-bdry segment
-c ksegrb(.) internal use; tells what defined this segment
-c -2: Left-shifted notehead
-c -1: Original right boundary
-c 0: Main note accidental
-c icrd: Chord-note accidental
-c isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c icrdot0 = top-down level-rank of main note among accid-notes
-c icrdot(icrd)(27-29) = level rank of chord-note among accid-notes
-c twooftwo will be true 2nd time thru; signal to store shifts w/ notes
-c
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50)
- integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50),
- * isetshft(10),ksegrb0(50)
- logical lasttime,mainnote,twooftwo
- data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 /
- data segar /
-c
-c Fancy sharp boundary. fl,sh,na,dfl,dsh
-c
- * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2,
-c * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. ,
-c meas value for y, natural is 1.6
- * -0.75,-0.20,-0.80,-.75, 0. , .96,-1.04,1.48, .96, 1.2,
- * 0.00,-0.38, 0.00, 0. , 0. ,3.15, 1.64,3.0, 3.15, 0. ,
- * 0. , 0.00, 0. , 0. , 0. , 0. , 2.90, 0. , 0. , 0. ,
- * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. ,
- * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. /
- data segal /
-c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. ,
-cc (meas. value is 3.08) ^^^^
-cc Raise top of flat so it interferes with bottom of sharp
- * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2,
- * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2,
- * 0. ,-1.02, 0.00, 0. , 0. , 0. , 1.04, 3.0, 0. , 0. ,
- * 0. , 0.00, 0. , 0. , 0. , 0. , 2.9 , 0. , 0. , 0. ,
- * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. ,
- * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. /
-c
-c iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6)
-c
- data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 /
-c
-c Set up barrier segrb(iseg,ipoint) to define coords of corner points
-c on stem+notes
-c
- do 11 iseg = 1 , nsegrb0
- segrb(1,iseg) = segrb0(1,iseg)
- segrb(2,iseg) = segrb0(2,iseg)
- ksegrb(iseg) = ksegrb0(iseg)
-11 continue
- nsegrb = nsegrb0
- rmsshift = 0.
- shiftmin = 1000.
- do 1 iwa = 1 , naccid
-c
-c Initialize shift for this note
-c
- shift = 0.
- mainnote = micrd(iwa).eq.0
- isetshft(iwa) = -1
-c
-c Get note level and accidental type
-c
- if (mainnote) then
- nolev = nolevm
- iacctype = iacctbl(igetbits(nacc,3,0))
- else
- nolev = igetbits(icrdat(micrd(iwa)),7,12)
- iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20))
- end if
-c
-c Cycle thru segments on right edge of this accidental
-c
- do 2 isega = 1 , nsegar(iacctype)-1
- ybotaseg = nolev+segar(iacctype,2,isega)
- ytopaseg = nolev+segar(iacctype,2,isega+1)
-c
-c Cycle thru segments of right-hand barrier
-c
- do 3 isegrb = 1 , nsegrb-1
-c
-c Must find all barrier segments that start below ytopseg & end above ybotseg
-c
- if (segrb(2,isegrb) .lt. ytopaseg) then
-c
-c Barrier seg starts below top of accid
-c Check if barrier seg ends above bottom of accid
-c
- if (segrb(2,isegrb+1) .gt. ybotaseg) then
- if (shift .gt.
- * segrb(1,isegrb)-segar(iacctype,1,isega)) then
- shift = segrb(1,isegrb)-segar(iacctype,1,isega)
-c
-c Record the cause of the shift
-c
- isetshft(iwa) = ksegrb(isegrb)
- end if
- end if
-c
-c Does barrier segment end above top of accid seg?
-c
- if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4
- end if
-3 continue
-4 continue
-2 continue
- if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001
- * .and. .not.lasttime) then
-c if (nolev .eq. levmaxacc) then
- if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then
- rmsshift = 1000.
- return
- end if
-c
-c Does the following properly account for left-shifted noteheads?
-c
-c Top-down rank of this note we just shifted
-c
- if (mainnote) then
- irank = icrdot0
- else
- irank = igetbits(icrdot(micrd(iwa)),3,27)
- end if
-c
-c Compare level-rank of this note vs. that of note that caused the shift.
-c This has effect of checking for basic interferences from top down.
-c
-c ksegrb(.) internal use; tells what defined this segment
-c -2: Left-shifted notehead
-c -1: Original right boundary
-c 0: Main note accidental
-c icrd: Chord-note accidental
-c isetshft(i),i=1,naccid: what set shift for this accid, same codes
-c
- if (isetshft(iwa) .lt. 0) then
- iranksetter = 0
- else if (isetshft(iwa) .eq. 0) then
- iranksetter = icrdot0
- else
- iranksetter = igetbits(icrdot(isetshft(iwa)),3,27)
- end if
- if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then
- rmsshift = 1000.
- return
- end if
- end if
- rmsshift = rmsshift+shift**2
- if (lasttime .and. abs(shift).gt..0001) then
- if (mainnote) then
- if (.not.btest(nacc,29)) go to 10
- else
- if (.not.btest(icrdat(micrd(iwa)),29)) go to 10
- end if
-c
-c If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there
-c was a manual shift but auto-shift was zero, will not come thru here, but shift value
-c will be left intact.
-c
- if (mainnote) then
- shift = shift+.05*(igetbits(nacc,7,10)-107)
- else
- shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107)
- end if
-10 continue
- if (twooftwo) then
-c
-c Record the shift for this accidental
-c
- if (shift .lt. -5.35) then
- call printl(' ')
- call printl('WARNING: auto-generated accidental '//
- * 'shift too big for PMX, ignoring')
- else
- ishift = nint(20*(shift+5.35))
- if (mainnote) then
- call setbits(nacc,7,10,ishift)
- else
- call setbits(icrdot(micrd(iwa)),7,20,ishift)
- end if
- end if
- else
-c
-c This is the earlier call to precrd, so need minimum shift
-c
- shiftmin = min(shiftmin,shift)
- end if
- end if
-c
-c Bail out if this is the last accidental to check
-c
- if (iwa .eq. naccid) go to 1
-c
-c Add this accidental to the right barrier! Count down from highest barrier segment,
-c find 1st one starting below top of accid, and first one starting below bot.
-c
- do 5 ibelowtop = nsegrb , 1 , -1
- if (segrb(2,ibelowtop) .lt.
- * nolev+segal(iacctype,2,nsegal(iacctype))) then
- do 9 ibelowbot = ibelowtop , 1 , -1
- if (segrb(2,ibelowbot) .lt.
- * nolev+segal(iacctype,2,1)) go to 6
-9 continue
- print*,'Oops2!'
- call stop1()
- end if
-5 continue
- print*,'Ugh0! in crdaccs'
- call stop1()
-6 continue
- netgain = nsegal(iacctype)-ibelowtop+ibelowbot
-c
-c Shift high segments up
-c
- if (netgain .ge. 0) then
- do 7 isegrb = nsegrb , ibelowtop+1 , -1
- segrb(1,isegrb+netgain) = segrb(1,isegrb)
- segrb(2,isegrb+netgain) = segrb(2,isegrb)
- ksegrb(isegrb+netgain) = ksegrb(isegrb)
-7 continue
-c
-c Set up 1st segment above accid
-c
- segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
- segrb(2,ibelowtop+netgain) =
- * nolev+segal(iacctype,2,nsegal(iacctype))
- ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
- else
-c
-c netgain<0, must remove segments. Use same coding but reverse order,
-c work from bottom up
-c
- segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
- segrb(2,ibelowtop+netgain) =
- * nolev+segal(iacctype,2,nsegal(iacctype))
- ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
- do 12 isegrb = ibelowtop+1 , nsegrb
- segrb(1,isegrb+netgain) = segrb(1,isegrb)
- segrb(2,isegrb+netgain) = segrb(2,isegrb)
- ksegrb(isegrb+netgain) = ksegrb(isegrb)
-12 continue
- end if
-c
-c Insert new segments
-c
- do 8 isega = 1 , nsegal(iacctype)-1
- segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega)
- segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega)
- if (mainnote) then
- ksegrb(ibelowbot+isega) = 0
- else
- ksegrb(ibelowbot+isega) = micrd(iwa)
- end if
-8 continue
-c
-c Update number of barrier segments
-c
- nsegrb = nsegrb+netgain
-cc
-cc Temporary printout for boundary segments as built up
-cc
-c write(15,'()')
-c write(15,'(a/(2f8.2,i5))')' y x kseg',
-c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c write(15,'(a/(2i5))')' micrd isetshft',
-c * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa)
-cc
-1 continue ! next accidental
- if (lasttime .and. .not.twooftwo) then
-c
-c This is the final call on the pre-ask pass, so compute left-shift rqmt.
-c
- icashft = nint(-20*shiftmin)
- end if
-cc
-cc Temporary printout for boundary segments
-cc
-c if (twooftwo) then
-c write(15,'()')
-c write(15,'(a/(2f8.2,i5))')' y x kseg',
-c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
-c write(15,'(a/(2i5))')' micrd isetshft',
-c * (micrd(iwa),isetshft(iwa),iwa=1,naccid)
-c end if
-cc
- return
- end
- subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm,
- * levmaxacc,levminacc,icrdot0,twooftwo,icashft)
-c
-c nacc = accidental bitmap for main note
-c naccid = # of accid's in chord
-c kicrd = array with icrd #'s for notes w/ acc's, 0=>main note
-c nolevm = level of main note
-c
-c This is called once per multi-accidental chord. In here, loop over all
-c permutations of the order of accidental as stored in kicrd. Each time thru
-c loop, call crdacc once, get rms shift. Only save permutation and rms value
-c if it is less than old value.
-c
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
-c
-c Make consistent? 120106
-c integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
- integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
- real*4 segrb0(2,50)
- logical btest,tagged,manual,lshift,twooftwo
-cc
-cc Temporary printout of level-rankings
-cc
-c write(15,'()')
-c do 98 iacc = 1 , naccid
-c if (kicrd(iacc) .eq. 0) then
-c write(15,'(3i5)')nolevm,icrdot0
-c else
-c write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12),
-c * igetbits(icrdot(kicrd(iacc)),3,27)
-c end if
-c98 continue
-cc
-c
-c Initialize right-barrier
-c
- segrb0(1,1) = 0.
- segrb0(2,1) = -1000.
- segrb0(1,2) = 0.
- segrb0(2,2) = 1000.
- nsegrb0 = 2
- ksegrb0(1) = -1
- ksegrb0(2) = -1
-c
-c Search for left-shifted notes, Make up the initial right-barrier, which
-c will be good for all permutations.
-c irest()(27) is set if any notes are left-shifted
-c Must use ALL chord notes, not just ones w/ accid's.
-c
- if (btest(irest,27)) then
- do 15 icrd = icrd1-1, icrd2
- if (icrd .eq. icrd1-1) then
-c
-c Main note
-c
-c lshift = btest(ipl,8)
- lshift = btest(ipl,8) .or. btest(nacc,31)
- if (lshift) nolev = nolevm
- else
-c
-c Chord note
-c
- lshift = btest(icrdat(icrd),23)
-c if (lshift) nolev = igetbits(icrdat(icrd),7,12)
- if (lshift) then
- nolev = igetbits(icrdat(icrd),7,12)
- if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
-c
-c This note is not really shifted, It is the upper of a 2nd with the main
-c note on an upstem, and Main note must be shifted.
-c nacc(31) signals the real truth.
-c
- lshift = .false.
- end if
- end if
- end if
- if (lshift) then
- do 16 isegrb = 1 , nsegrb0-1
- if (segrb0(2,isegrb+1) .gt. nolev-1) then
-c
-c Add this notehead to the right boundary here. Move all higher segs up 2.
-c
- do 17 iiseg = nsegrb0 , isegrb+1 , -1
- segrb0(1,iiseg+2) = segrb0(1,iiseg)
- segrb0(2,iiseg+2) = segrb0(2,iiseg)
- ksegrb0(iiseg+2) = ksegrb0(iiseg)
-17 continue
- go to 18
- end if
-16 continue
-18 continue
-c
-c Insert notehead into list. Set kseg=-2 to signal notehead shift.
-c
- iiseg = isegrb+1
- segrb0(1,iiseg) = -1.2
- segrb0(2,iiseg) = nolev-1.
- ksegrb0(iiseg) = -2
- segrb0(1,iiseg+1) = 0.
- segrb0(2,iiseg+1) = nolev+1.
- ksegrb0(iiseg+1) = -1
- nsegrb0 = nsegrb0+2
- end if
-15 continue
- end if
-c
-c Done setting right barrier for left-shifted noteheads
-c
- tagged = .false.
- manual = .false.
-c
-c Preprocess to check for manual shifts.
-c If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then
-c If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then
-c 1. Auto-shifting proceeds
-c 2. "A"-shifts add to autoshifts
-c 3. non-"A" shifts are ignored!
-c Else (>0 man shifts, none has "A")
-c No auto-ordering, No autoshifts, Observe all manual shifts.
-c End if
-c End if
-c
- maxmanshft = 0
- do 13 i = 1 , naccid
- if (kicrd(i) .eq. 0) then
-c
-c Main note
-c
- manshft = igetbits(nacc,7,10)
- if (manshft .ne. 0) then
- manual = .true.
- if (btest(nacc,29)) then
- tagged = .true.
- else
-c maxmanshft = max(maxmanshft,64-manshft)
- maxmanshft = max(maxmanshft,107-manshft)
- end if
- end if
- else
-c
-c Chord note
-c
- manshft = igetbits(icrdot(kicrd(i)),7,20)
- if (manshft .ne. 0) then
- manual = .true.
- if (btest(icrdat(kicrd(i)),29)) then
- tagged = .true.
- else
-c maxmanshft = max(maxmanshft,64-manshft)
- maxmanshft = max(maxmanshft,107-manshft)
- end if
- end if
- end if
-13 continue
- if (manual) then
- if (tagged) then
-c
-c zero out all untagged shifts
-c
- do 14 i = 1 , naccid
- if (kicrd(i) .eq. 0) then
- if (.not.btest(nacc,29)) call setbits (nacc,7,10,0)
- else
- if (.not.btest(icrdat(kicrd(i)),29))
- * call setbits (icrdot(kicrd(i)),7,20,0)
- end if
-14 continue
- else
-c
-c There are manual shifts but none tagged. Only proceed if "Ao" was entered
-c
- if (.not.btest(nacc,28)) then
- icashft = maxmanshft
- return
- end if
- end if
- end if
- if (btest(nacc,28)) then
-c
-c Take the accidentals in order as originally input, then exit.
-c
- call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true.,
- * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
- return
-c end if
- else if (naccid .eq. 3) then
-c
-c Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd
-c then place in order top, bottom, middle.
-c
- do 20 i = 1 , 3
- if (kicrd(i) .eq. 0) then
- irank = icrdot0
- nolev = nolevm
- else
- irank = igetbits(icrdot(kicrd(i)),3,27)
- nolev = igetbits(icrdat(kicrd(i)),7,12)
- end if
- if (irank .eq. 1 ) then
- micrd(1) = kicrd(i)
- else
- micrd(5-irank) = kicrd(i)
- end if
- if (irank .eq. 2) then
- levmidacc = nolev
- end if
-20 continue
- if (levmaxacc.ne.levmidacc+1 .and.
- * levmidacc.ne.levminacc+1) then
- call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
- * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
- return
- end if
- end if
- rmsmin = 100000.
-c
-c Initialize permutation array
-c
- do 7 i = 1 , naccid
- iperm(i) = i
-7 continue
-c
-c Start looping over permutations
-c
- do 8 ip = 1 , 5041
- if (ip .ne. 1) then
-c
-c Work the magic algorithm to get the next permutation
-c
- do 1 k = naccid-1 , 1 , -1
- if (iperm(k) .le. iperm(k+1)) go to 2
-1 continue
-c
-c If here, we just got the last permutation, so exit the loop over permutations
-c
- go to 10
-2 continue
- do 3 j = naccid , 1 , -1
- if (iperm(k) .le. iperm(j)) go to 4
-3 continue
-4 continue
- it = iperm(j)
- iperm(j) = iperm(k)
- iperm(k) = it
- is = k+1
- do 5 ir = naccid , 1 , -1
- if (ir .le. is) go to 6
- it = iperm(ir)
- iperm(ir) = iperm(is)
- iperm(is) = it
- is = is+1
-5 continue
-6 continue
- end if
-c
-c New we have a permutation. Take icrd values out of kicrd and put them into
-c micrd in the order of the permutation
-c
- do 9 i = 1 , naccid
- micrd(i) = kicrd(iperm(i))
-9 continue
-cc
-cc Temporary printout
-cc
-c write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid)
-cc
- call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false.,
- * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
-cc
-cc Temporary printout
-cc
-c write(15,*)'perm done, rmsshift:',rmsshift
-cc
- if (rmsshift .lt. rmsmin) then
-c
-c Save this permutation, reset minrms
-c
- do 11 i = 1 , naccid
- ipermsav(i) = iperm(i)
- rmsmin = rmsshift
-11 continue
- end if
-8 continue
- print*,'Should not BEEEEEE here!'
- call stop1()
-10 continue
-c
-c Done looping, get info for the final choice
-c
- do 12 i = 1 , naccid
- micrd(i) = kicrd(ipermsav(i))
-12 continue
-cc
-cc Temporary printout
-cc
-c write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid)
-cc
- call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
- * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
- return
- end
- subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut)
- character*1 sq,chax
- character*3 acsymq
- character*8 noteq
- character*79 notexq
- logical btest,caut
- sq = chax(92)
- if (ihshft .eq. -107) ihshft=0
-cc
-cc If main note shifted left, so shift accid. Terminate below, when acc. is done.
-cc
- if (ihshft .ne. 0) then
-c
-c Accid must be shifted horizontally
-c
- if (ihshft .lt. 0) then
- notexq = sq//'loffset{'
- ihshft = -ihshft
- else
- notexq = sq//'roffset{'
- end if
- hshft = .05*ihshft
- if (hshft .lt. 1.) then
- write(notexq(10:12),'(f3.2)')hshft
- lnote = 12
- else
- write(notexq(10:13),'(f4.2)')hshft
- lnote = 13
- end if
- notexq = notexq(1:lnote)//'}{'//sq
- lnote = lnote+3
- else
- notexq = sq
- lnote = 1
- end if
- if (btest(nacc,3)) then
- notexq = notexq(1:lnote)//'big'
- lnote = lnote+3
- end if
- if (caut) then
-c
-c Cautionary accidental. Need to define bigcna,... in pmx.tex
-c
- notexq = notexq(1:lnote)//'c'
- lnote = lnote+1
- end if
- call accsym(nacc,acsymq,lacc)
- notexq = notexq(1:lnote)//acsymq(1:lacc)
- lnote = lnote+lacc
- noleva = nolev
- if (ivshft .ne. 0) noleva = noleva+ivshft-32
- call notefq(noteq,lnoten,noleva,ncm)
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (ihshft .ne. 0) then
-c
-c Terminate horizontal shift
-c
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- return
- end
- subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
- * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
- * dotxtup,nacc,irest)
- parameter (nm=24,mv=24576)
- integer*4 irest(nm,24)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
- integer*2 mmidi,iinsiv
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- logical lowdot,dotxtup
- integer*4 ihornb(nm,24),nornb(nm)
- character*1 ulq(nm,9),chax
- character*7 nosymq
- character*8 noteq
- character*79 notexq,outq
- character*80 soutq
- logical btest,isleft,isright,beamon
- character*79 inameq
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /commidisig/ midisig
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
-c
-c This subr. once produced notexq for entire chord. 10/18/97 altered to write
-c chord notes as we go. 10/22/97 find range of icrd first.
-c 2/25/98 moved rangefinding to precrd so done before slurs, so now
-c on entry, icrd1, icrd2 define range of icrd for this chord.
-c
-c Set counter (for this note) for chord notes present. Set notmain=T.
-c Will test for notmain=.true. in addmidi to tell whether to save pitch.
-c
- nmidcrd = 0
- notmain = .true.
- crdacc = .false.
- do 5 icrd = icrd1 , icrd2
- lnote = 0
- nolev = igetbits(icrdat(icrd),7,12)
-c
-c 3/8/03 save original pitch to use in midi, in case 2nds alter things.
-c
- nolevo = nolev
-c
-c Check for special situations with 2nds (see precrd).
-c
- if (btest(nacc,30) .and. nolev.eq.nolevm-1) then
-c
-c Upstem, 2nd with upper as main, interchange pitches,
-c rt-shift upper (now chord note). Lower (orig chord, now main)
-c if dotted, probably had shifted dot, dot parameters must be moved
-c from chord to main
-c
- nolev = nolevm
- if (btest(icrdat(icrd),26)) then
-c
-c Orig. chord note dot shift, must transfer to main.
-c
- icrdotsav = icrdot(icrd)
- icrdatsav = icrdat(icrd)
- if (btest(irest(ivx,ip),19)) then
-c
-c Main note (upper) had a dot shift, must move it to chord
-c
- call setbits(icrdat(icrd),1,26,1)
- call setbits(icrdot(icrd),7,0,
- * nint(updot(ivx,ndotmv(ivx)+1)*10)+64)
- call setbits(icrdot(icrd),7,7,
- * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64)
-c
-c May need to worry about other chord params (accid shefts etc) later
-c
- else
- icrdat(icrd) = ibclr(icrdat(icrd),26)
- end if
-c
-c We are adding a main note dot shift, so push any later ones back
-c
-
- if (.not.btest(irest(ivx,ip),19)) then
- maxdotmv(ivx) = maxdotmv(ivx)+1
- do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1
- updot(ivx,indm) = updot(ivx,indm-1)
- rtdot(ivx,indm) = rtdot(ivx,indm-1)
-1 continue
- end if
- irest(ivx,ip) = ibset(irest(ivx,ip),19)
- updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64)
- rtdot(ivx,ndotmv(ivx)+1) =
- * 0.1*(iand(127,ishft(icrdotsav,-7))-64)
- end if
- else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
-c
-c Downstem, 2nd with lower as main, interchange pitches,
-c left-shift lower (now chord note). Lower (orig main, now chord)
-c probably had shifted dot, dot parameters must be moved from
-c main to chord
-c
- nolev = nolevm
- if (btest(irest(ivx,ip),19)) then
- icrdotsav = icrdot(icrd)
- icrdatsav = icrdat(icrd)
- icrdat(icrd) = ibset(icrdat(icrd),26)
-c bits in icrdot
-c 0-6 10*abs(vertical dot shift in \internote) + 64
-c 7-13 10*abs(horizontal dot shift in \internote) + 64
-c Assuming >0 for now!
- call setbits(icrdot(icrd),7,0,
- * nint(updot(ivx,ndotmv(ivx)+1)*10)+64)
- call setbits(icrdot(icrd),7,7,
- * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64)
-c
-c Must also set dot shift for (now) main note (orig. chord note).
-c
- if (btest(icrdatsav,26)) then
- updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64)
- rtdot(ivx,ndotmv(ivx)+1) =
- * 0.1*(iand(127,ishft(icrdotsav,-7))-64)
- else
-c
-c No dot move on original chord (now main) note,
-c
- updot(ivx,ndotmv(ivx)+1) = 0.
- rtdot(ivx,ndotmv(ivx)+1) = 0.
- end if
- end if
- end if
-c
-c Lower dot for lower-voice notes?. Conditions are:
-c 1. Dotted time value
-c 2. Lower voice of two
-c 3. Note is on a line
-c 4. Not a rest (cannot be a rest in a chord!)
-c. 5. Flag (lowdot) is set to true
-c
- if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then
- if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then
- if (btest(icrdat(icrd),26)) then
-c
-c Note already in movdot list. Drop by 2.
-c
- call setbits(icrdot(icrd),7,0,
- * igetbits(icrdot(icrd),7,0)-20)
- else
-c
-c Not in list so just move it right now
-c
- call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
- end if
- end if
- end if
- if (btest(icrdat(icrd),26)) then
-c
-c Move the dot. Basic call for chord notes, not main note.
-c
- updotc = 0.1*(iand(127,icrdot(icrd))-64)
- rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64)
- call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3))
- end if
- isleft = btest(icrdat(icrd),23)
- isright = btest(icrdat(icrd),24)
-c
-c Check for ornament in chord.
-c
- if (icrdorn(icrd) .gt. 0) then
- call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq,
- * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,
- * ip,0,beamon,.true.)
- call addstr(outq,lout,soutq,lsout)
- end if
-c
-c Chord-note symbol. First check for breve
-c
- if (nodu .eq. 128) then
- nosymq = chax(92)//'zbreve'
- lsym = 7
- else
-c
-c Not a breve chord. Get first letters in chord-note symbol
-c
- if (isleft) then
- nosymq = chax(92)//'l'
- else if (isright) then
- nosymq = chax(92)//'r'
- else
- nosymq = chax(92)//'z'
- end if
- if (nodu .ge. 64) then
- nosymq = nosymq(1:2)//'w'
- else if (nodu .ge. 32) then
- nosymq = nosymq(1:2)//'h'
- else
- nosymq = nosymq(1:2)//'q'
- end if
- if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then
- lsym = 3
- else if (.not.btest(islur,3) .or. dotxtup) then
-c
-c Single dot
-c
- nosymq = nosymq(1:3)//'p'
- lsym = 4
- else
-c
-c Double dot
-c
- nosymq = nosymq(1:3)//'pp'
- lsym = 5
- end if
- end if
- if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then
-c
-c Accidental and not MIDI-only. Build up bits 0-3 of nacc
-c
- nactmp = igetbits(icrdat(icrd),3,20)
-c
-c Kluge for bigness. Only means 'As' has not been issued
-c
- if (bacfac .ne. 1.e6) nactmp = nactmp+8
- call doacc(igetbits(icrdot(icrd),7,20)-107,
- * igetbits(icrdot(icrd),6,14),
-c * notexq,lnote,nactmp,nolev,ncmid(iv,ip))
-c Get original nolev, not altered to deal with 2nds
- * notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12),
-c * ncmid(iv,ip))
- * ncmid(iv,ip),btest(icrdat(icrd),31))
- notexq = notexq(1:lnote)//nosymq
- crdacc = .true.
- else
- notexq = nosymq
- end if
- lnote = lnote+lsym
-c
-c Get note name (again if accid, due to possible octave jump)
-c
- call notefq(noteq,lnoten,nolev,ncm)
- if (lnoten.eq.1) call addblank(noteq,lnoten)
-c
-c Put in note name
-c
- notexq = notexq(1:lnote)//noteq
- lnote = lnote+lnoten
- if (btest(icrdat(icrd),25)) then
-c
-c Arpeggio signal
-c
- call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout)
- end if
- call addstr(notexq,lnote,soutq,lsout)
- if (ismidi) then
-c
-c Here is where we collect MIDI pitch info for the chord note. By checking
-c notmain, addmidi(...) knows to just compute the
-c pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi()
-c for MAIN note, will put in note codes for all chord notes + main note.
-c
- kv = 1
- if (ivx .gt. iv) kv=2
- nmidcrd = nmidcrd+1
- if (nmidcrd .gt. 20) then
- print*
- print*,'21 chord notes is too many for midi processor'
- call stop1()
- end if
-c
-c Use original saved pitch level, unaltered by 2nds logic.
-c
- call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
- * igetbits(icrdat(icrd),3,20),midisig,1.,
- * .false.,.false.)
- end if
-5 continue
- notmain = .false.
- return
- end
- subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv,
- * beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout)
- parameter (nm=24)
-c
-c Inputs are array *elements* except ihornb,nornb,ulq
-c
- common /commus/ musize,whead20
- common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
- * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
- * idynda2(99),levhssav(nm),listcresc,listdecresc
- character*128 txtdynq
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- logical btest,beamon,upstem,nostem
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- logical fontslur,upslur,WrotePsslurDefaults
- character*1 udqq,chax,ulq(nm,9)
- character*4 dynstrq
- character*5 numpq
- character*48 dyntablq,tempq
- character*79 notexq
- character*80 soutq
- integer*4 ihornb(nm,24),nornb(nm),idynn(10)
- common /comhair/ ihairuse,idhair(nm)
- data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/
- numdyn = 0
-c
-c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values
-c in idynn(1...4)
-c
- do 1 idyn = 1 , ndyn
- ivxtent = iand(idyndat(idyn),15)
- * +16*igetbits(idynda2(idyn),1,10)
- if (ivxtent .eq. ivx) then
- iptent = igetbits(idyndat(idyn),8,4)
- if (iptent .eq. ip) then
- numdyn = numdyn+1
- idynn(numdyn) = idyn
- else if (iptent .gt. ip) then
-c
-c I don't think there are any more possible for this ivx,ip, so exit loop
-c
- go to 2
- end if
- end if
-1 continue
-2 continue
-c
-c At this point there is a list of idyn's in idynn(1...numdyn)
-c Compute level, and stem-dir'n-based horizontal tweaks
-c
- hoffsd = 0.
-c
-c Set upstem to false as default
-c
- upstem = .false.
- if (btest(irest,0)) then
-c
-c It's a rest. Assume it doesn't go below the staff
-c
- lbot = ncm-4
- else if (.not.beamon) then
- if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then
- upstem = .true.
- if (.not.btest(ipl,10)) then
- lbot = min(nolev-1,ncm-4)
- else
- lbot = min(minlev-1,ncm-4)
- end if
- else
- hoffsd = -.5
- if (.not.btest(ipl,10)) then
- lbot = min(nolev-7,ncm-4)
- else
- lbot = min(minlev-7,ncm-4)
- end if
- end if
- else
- if (ulq(ivx,ibmcnt) .eq. 'u') then
- upstem = .true.
- if (.not.btest(ipl,10)) then
- lbot = min(nolev-1,ncm-4)
- else
- lbot = min(minlev-1,ncm-4)
- end if
- else
- hoffsd = -.5
-c
-c 171230 Desperation
-c lbot = ihornb(ivx,nornb(ivx))+1
- if (nornb(ivx).eq.0) then
- lbot = 1
- else
- lbot = ihornb(ivx,nornb(ivx))+1
- end if
- if (lbot .eq. 1) then
-c
-c Kluge for non-beamed, down xtup, for which ihorb was never set.
-c Assumes stem is shortened.
-c
- lbot = nolev-5
- end if
- nornb(ivx) = nornb(ivx)+1
- end if
- end if
- lbot = lbot-5
- jtxtdyn1 = 1
-c
-c Now ready to loop over current dyn's
-c
- do 3 icntdyn = 1 , numdyn
- idynd = idyndat(idynn(icntdyn))
- idynd2 = idynda2(idynn(icntdyn))
- idno = igetbits(idynd,4,12)
-c ivx = iand(15,idynd)
- ivx = iand(15,idynd)+16*igetbits(idynd2,1,10)
-c
-c Build the command into notex in stages. Insert name & rq'd args in order:
-c
-c Command name
-c hpstrt, hpcend, hpdend, pmxdyn
-c ivx
-c X X X
-c level
-c X X X
-c hoff
-c X X X X
-c d-mark
-c X
-c
- if (idno .eq. 0) then
-c
-c Text-dynamic
-c
- notexq = chax(92)//'txtdyn'
- lnote = 7
- else if (idno .le. 12) then
-c
-c Letter-group
-c
- notexq = chax(92)//'pmxdyn'
- lnote = 7
- else if (fontslur) then
- lnote = 7
- if (idno .eq. 13) then
-c
-c Start a font-based hairpin
-c
- notexq = chax(92)//'hpstrt'
- else if (idno .eq. 14) then
-c
-c End crescendo
-c
- notexq = chax(92)//'hpcend'
- else
-c
-c End decrescendo
-c
- notexq = chax(92)//'hpdend'
- end if
-c
-c Put in voice number as ID for font-based hairpin
-c
- if (ivx .le. 9) then
- notexq = notexq(1:lnote)//char(48+ivx)
- lnote = lnote+1
- else if (ivx .le. 19) then
- notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}'
- lnote = lnote+4
- end if
- else
-c
-c Postscript hairpins
-c
- lnote = 7
- if (idno .eq. 13) then
- notexq = chax(92)//'Icresc'
- else if (idno .eq.14) then
- notexq = chax(92)//'Idecresc'
- lnote = 9
- else
- notexq = chax(92)//'Tcresc'
- end if
- if (idno .le. 14) then
-c
-c Get and record ID no for start of ps hairpin
-c Find first unused ID
-c
- do 8 idh = 1 , 24
- if (.not.btest(ihairuse,idh)) go to 9
-8 continue
- call printl('Bad place in putdyn, call Dr. Don')
- call stop1()
-9 continue
- ihairuse = ibset(ihairuse,idh)
- idhair(ivx) = idh
- else
-c
-c Unrecord ID no for end of ps hairpin
-c
- call setbits(ihairuse,1,idhair(ivx),0)
- end if
-c
-c Write ID # for start or end of ps hairpin
-c
- idh = idhair(ivx)
- if (idh .le. 9) then
- notexq = notexq(1:lnote)//char(48+idh)
- lnote = lnote+1
- else if (idh .le. 19) then
- notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}'
- lnote = lnote+4
- end if
- end if
-c
-c Begin setting level
-c
- lbot1 = lbot
- if (idno.gt.0 .and. idno.le.5) then
-c
-c All letters are short so raise a bit.
-c
- lbot1 = lbot1+1
- else if (idno .ge. 13) then
- lbot1 = lbot1+2
- end if
-c
-c Convert so reference is bottom line
-c
- lbot1 = lbot1-ncm+4
- if ((fontslur.and.idno.eq.13) .or.
- * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c Hairpin start. Save level and user-tweak before applying user tweak.
-c
- levdsav(ivx) = lbot1
- levhssav(ivx) = 0
- if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17)
- else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then
-c
-c Hairpin end; Compare level with saved start level before user-tweaks
-c
- lbot1 = min(lbot1,levdsav(ivx))
-c
-c Save pre-tweak level
-c
- lpretweak = lbot1
- end if
-c
-c Check for user-defined vertical tweak
-c
- if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17)
-c
-c Now horizontal stuff
-c
- hoff = hoffsd
-c
-c Some special horizontal tweaks
-c
- if (upstem .and. idno.gt.0 .and.
- * (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4
-c
-c User-defined tweaks
-c
- if (btest(idynd2,0))
- * hoff = hoff+(igetbits(idynd2,9,1)-256)*.1
- if (numdyn .gt. 1) then
-c
-c Horizontal-interaction-based tweaks.
-c
-c Cases:
-c numdyn type1 type2 type3 data used
-c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12)
-c 2 hrpnend wrd-grp - ivowg,hoh2
-c 2 hrpnend hrpnstrt - hoh2h1(1...2)
-c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1
-c
- if (idno.gt.0 .and. idno.le.12) then
-c
-c Word-group, may need vertical tweak to line up.
-c
- lbot1 = lbot1+ivowg(idno)
-c
-c Protecting against hp start-stop on same note
-c
- else if (((fontslur.and.idno.ge.14).or.idno.eq.15)
- * .and. icntdyn.lt.numdyn) then
-c
-c Hairpin ending, check next type
-c
- if ((fontslur .and.
- * igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
- * .or. (.not.fontslur .and.
- * ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
- * .or.
- * (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14))))
- * then
-c
-c Hairpin end then hairpin start, no words, (remember dealing with end now)
-c
- hoff = hoff+hoh2h1(1)
- else
-c
-c Hairpin end then word-group, need idno for w-g to set hp offset
-c
- hoff = hoff +
- * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12))
- end if
-c
-c Protecting against hp start-stop on same note
-c
- else if (icntdyn.gt.1 .and. idno.gt.0 .and.
- * ((fontslur.and.idno.lt.14).or.
- * (.not.fontslur.and.idno.lt.15))) then
-c
-c Hairpin start, check prior type
-c
- if ((fontslur.and.
- * igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14)
- * .or.
- * (.not.fontslur.and.
- * igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15))
- * then
-c
-c Hairpin end then hairpin start, (remember dealing with start now)
-c
- hoff = hoff+hoh2h1(2)
- else
-c
-c Hairpin start after word-group, need idno for w-g to set hp offset
-c
- hoff = hoff+
- * hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12))
- end if
- end if
- end if
-c
-c End of if-block for 2- or 3-way interactions.
-c
- if ((.not.fontslur) .and. idno.ge.13)
-c
-c Slur font and hairpin. Add hoff, and change from \interneote to \qn@width
-c
- * hoff = (hoff+.5)*6./2.5
-c
-c Position corrections all done now. Put in the level.
-c
- if ((fontslur.and.idno.eq.13) .or.
- * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
-c
-c Hairpin start.
-c
- if (.not.fontslur) then
-c
-c Postscript hairpin start...inset placeholder for start level.
-
- notexq = notexq(1:lnote)//'{ }'
- lnote = lnote+5
- end if
- else
-c
-c Insert actual level in all cases except hairpin start
-c Create string with level in it
-c
- if (lbot1 .gt. 9) then
- numpq = '{'
- write(numpq(2:3),'(i2)')lbot1
- numpq = numpq(1:3)//'}'
- lnumpq = 4
- else if (lbot1 .gt. -1) then
- numpq = char(48+lbot1)
- lnumpq = 1
- else if (lbot1 .gt. -10) then
- numpq = '{'
- write(numpq(2:3),'(i2)')lbot1
- numpq = numpq(1:3)//'}'
- lnumpq = 4
- else
- numpq = '{'
- write(numpq(2:4),'(i3)')lbot1
- numpq = numpq(1:4)//'}'
- lnumpq = 5
- end if
-c
-c Level has now been computed and stored in numpq
-c Append the level
-c
- notexq = notexq(1:lnote)//numpq(1:lnumpq)
- lnote = lnote+lnumpq
- end if
- if (abs(hoff) .lt. .001) then
-c
-c No horiz offset
-c
- notexq = notexq(1:lnote)//'0'
- lnote = lnote+1
- else
-c
-c Horizontal tweak
-c
- lform = lfmt1(hoff)
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- write(notexq(lnote+1:lnote+lform),
- * '(f'//chax(48+lform)//'.1)')hoff
- lnote = lnote+lform
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- if (idno .eq. 0) then
-c
-c text-dynamic. Find the string and append it
-c
- do 4 jtxtdyn = jtxtdyn1 , ntxtdyn
-c ivxip = ivx+16*ip
- ivxip = ivx+32*ip
- if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5
-4 continue
- call printl('Abnormal stop in putdyn')
- call stop1()
-5 continue
- ltxtdyn = lenstr(txtdynq(jtxtdyn),128)
-c
-c Font size based on musicsize
-c
-c if (musize .eq. 20) then
-c notexq = notexq(1:lnote)//'{'//char(92)//'medtype'
-c * //char(92)//'it '
-c lnote = lnote+13
-c else if (musize .eq. 16) then
-c notexq = notexq(1:lnote)//'{'//char(92)//'normtype'
-c * //char(92)//'it '
-c lnote = lnote+14
-c else if (musize .eq. 24) then
-c notexq = notexq(1:lnote)//'{'//char(92)//'bigtype'
-c * //char(92)//'it '
-c lnote = lnote+13
-c else if (musize .eq. 29) then
-c notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype'
-c * //char(92)//'it '
-c lnote = lnote+13
-c end if
-c
-c Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line)
-c
- call addstr(notexq(1:lnote),lnote,soutq,lsout)
- if (musize .eq. 20) then
- notexq = '{'//char(92)//'medtype'//char(92)//'it '
- lnote = 13
- else if (musize .eq. 16) then
- notexq = '{'//char(92)//'normtype'//char(92)//'it '
- lnote = 14
- else if (musize .eq. 24) then
- notexq = '{'//char(92)//'bigtype'//char(92)//'it '
- lnote = 13
- else if (musize .eq. 29) then
- notexq = '{'//char(92)//'Bigtype'//char(92)//'it '
- lnote = 13
- end if
-c
- notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)//'}'
- lnote = lnote+ltxtdyn+1
-c
-c Reset jtxtdyn1 just in case >1 txtdyn on same note.
-c
- jtxtdyn1 = jtxtdyn+1
- else if (idno .le. 12) then
-c
-c Letter-group dynamic. Append the letter-group command
-c
- id = 4*idno
- dynstrq = dyntablq(id-3:id)
- id = lenstr(dynstrq,4)
- notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id)
- lnote = lnote+1+id
- end if
- call addstr(notexq(1:lnote),lnote,soutq,lsout)
- if ((.not.fontslur).and.idno.eq.15) then
-c
-c PS slurs on, hairpin is ending. Go back and set height at beginning.
-c Add user-defined tweak to default level
-c
- lbot1 = lpretweak+levhssav(ivx)
- if (lbot1 .gt. 9) then
- numpq = '{'
- write(numpq(2:3),'(i2)')lbot1
- numpq = numpq(1:3)//'}'
- lnumpq = 4
- else if (lbot1 .gt. -1) then
- numpq = char(48+lbot1)
- lnumpq = 1
- else if (lbot1 .gt. -10) then
- numpq = '{'
- write(numpq(2:3),'(i2)')lbot1
- numpq = numpq(1:3)//'}'
- lnumpq = 4
- else
- numpq = '{'
- write(numpq(2:4),'(i3)')lbot1
- numpq = numpq(1:4)//'}'
- lnumpq = 5
- end if
-c
-c Construct string to search backwards for placeholder
-c
- if (idh .le. 9) then
- tempq = 'cresc'//char(48+idh)//'{ }'
- ltemp = 11
- else if (idh .le. 19) then
- tempq = 'cresc'//'{1'//char(38+idh)//'}{ }'
- ltemp = 14
- else
- tempq = 'cresc'//'{2'//char(28+idh)//'}{ }'
- ltemp = 14
- end if
- write(11,'(a)')soutq(1:lsout)//'%'
- lsout = 0
- call backfill(11,tempq,ltemp,
- * tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq)
- end if
-3 continue
-c
-c Shrink arrays, decrease ndyn 111109
-c
- do 6 icntdyn = numdyn, 1 , -1
- do 7 jdyn = idynn(icntdyn) , ndyn-1
- idyndat(jdyn) = idyndat(jdyn+1)
- idynda2(jdyn) = idynda2(jdyn+1)
-7 continue
- ndyn = ndyn-1
-6 continue
- end
- subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl,
- * farend,
- * beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno)
-c
-c ip will be one LESS than current note, for way-after's before bar-end,
-c It is only used to find ig.
-c ig is returned to makeabar in case there's a slur that needs to be ended
-c
- parameter (nm=24)
- logical beamon,stemup
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /comoct/ noctup
- logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft,
- * normsp,farend,fontslur,WrotePsslurDefaults
- real*4 ptgr(37)
- character*80 soutq
- character*128 litq
- character*79 notexq
- character*20 voltxtq
- character*10 figq
- character*8 noteq,noteqGA
- character*3 acsymq
- character*1 sq,chax,udqq,ulq(nm,9)
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- sq = chax(92)
- isgaft = btest(ipl,29)
- iswaft = btest(ipl,31)
- normsp = .not. isgaft
-c
-c Find ig.
-c
- do 120 ig = 1 , ngrace
- if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121
-120 continue
- print*,'Problem finding grace index in dograce'
- stop
-121 continue
- ngs = ngstrt(ig)
- mg = multg(ig)
-c wheadpt1 = wheadpt*fullsize(ivx)
- wheadpt1 = wheadpt*fullsize(instno)
-c
-c For way-after-graces at end of bar, must set the octave.
-c
- if (farend) then
- noctup = 0
- if (ncm .eq.23) noctup = -2
- end if
- if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then
- if (listslur .eq. 16777215) then
- print*
- print*,'You defined the twentyfifth slur, one too many!'
- write(15,'(/,a)')
- * 'You defined the twentyfifth slur, one too many!'
- call stop1()
- end if
-c
-c Slur on fore-grace. Get index of next slur not in use, from 23 down.
-c
- ndxslur = log2(16777215-listslur)
-
- end if
- if (nng(ig) .eq. 1) then
-c
-c Single grace.
-c
- if (normsp) then
-c
-c Anything but GA
-c
- call addstr(sq//'shlft',6,soutq,lsout)
- niptgr = nint(ptgr(ig))
-c
-c Empirical tweak for postscript.
-c
-C if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3)
-c++
- if (niptgr .lt. 10) then
- call addstr(chax(48+niptgr)//'{',2,soutq,lsout)
- else if (niptgr .lt. 100) then
- write(notexq(1:2),'(i2)')niptgr
- call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout)
- else
- print*,
- * 'Call Dr. Don if you really want grace note group > 99 pt'
- stop
- end if
- else
- call addstr(sq//'gaft{1.5}{',11,soutq,lsout)
-c
-c GA. Compute aftshft, for later use.
-c
- aftshft = grafac
- if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac
- aftshft = aftshft*wheadpt
- end if
- if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then
-c
-c Start slur on pre-grace. No accounting needed since will be ended very soon.
-c
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
- if (fontslur) then
- if (upg(ig)) then
- call addstr(sq//'islurd',7,soutq,lsout)
- else
- call addstr(sq//'isluru',7,soutq,lsout)
- end if
- else
-c
-c Start Postscript slur.
-c
- if (upg(ig)) then
- call addstr(sq//'isd',4,soutq,lsout)
- else
- call addstr(sq//'isu',4,soutq,lsout)
- end if
- end if
-c
-c Print slur number, 23-ndxslur
-c
- lnote = 0
- if (23-ndxslur .lt. 10) then
-c notexq = notexq(1:lnote)//chax(59-ndxslur)
- notexq = chax(71-ndxslur)
- lnote = 1
- else if (23-ndxslur .lt. 20) then
-c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
- notexq = '{1'//chax(61-ndxslur)//'}'
- lnote = 4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = 4
- end if
- call addstr(notexq(1:lnote)//noteq(1:lnoten),
- * lnote+lnoten,soutq,lsout)
- if (.not.fontslur) then
-c
-c Horizontal tweaks for postscript slur on single grace
-c
- stemup = .true.
- if (upg(ig)) then
-c
-c Check for up-grace + down stem. Get stem direction
-c
- if (.not.beamon) then
-c
-c Separate note. Get stem direction.
-c
- stemup = udqq(nolev,ncmidx,
- * islur,nvmx,ivx,nv) .eq. 'u'
- else
-c
-c In a beam
-c
- stemup = ulq(ivx,ibmcnt) .eq. 'u'
- end if
-c
-c Stop the shift if whole note
-c
- stemup = stemup .or. tnote.gt.63
- end if
- if (stemup) then
- call addstr('{-.3}',5,soutq,lsout)
- else
- call addstr('{-.8}',5,soutq,lsout)
- end if
- end if
- end if
- if (naccg(ngs) .gt. 0) then
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
-c Save for checking octave shifts in GA
-c
- if (isgaft) then
- lnotenGA = lnoten
- noteqGA = noteq
- end if
-c
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- call accsym(naccg(ngs),acsymq,lacc)
- call addstr(sq//'big'//acsymq(1:lacc)//
- * noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
- end if
- if (slashg(ig)) then
- notexq = sq//'grc'
- lnote = 4
- else if (mg .eq. 0) then
- notexq = sq//'zq'
- lnote = 3
- else
- notexq = sq//'zc'
- do 61 i = 2 , mg
- notexq = notexq(1:i+1)//'c'
-61 continue
- lnote = mg+2
- end if
- if (upg(ig)) then
- notexq = notexq(1:lnote)//'u'
- else
- notexq = notexq(1:lnote)//'l'
- end if
- call addstr(notexq,lnote+1,soutq,lsout)
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
-c
- if (isgaft .and. naccg(ngs).eq.0) then
- lnotenGA = lnoten
- noteqGA = noteq
- end if
-c
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- call addstr(noteq,lnoten,soutq,lsout)
- if (slashg(ig)) call addstr(sq//'off{-'//sq//
- * 'noteskip}',16,soutq,lsout)
-c
-c Above code needed since slashg causes spacing
-c
- if (slurg(ig) .and. (iswaft.or.isgaft)) then
-c
-c Terminate slur on single after-grace
-c
- ndxslur = igetbits(ipl,5,23)
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
- call addstr(sq//'tslur',6,soutq,lsout)
-c
-c Print 24-ndxslur
-c
-c if (11-ndxslur .lt. 10) then
- if (23-ndxslur .lt. 10) then
-c call addstr(chax(59-ndxslur)//noteq(1:lnoten),
- call addstr(chax(71-ndxslur)//noteq(1:lnoten),
- * 1+lnoten,soutq,lsout)
- else if (23-ndxslur .lt. 20) then
- call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
- * 4+lnoten,soutq,lsout)
- else
-c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
- call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
- * 4+lnoten,soutq,lsout)
- end if
- slurg(ig) = .false.
- listslur = ibclr(listslur,ndxslur)
- end if
- call addstr('}',1,soutq,lsout)
-c
-c+++ Try to fix loss of octave with single gaft
-c
- if (isgaft) then
- itrans = 0
- do 1 i = 1 , lnotenGA
- if (noteqGA(i:i) .eq. chax(39)) then
- itrans = itrans+7
- else if (noteqGA(i:i) .eq. chax(96)) then
- itrans = itrans-7
- end if
-1 continue
- if (itrans. eq. -14) then
- call addstr(sq//'advance'//sq//'transpose-14',21,
- * soutq,lsout)
- else if (itrans .eq. -7) then
- call addstr(sq//'advance'//sq//'transpose-7',20,
- * soutq,lsout)
- else if (itrans .eq. 7) then
- call addstr(sq//'advance'//sq//'transpose7',19,
- * soutq,lsout)
- else if (itrans .eq. 14) then
- call addstr(sq//'advance'//sq//'transpose14',20,
- * soutq,lsout)
- end if
- end if
- else
-c
-c Multiple grace. Put in literally. Compute beam stuff
-c
- sumx = 0.
- sumy = 0.
- sumxy = 0.
- sumxx = 0.
- sumyy = 0.
- x = 0.
- do 118 ing = ngs , ngs+nng(ig)-1
- if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac
- y = nolevg(ing)
- sumx = sumx + x
- sumy = sumy + y
- sumxy = sumxy + x*y
- sumxx = sumxx + x*x
- sumyy = sumyy + y*y
- x = x+emgfac
-118 continue
- delta = nng(ig)*sumxx-sumx*sumx
- em = (nng(ig)*sumxy-sumx*sumy)/delta
- islope = nint(0.5*em*gslfac)
- if (iabs(islope) .gt. 9) islope = isign(9,islope)
- beta = (sumy-islope/gslfac*sumx)/nng(ig)
- nolev1 = nint(beta)
-c
-c Back up
-c
- notexq = sq//'settiny'//sq//'off{'
- if (normsp) then
- write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig)
- call addstr(notexq(1:18)//'pt}',21,soutq,lsout)
- finalshift = ptgr(ig)
- else
- aftshft = wheadpt*1.33
- if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5
- write(notexq(14:17),'(f4.1)')aftshft
- call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout)
- end if
-c
-c Start the beam
-c
- notexq = sq//'ib'
- do 119 ing = 2 , mg
- notexq = notexq(1:ing+1)//'b'
-119 continue
- if (upg(ig)) then
- notexq = notexq(1:mg+2)//'u'
- else
- notexq = notexq(1:mg+2)//'l'
- end if
- notexq = notexq(1:mg+3)//'0'
-c
-c Get starting note for beam
-c
- call notefq(noteq,lnoten,nolev1,ncm)
- call addstr(notexq(1:mg+4)//noteq(1:lnoten),
- * mg+4+lnoten,soutq,lsout)
-c
-c Put in the slope
-c
- if (islope .ge. 0) then
- call addstr(chax(48+islope),1,soutq,lsout)
- else
- call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout)
- end if
-c
-c Start a slur on multiple fore-grace
-c
- if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
- if (fontslur) then
- if (upg(ig)) then
- call addstr(sq//'islurd',7,soutq,lsout)
- else
- call addstr(sq//'isluru',7,soutq,lsout)
- end if
- else
-c
-c Need a tweak for postscript slur
-c
- if (upg(ig)) then
- call addstr(sq//'isd',4,soutq,lsout)
- else
- call addstr(sq//'isu',4,soutq,lsout)
- end if
- end if
-c
-c Print 23-ndxslur
-c
- if (23-ndxslur .lt. 10) then
- call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
- * soutq,lsout)
- else if (23-ndxslur .lt. 2) then
- call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
- * 4+lnoten,soutq,lsout)
- else
- call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
- * 4+lnoten,soutq,lsout)
- end if
-c
-c Put in tweak for postscript slur
-c
- if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout)
- end if
-c
-c Put in first note. Call notefq again in case octave changed
-c
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
- if (naccg(ngs) .eq. 0) then
- notexq = sq//'zqb0'//noteq(1:lnoten)
- lnote = 5+lnoten
- else
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- call accsym(naccg(ngs),acsymq,lacc)
- notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten)
- lnote = 4+lacc+lnoten
- call notefq(noteq,lnoten,nolevg(ngs),ncm)
- notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten)
- lnote = lnote+5+lnoten
- end if
- call addstr(notexq,lnote,soutq,lsout)
- do 127 ing = ngs+1 , ngs+nng(ig)-1
-c
-c Skip
-c
- ptoff = wheadpt1*emgfac
- if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac
- if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff
- notexq = sq//'off{'
- write(notexq(6:8),'(f3.1)')ptoff
- if (normsp) finalshift = finalshift-ptoff
- call addstr(notexq(1:8)//'pt}',11,soutq,lsout)
- if (ing .eq. ngs+nng(ig)-1) then
-c
-c Terminate beam if needed
-c
- if (upg(ig)) then
- call addstr(sq//'tbu0',5,soutq,lsout)
- else
- call addstr(sq//'tbl0',5,soutq,lsout)
- end if
-c
-c Terminate after slur if needed
-c
- if ((isgaft.or.iswaft) .and. slurg(ig)) then
-c if (iswaft) ndxslur = igetbits(ipl,4,23)
- if (iswaft) ndxslur = igetbits(ipl,5,23)
- call notefq(noteq,lnoten,nolevg(ing),ncm)
- call addstr(sq//'tslur',6,soutq,lsout)
-c
-c Print 11-ndxslur
-cc Print 23-ndxslur
-c
- if (23-ndxslur .lt. 10) then
- call addstr(chax(71-ndxslur)//noteq(1:lnoten),
- * 1+lnoten,soutq,lsout)
- else if (23-ndxslur .lt. 20) then
- call addstr('{2'//chax(61-ndxslur)//'}'
- * //noteq(1:lnoten),4+lnoten,soutq,lsout)
- else
- call addstr('{1'//chax(51-ndxslur)//'}'
- * //noteq(1:lnoten),4+lnoten,soutq,lsout)
- end if
-c
-c Stop slur terminator after exit from this subroutine
-c
- listslur = ibclr(listslur,ndxslur)
- slurg(ig) = .false.
- end if
- end if
-c
-c Accidental if needed
-c
- if (naccg(ing).gt.0) then
- call notefq(noteq,lnoten,nolevg(ing),ncm)
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- call accsym(naccg(ing),acsymq,lacc)
- call addstr(sq//'big'//acsymq(1:lacc)
- * //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
- end if
-c
-c Put in the (beamed) grace note
-c
- call notefq(noteq,lnoten,nolevg(ing),ncm)
- call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten,
- * soutq,lsout)
-127 continue
-c
-c Terminate the grace
-c
-c notexq = sq//'normalnotesize'//sq//'off{'
-c lnote = 20
-c notexq = '}'//sq//'off{'
-c lnote = 6
- notexq = sq//'off{'
- lnote = 5
- ptoff = wheadpt*emgfac
- if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17))
- * ptoff = ptoff+wheadpt*accfac
- if (isgaft .and. .not.iswaft) then
- notexq = notexq(1:5)//'-'
- lnote = 6
- ptoff = aftshft
- end if
- if (normsp) ptoff = finalshift
- if (ptoff .lt. 9.95) then
- write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff
- lnote = lnote+3
- else if (ptoff .lt. 99.95) then
- write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff
- lnote = lnote+4
- else
- write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff
- lnote = lnote+5
- end if
- call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout)
- if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout)
- call addstr(sq//'resetsize',10,soutq,lsout)
- end if
- return
- end
- subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip,
- * iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur,
- * ipl,iornq,islhgt,tno,nacc)
-c
-c Called once per main note.
-c 12 May 2002 Create this subroutine to isolate postscript slurs/ties.
-c Always set \Nosluradjust\Notieadjust
-c
- parameter (nm=24,mv=24576)
- integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /comsln/ is1n1,is2n1,irzbnd,isnx
- character*1 ulq,slurudq,udfq,udqq,chax
- character*79 notexq
- character*8 noteq
- character*80 soutq
- logical upslur,beamon,btest,stemup,iscrd,
- * settie,fontslur,pstie,WrotePsslurDefaults
- logical slmon,dbltie
- common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
- * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
- * slmon(0:nm),dbltie
- integer*2 mmidi,iinsiv
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
-c 130316
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c Bits in isdat1:
-c 13-17 iv
-c 3-10 ip
-c 11 start/stop switch
-c 12 kv-1
-c 19-25 ichar(code$)
-c 26 force direction?
-
-c 27 forced dir'n = up if on, set in sslur; also
-c final direction, set in doslur when beam is started, used on term.
-c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term.
-c 18 int(ndxslur/16), ditto. So this allows ndxslur>15.
-c 2 stem slur flag
-c 1 flag for "x" slur (voice-independent)
-c
-c Bits in isdat2
-c 0 Chord switch. Not set on main note.
-c 1-2 left/right notehead shift. Set only for chord note.
-c 3 tie positioning
-c 4 dotted flag
-c 6-11 voff1 1-63 => -31...+31
-c 12-18 hoff1 1-127 => -6.3...+6.3
-c 19-25 nolev
-c 26 \sluradjust (p+s)
-c 27 \nosluradjust (p-s)
-c 28 \tieadjust (p+t)
-c 29 \notieadjust (p-t)
-c
-c Bits in isdat3: Only used for slur endings
-c 0 set if midslur (at least one argument)
-c 1 set if curve (2 more args)
-c 2-7 32+first arg (height correction) (1st arg may be negative)
-c 8-10 second arg (initial slope)
-c 11-13 third arg (closing slope)
-c 14-21 tie level for use in LineBreakTies
-c 22-29 ncm for use in LineBreakTies
-c
-c Bits in isdat4 Only used for linebreak slurs
-c 0-5 Linebreak seg 1 voff 1-63 => -31...+31
-c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3
-c 16-21 Linebreak seg 2 voff 1-63 => -31...+31
-c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3
-c
-c In listslur bit ib is on if slur index ib is in use, ib=0-13.
-c ndxslur = slur index
-c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note,
-c s-slur is blank (idcode=32), t-slur is idcode=1.
-c ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c Ivoff will be set for ./_ only if no user-defined shift is specified.
-c If highest note has upslur, save slur height in islhgt in case
-c ornament must be moved.
-c
- islhgt = 0
- if (beamon) then
- stemup = ulq .eq. 'u'
- else if (nvmx(iv) .eq. 2) then
- if (.not.btest(islur,30)) then
-c
-c Single note, 2 lines of music, stem direction not forced
-c
- stemup = ivx .gt. nv
- else
- stemup = btest(islur,17)
- end if
- else
- stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
- end if
- iscrd = btest(ipl,10)
- if (ismidi) then
- settie = .false.
- dbltie = .false.
- end if
- do 1 isdat = 1 , nsdat
- isdata = isdat1(isdat)
- if (iv .eq. igetbits(isdata,5,13) .and.
- * ip .eq. igetbits(isdata,8,3) .and.
-c * kv .eq. igetbits(isdata,1,12)+1) then
- * (kv .eq. igetbits(isdata,1,12)+1 .or.
- * btest(isdata,1))) then
-c
-c Since iv and kv match, ivx will be correct
-c
- idcode = igetbits(isdata,7,19)
- ivoff = igetbits(isdat2(isdat),6,6)-32
- ihoff = igetbits(isdat2(isdat),7,12)-64
- iupdn = 0
- slurudq = 'd'
- nolevs = igetbits(isdat2(isdat),7,19)
- pstie = btest(isdat2(isdat),3) .or. idcode.eq.1
- if (btest(isdata,11)) then
-c
-c Turnon
-c Get slur direction
-c
- if (btest(isdata,26)) then
-c
-c Force slur direction
-c
- if (btest(isdata,27)) slurudq = 'u'
- else if (nvmx(iv) .eq. 1) then
-c
-c Only one voice per line
-c
- if (.not.beamon) then
-c
-c Separate note.
-c
- slurudq = udfq(nolev,ncm)
- else
-c
-c In a beam
-c
- if (ulq .ne. 'u') slurudq = 'u'
- end if
- if (iscrd) then
- if (nolevs .gt. ncm) then
- slurudq = 'u'
- else
- slurudq = 'd'
- end if
- end if
- else
-c
-c Two voices per line. Get default
-c
- if (ivx .gt. nv) slurudq = 'u'
-c
-c Upper voice of the two, so up slur
-c
- end if
- if (btest(isdata,2)) then
-c
-c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment.
-c
- if (stemup) then
- slurudq = 'u'
- ivoff = ivoff+4
- else
- slurudq = 'd'
- ivoff = ivoff-4
- end if
- end if
-c
-c Set level for slur starting on rest
-c
- if (nolevs.eq.0 .or. nolevs.gt.60) then
- if (slurudq .eq. 'u') then
- nolevs = ncm+2
- else
- nolevs = ncm-2
- end if
- end if
-c
-c Save up/down-ness for use at termination
-c
- if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c End of section for setting slur direction, still in "Turnon" if-block.
-c
- if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c Raise or lower slur by one unit provided . or _ is on same side as slur
-c
- ivoffinc = 0
- if ((stemup .and. slurudq.eq.'d') .or.
- * (.not.stemup .and. slurudq.eq.'u')) then
-c
-c Must move the slur for _ or .
-c
- if (stemup) then
- ivoffinc = -1
- else
- ivoffinc = 1
- end if
- if (((stemup .and. nolev.ge.ncm-2) .or.
- * (.not.stemup .and. nolev.le.ncm+2)) .and.
- * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
- ivoff = ivoff+ivoffinc
- end if
- end if
- if (listslur .eq. 16777215) then
- print*
- print*,'You1 defined the twentyfifth slur, one too many!'
- write(15,'(/,a)')
- * 'You defined the twentyfifth slur, one too many!'
- call stop1()
- end if
-c
-c Get index of next slur not in use, starting from 12 down
-c
- ndxslur = log2(16777215-listslur)
-c
-c Record slur index
-c
- listslur = ibset(listslur,ndxslur)
-c
-c Save for use on termination
-c
-c call setbits(isdata,4,28,ndxslur)
-c 080531 Allow >16 slurs
- call setbits(isdata,4,28,mod(ndxslur,16))
- call setbits(isdata,1,18,ndxslur/16)
-c
-c Shift for stem?
-c
- if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then
- if (.not.pstie) then
- ihoff = ihoff+8
- else
- ihoff = ihoff+2
- end if
- end if
- if (iscrd) then
-c
-c Additional horiz shifts for h-shifted noteheads?
-c
- if (btest(isdat2(isdat),1)) then
-c
-c Slur start on left-shifted chord notehead. ASSUME downstem.
-c
- if (nolevs.eq.minlev .and. slurudq.eq.'d') then
- ihoff = ihoff-2
- else
- ihoff = ihoff-10
- end if
- else if (btest(isdat2(isdat),2)) then
-c
-c Right shifted chord notehead. ASSUME upstem.
-c
- if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
- ihoff = ihoff+2
- else
- ihoff = ihoff+10
- end if
- end if
- end if
- notexq = chax(92)
- lnote = 1
-c
-c Check for local adjustment default changes
-c
- if (btest(isdat2(isdat),26)) then
- notexq = chax(92)//'sluradjust'//chax(92)
- lnote = 12
- else if (btest(isdat2(isdat),27)) then
- notexq = chax(92)//'nosluradjust'//chax(92)
- lnote = 14
- else if (btest(isdat2(isdat),28)) then
- notexq = chax(92)//'tieadjust'//chax(92)
- lnote = 11
- else if (btest(isdat2(isdat),29)) then
- notexq = chax(92)//'notieadjust'//chax(92)
- lnote = 13
- end if
- if (ihoff .eq. 0) then
-c
-c Write stuff for non-shifted start
-c
- notexq = notexq(1:lnote)//'islur'//slurudq
- lnote = lnote+6
- else
- notexq = notexq(1:lnote)//'is'//slurudq
- lnote = lnote+3
- end if
-c
-c Prepend postscript tie switch
-c
- if (pstie) then
- notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote)
- lnote = lnote+10
- end if
- if (btest(isdat2(isdat),4)) then
-c
-c Dotted slur
-c
-c noteq = notexq
-c notexq = chax(92)//'dotted'//noteq
- notexq = chax(92)//'dotted'//notexq(1:lnote)
- lnote = lnote+7
- end if
-c
-c Add slur index to string
-c Print 23-ndxslur
-c
- if (23-ndxslur .lt. 10) then
-c
-c 5/25/08 Allow 24 slurs
-c
- notexq = notexq(1:lnote)//chax(71-ndxslur)
- lnote = lnote+1
- else if (23-ndxslur .lt. 20) then
- notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = lnote+4
- end if
-c
-c Add note name to string
-c
- islhgt = nolevs+iupdn+ivoff
- call notefq(noteq,lnoten,islhgt,ncm)
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
-c
-c Store height and staff mid level for use with LineBreakTies
-c
- call setbits(isdat3(isdat),8,14,islhgt)
- call setbits(isdat3(isdat),8,22,ncm)
-c
-c Save height (for ornament and barnobox interference) if topmost slur is up
-c
- if (slurudq.eq.'u' .and.
- * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
- islhgt = nolevs+iupdn+ivoff
-c
-c Save height & idcode if top voice and slur start
-c
- if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
- is1n1 = islhgt
- is2n1 = idcode
- end if
- end if
- if (ihoff .ne. 0.) then
- shift = ihoff*0.1
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- lform = lfmt1(shift)
- write(notexq(lnote+1:lnote+lform),'(f'//
- * chax(48+lform)//'.1)') shift
- lnote = lnote+lform
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- call addstr(notexq,lnote,soutq,lsout)
-c
-c Zero out ip1 to avoid problems if slur goes to next input blk.
-c
- call setbits(isdata,8,3,0)
-c
-c Set slur-on data for midi. Only treat null-index slurs and ps ties for now.
-c
- if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
-c levson(midchan(iv,kv)) = nolevs
-c 130316
- levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
- if (settie) dbltie = .true.
-c
-c Only way settie=T is if we just set a tie ending. So there's also a slur
-c start here, so set a flag telling addmidi not to zero out levson
-c
- end if
- else
-c
-c Slur is ending. Back thru list to find starting slur
-c
- do 3 j = isdat-1 , 1 , -1
- if (iv.eq.igetbits(isdat1(j),5,13) .and.
-c * kv.eq.igetbits(isdat1(j),1,12)+1) then
- * (kv.eq.igetbits(isdat1(j),1,12)+1
- * .or. btest(isdat1(j),1))) then
- if (idcode .eq. igetbits(isdat1(j),7,19)) then
- ndxslur = igetbits(isdat1(j),4,28)
-c
-c 080531 Allow >16 slurs
-c
- * +16*igetbits(isdat1(j),1,18)
- if (btest(isdat1(j),27)) slurudq = 'u'
- go to 4
- end if
- end if
-3 continue
- print*,'Bad place in doslur'
- call stop1()
-4 continue
-c
-c Bugfix 070901 for slur ending on rest in 2-voice staff
-c
- if (nolevs.le.2 .or. nolevs.gt.60) then
-c
-c Ending is on a rest, reset nolevs to default starting height
-c
- nolevs = igetbits(isdat2(j),7,19)
- end if
- if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then
-c
-c Deal with \curve or \midslur. isdat is ending, j is start.
-c
- if (btest(isdat3(isdat),0)) then
- imid = igetbits(isdat3(isdat),6,2)-32
- else
- imid = igetbits(isdat3(j),6,2)-32
- end if
-c
-c Postscript slurs, and \midslur adjustment is needed. Invoke macro
-c (from pmx.tex) that redefines \tslur as r'qd. Tentative mapping:
-c Abs(imid) Postscript slur type
-c 1 f
-c 2-3 default
-c 4 h
-c 5 H
-c 6+ HH
-c
- call addstr(chax(92)//'psforts'//
- * chax(48+min(abs(imid),6)),9,soutq,lsout)
- end if
- if (btest(isdata,2)) then
-c
-c ADjust for stem slur.
-c
- if (stemup) then
- slurudq = 'u'
- ivoff = ivoff+4
- else
- slurudq = 'd'
- ivoff = ivoff-4
- end if
- end if
-c
-c Shift slur ending for stem on any note?
-c
- if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then
- if (.not.pstie) then
- ihoff = ihoff-8
- else
- ihoff = ihoff-3
- end if
- end if
- if (iscrd) then
-c
-c Shift termination for shifted notehead?
-c
- if (btest(isdat2(isdat),1)) then
-c
-c Left-shifted chord notehead. ASSUME downstem.
-c
- if (nolevs.eq.minlev .and. slurudq.eq.'d') then
- ihoff = ihoff-2
- else
- ihoff = ihoff-10
- end if
- else if (btest(isdat2(isdat),2)) then
-c
-c Right shifted chord notehead. ASSUME upstem.
-c
- if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
- ihoff = ihoff+2
- else
- ihoff = ihoff+10
- end if
- end if
- end if
- if (ihoff .eq. 0) then
- notexq = chax(92)//'tslur'
- lnote = 6
- else
-c
-c Shift needed
-c
- notexq = chax(92)//'ts'
- lnote = 3
- end if
-c
-c Switch to postscript tie
-c
- if (pstie) then
- notexq = chax(92)//'tieforts'//notexq(1:lnote)
- lnote = lnote+9
- end if
-c
-c Print 13-ndxslur
-c 5/25/08 Allow 14 slurs
-c
- if (23-ndxslur .lt. 10) then
- notexq = notexq(1:lnote)//chax(71-ndxslur)
- lnote = lnote+1
- else if (23-ndxslur .lt. 20) then
- notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = lnote+4
- end if
- if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c Raise or lower slur by one unit provided . or _ is on same side as slur
-c
- ivoffinc = 0
- if ((stemup .and. slurudq.eq.'d') .or.
- * (.not.stemup .and. slurudq.eq.'u')) then
- if (stemup) then
- ivoffinc = -1
- else
- ivoffinc = 1
- end if
- if (((stemup .and. nolev.ge.ncm-2) .or.
- * (.not.stemup .and. nolev.le.ncm+2)) .and.
- * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
- end if
- ivoff = ivoff+ivoffinc
- end if
- call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
- if (slurudq.eq.'u' .and.
- * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
- islhgt = nolevs+iupdn+ivoff
-c
-c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
- if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
- if (idcode .eq. is2n1) is1n1=0
- end if
- end if
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (ihoff .ne. 0) then
- shift = ihoff*0.1
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- lform = lfmt1(shift)
- write(notexq(lnote+1:lnote+lform),
- * '(f'//chax(48+lform)//'.1)')shift
- lnote = lnote+lform
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- call addstr(notexq,lnote,soutq,lsout)
-c
-c Clear the bit from list of slurs in use
-c
- listslur = ibclr(listslur,ndxslur)
-c
-c Zero out the entire strings for start and stop
-c
- isdata = 0
- isdat2(isdat) = 0
- isdat3(isdat) = 0
- isdat4(isdat) = 0
- isdat1(j) = 0
- isdat2(j) = 0
- isdat3(j) = 0
- isdat4(j) = 0
-c
-c Set midi info for slur ending
-c
- if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
- icm = midchan(iv,kv)
- if (slmon(icm)) then
- if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
- * iand(7,nacc).eq.0) then
-c
-c There is a tie here. NB!!! assumed no accidental on 2nd member of tie.
-c
- levsoff(icm) = nolevs+miditran(instno(iv))
- settie = .true.
- else
- levsoff(icm) = 0
- levson(icm) = 0
- slmon(icm) = .false.
- end if
- end if
- end if
- end if
- isdat1(isdat) = isdata
- end if
-1 continue
-c
-c Clear and collapse the slur data list
-c
- numdrop = 0
- do 2 isdat = 1 , nsdat
- if (isdat1(isdat) .eq. 0) then
- numdrop = numdrop+1
- else if (numdrop .gt. 0) then
- isdat1(isdat-numdrop) = isdat1(isdat)
- isdat2(isdat-numdrop) = isdat2(isdat)
- isdat3(isdat-numdrop) = isdat3(isdat)
- isdat4(isdat-numdrop) = isdat4(isdat)
- isdat1(isdat) = 0
- isdat2(isdat) = 0
- isdat3(isdat) = 0
- isdat4(isdat) = 0
- end if
-2 continue
- nsdat = nsdat-numdrop
-c call report(nsdat,isdat1,isdat2)
- return
- end
- subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv,
- * beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc)
-c
-c Called once per main note. (5/26/02) for non-ps slurs only
-c
- parameter (nm=24,mv=24576)
- integer*4 isdat1(202),isdat2(202),isdat3(202)
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /comsln/ is1n1,is2n1,irzbnd,isnx
- character*1 ulq,slurudq,udfq,udqq,chax
- character*79 notexq
- character*8 noteq
- character*80 soutq
- logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove,
- * settie,fontslur,WrotePsslurDefaults
- logical slmon,dbltie
- common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
- * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
- * slmon(0:nm),dbltie
- integer*2 mmidi,iinsiv
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
-c 130316
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
-c
-c Bits in isdat1:
-c 13-17 iv
-c 3-10 ip
-c 11 start/stop switch
-c 12 kv-1
-c 19-25 ichar(code$)
-c 26 force direction?
-c 27 forced dir'n = up if on, set in sslur; also
-c final direction, set in doslur when beam is started, used on term.
-c 28-31 ndxslur, set in doslur when beam is started, used on term.
-c
-c Bits in isdat2
-c 0 Chord switch. Not set on main note.
-c 1-2 left/right notehead shift. Set only for chord note.
-c 3 tie positioning
-c 4 dotted flag
-c 6-11 voff1 1-63 => -31...+31
-c 12-18 hoff1 1-127 => -6.3...+6.3
-c 19-25 nolev
-c
-c Bits in isdat3: Only used for slur endings
-c 0 set if midslur (at least one argument)
-c 1 set if curve (2 more args)
-c 2-7 32+first arg (height correction) (1st arg may be negative)
-c 8-10 second arg (initial slope)
-c 11-13 third arg (closing slope)
-c
-c In listslur bit ib is on if slur index ib is in use, ib=0-23.
-c ndxslur = slur index
-c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note,
-c s-slur is blank (idcode=32), t-slur is idcode=1.
-c ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
-c Ivoff will be set for ./_ only if no user-defined shift is specified.
-c If highest note has upslur, save slur height in islhgt in case
-c ornament must be moved.
-c
- islhgt = 0
- if (beamon) then
- stemup = ulq .eq. 'u'
- else if (nvmx(iv) .eq. 2) then
- if (.not.btest(islur,30)) then
-c
-c Single note, 2 lines of music, stem direction not forced
-c
- stemup = ivx .gt. nv
- else
- stemup = btest(islur,17)
- end if
- else
- stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
- end if
- iscrd = btest(ipl,10)
- if (btest(islur,1)) then
-c
-c 't'-slur (idcode=1) somewhere on this note. Find it, check height against
-c 's'-slur (idcode=32)
-c
- sfound = .false.
- tfound = .false.
- tmove = .false.
- do 5 isdat = 1 , nsdat
- if (iv .eq. igetbits(isdat1(isdat),5,13) .and.
- * ip .eq. igetbits(isdat1(isdat),8,3) .and.
- * kv .eq. igetbits(isdat1(isdat),1,12)+1) then
- if (.not.tfound) then
- tfound = igetbits(isdat1(isdat),7,19).eq.1
- if (tfound) then
- nolevt = igetbits(isdat2(isdat),7,19)
- isdatt = isdat
- if (sfound) go to 6
- end if
- end if
- if (.not.sfound) then
- sfound = igetbits(isdat1(isdat),7,19).eq.32
- if (sfound) then
- nolevs = igetbits(isdat2(isdat),7,19)
- isdats = isdat
- if (tfound) go to 6
- end if
- end if
- end if
-5 continue
-c
-c Will come thru here if there is a t with no s, so comment out the following
-c print*,'Did not find s+t-slurs in doslur'
-c
-6 continue
- if (sfound .and. tfound)
- * tmove = nolevs.eq.nolevt .and.
-c
-c Check if 2 starts or two stops
-c
- * ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or.
- * (.not.btest(isdat1(isdats),11).and.
- * .not.btest(isdat1(isdatt),11)) )
-c
-c This is a flag for later changing slur level, after we know slur dir'n.
-c
- end if
- if (ismidi) then
- settie = .false.
- dbltie = .false.
- end if
- do 1 isdat = 1 , nsdat
- isdata = isdat1(isdat)
- if (iv .eq. igetbits(isdata,5,13) .and.
- * ip .eq. igetbits(isdata,8,3) .and.
- * kv .eq. igetbits(isdata,1,12)+1) then
-c
-c Since iv and kv match, ivx will be correct
-c
- idcode = igetbits(isdata,7,19)
- ivoff = igetbits(isdat2(isdat),6,6)-32
- ihoff = igetbits(isdat2(isdat),7,12)-64
- iupdn = 0
- slurudq = 'd'
- nolevs = igetbits(isdat2(isdat),7,19)
- if (btest(isdata,11)) then
-c
-c Turnon,
-c
- if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c Note was a rest, cannot start slur on rest.
-c
- print*
- call printl('Cannot start slur on a rest')
- call stop1()
- end if
-c
-c Get slur direction
-c
- if (btest(isdata,26)) then
-c
-c Force slur direction
-c
- if (btest(isdata,27)) slurudq = 'u'
- else if (nvmx(iv) .eq. 1) then
-c
-c Only one voice per line
-c
- if (.not.beamon) then
-c
-c Separate note.
-c
- slurudq = udfq(nolev,ncm)
- else
-c
-c In a beam
-c
- if (ulq .ne. 'u') slurudq = 'u'
- end if
- if (iscrd) then
- if (nolevs .gt. ncm) then
- slurudq = 'u'
- else
- slurudq = 'd'
- end if
- end if
- else
-c
-c Two voices per line. Get default
-c
- if (ivx .gt. nv) slurudq = 'u'
-c
-c Upper voice of the two, so up slur
-c
- end if
-c
-c Save up/down-ness for use at termination
-c
- if (slurudq .eq. 'u') isdata = ibset(isdata,27)
-c
-c End of section for setting slur direction, still in "Turnon" if-block.
-c
- if (idcode.eq.1 .and. tmove) then
- iupdn = 1
- if (slurudq .eq. 'd') iupdn = -1
- end if
- if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c Raise or lower slur by one unit provided . or _ is on same side as slur
-c
- ivoffinc = 0
- if ((stemup .and. slurudq.eq.'d') .or.
- * (.not.stemup .and. slurudq.eq.'u')) then
-c
-c Must move the slur for _ or .
-c
- if (stemup) then
- ivoffinc = -1
- else
- ivoffinc = 1
- end if
- if (((stemup .and. nolev.ge.ncm-2) .or.
- * (.not.stemup .and. nolev.le.ncm+2)) .and.
- * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
- ivoff = ivoff+ivoffinc
- end if
- end if
- if (listslur .eq. 16777215) then
- print*
- print*,'You1 defined the twenty-fifth slur, one too many!'
- write(15,'(/,a)')
- * 'You2 defined the twenty-fifth slur, one too many!'
- call stop1()
- end if
-c
-c Get index of next slur not in use, starting from ? down
-c
- ndxslur = log2(16777215-listslur)
-c
-c Record slur index
-c
- listslur = ibset(listslur,ndxslur)
-c
-c Save for use on termination
-c
-c call setbits(isdata,4,28,ndxslur)
-c 080531 Allow >16 slurs
- call setbits(isdata,4,28,mod(ndxslur,16))
- call setbits(isdata,1,18,ndxslur/16)
-c
-c Shift for stem?
-c
- if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.)
- * ihoff = ihoff+8
- if (btest(isdat2(isdat),3)) then
-c
-c Tie spacing, (slur start)
-c
- if (slurudq.eq.'d') then
- ivoff = ivoff+1
- ihoff = ihoff+8
- else if (slurudq.eq.'u') then
- ivoff = ivoff-1
- if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8
-c
-c (already shifted if (stemup.and.tno.gt.63.) and slurudq='u')
-c
- end if
- end if
- if (iscrd) then
-c
-c Additional horiz shifts for h-shifted noteheads?
-c
- if (btest(isdat2(isdat),1)) then
-c
-c Slur start on left-shifted chord notehead. ASSUME downstem.
-c
- if (nolevs.eq.minlev .and. slurudq.eq.'d') then
- ihoff = ihoff-2
- else
- ihoff = ihoff-10
- end if
- else if (btest(isdat2(isdat),2)) then
-c
-c Right shifted chord notehead. ASSUME upstem.
-c
- if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
- ihoff = ihoff+2
- else
- ihoff = ihoff+10
- end if
- end if
- end if
- if (ihoff .eq. 0) then
-c
-c Write stuff for non-shifted start
-c
- notexq = chax(92)//'islur'//slurudq
- lnote = 7
- else
- notexq = chax(92)//'is'//slurudq
- lnote = 4
- end if
- if (btest(isdat2(isdat),4)) then
-c
-c Dotted slur
-c
- noteq(1:8) = notexq
- notexq = chax(92)//'dotted'//noteq
- lnote = lnote+7
- end if
-c
-c Add slur index to string
-cc Print 11-ndxslur
-c Print 23-ndxslur
-c
-c if (11-ndxslur .lt. 10) then
- if (23-ndxslur .lt. 10) then
-c
-c 5/25/08 Allow 24 slurs
-c
-c notexq = notexq(1:lnote)//chax(59-ndxslur)
- notexq = notexq(1:lnote)//chax(71-ndxslur)
- lnote = lnote+1
- else if (23-ndxslur .lt. 20) then
-c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
- notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = lnote+4
- end if
-c
-c Add note name to string
-c
- call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
-c
-c Save height (for ornament and barnobox interference) if topmost slur is up
-c
- if (slurudq.eq.'u' .and.
- * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
- islhgt = nolevs+iupdn+ivoff
-c
-c Save height & idcode if top voice and slur start
-c
- if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
- is1n1 = islhgt
- is2n1 = idcode
- end if
- end if
- if (ihoff .ne. 0.) then
- shift = ihoff*0.1
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- lform = lfmt1(shift)
- write(notexq(lnote+1:lnote+lform),'(f'//
- * chax(48+lform)//'.1)') shift
- lnote = lnote+lform
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- call addstr(notexq,lnote,soutq,lsout)
-c
-c Zero out ip1 to avoid problems if slur goes to next input blk.
-c
- call setbits(isdata,8,3,0)
-c
-c Set slur-on data for midi. Only treat null-index slurs and ps ties for now.
-c
- if (ismidi .and. idcode.eq.32) then
- levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
- if (settie) dbltie = .true.
-c
-c Only way settie=T is if we just set a tie ending. So there's also a slur
-c start here, so set a flag telling addmidi not to zero out levson
-c
- end if
- else
-c
-c Slur is ending. Back thru list to find starting slur
-c
- do 3 j = isdat-1 , 1 , -1
- if (iv.eq.igetbits(isdat1(j),5,13) .and.
- * kv.eq.igetbits(isdat1(j),1,12)+1) then
- if (idcode .eq. igetbits(isdat1(j),7,19)) then
- ndxslur = igetbits(isdat1(j),4,28)
-c
-c 080531 Allow >16 slurs
-c
- * +16*igetbits(isdat1(j),1,18)
- if (btest(isdat1(j),27)) slurudq = 'u'
- go to 4
- end if
- end if
-3 continue
- print*,'Bad place in doslur'
- call stop1()
-4 continue
- if (nolevs.eq.0 .or. nolevs.gt.60) then
-c
-c Ending is on a rest, reset nolevs to default starting height
-c
- nolevs = igetbits(isdat2(j),7,19)
- end if
- if (btest(isdat3(isdat),0)) then
-c
-c Deal with \curve or \midslur
-c
- imid = igetbits(isdat3(isdat),6,2)-32
-c
-c Remember, only dealing with non-ps slurs
-c
-c Who knows where the following line came from. Removed it 6/30/02 to
-c restore behavior of non-ps slurs to old way
-c if (slurudq .eq. 'd') imid = -imid
-c 3/8/03 added the following
-c
- if (slurudq .eq. 'd') imid = -abs(imid)
-c
- if (btest(isdat3(isdat),1)) then
- notexq = chax(92)//'curve'
- lnote = 6
- else
- notexq = chax(92)//'midslur'
- lnote = 8
- end if
- if (imid.lt.0 .or. imid.gt.9) then
-c
-c Need brackets
-c
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- if (imid .lt. -9) then
- write(notexq(lnote+1:lnote+3),'(i3)')imid
- lnote = lnote+3
- else if (imid.lt.0 .or. imid.gt.9) then
- write(notexq(lnote+1:lnote+2),'(i2)')imid
- lnote = lnote+2
- else
- write(notexq(lnote+1:lnote+1),'(i1)')imid
- lnote = lnote+1
- end if
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- else
-c
-c 1=<imid=<9, no brackets
-c
- notexq = notexq(1:lnote)//char(48+imid)
- lnote = lnote+1
- end if
- if (btest(isdat3(isdat),1)) then
-c
-c \curve; 3 args
-c
- notexq = notexq(1:lnote)
- * //char(48+igetbits(isdat3(isdat),3,8))
- notexq = notexq(1:lnote+1)
- * //char(48+igetbits(isdat3(isdat),3,11))
- lnote = lnote+2
- end if
- call addstr(notexq,lnote,soutq,lsout)
- end if
-c
-c Shift slur ending for stem on any note?
-c
- if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.)
- * ihoff = ihoff-8
- if (btest(isdat2(isdat),3)) then
-c
-c Shift ending for tie spacing
-c
- if (slurudq .eq. 'u') then
- ihoff = ihoff-8
- ivoff = ivoff-1
- else if (slurudq .eq. 'd') then
- ivoff = ivoff+1
- if (stemup.or. tno.gt.63.) ihoff = ihoff-8
- end if
- end if
- if (iscrd) then
-c
-c Shift termination for shifted notehead?
-c
- if (btest(isdat2(isdat),1)) then
-c
-c Left-shifted chord notehead. ASSUME downstem.
-c
- if (nolevs.eq.minlev .and. slurudq.eq.'d') then
- ihoff = ihoff-2
- else
- ihoff = ihoff-10
- end if
- else if (btest(isdat2(isdat),2)) then
-c
-c Right shifted chord notehead. ASSUME upstem.
-c
- if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
- ihoff = ihoff+2
- else
- ihoff = ihoff+10
- end if
- end if
- end if
- if (ihoff .eq. 0) then
- notexq = chax(92)//'tslur'
- lnote = 6
- else
-c
-c Shift needed
-c
- notexq = chax(92)//'ts'
- lnote = 3
- end if
-c
-c Print 23-ndxslur
-c 5/25/08 Allow 14 slurs (???????????)
-c
- if (23-ndxslur .lt. 10) then
- notexq = notexq(1:lnote)//chax(71-ndxslur)
- lnote = lnote+1
- else if (23-ndxslur .lt. 20) then
- notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = lnote+4
- end if
- if (btest(iornq,11).or.btest(iornq,12)) then
-c
-c Raise or lower slur by one unit provided . or _ is on same side as slur
-c
- ivoffinc = 0
- if ((stemup .and. slurudq.eq.'d') .or.
- * (.not.stemup .and. slurudq.eq.'u')) then
- if (stemup) then
- ivoffinc = -1
- else
- ivoffinc = 1
- end if
- if (((stemup .and. nolev.ge.ncm-2) .or.
- * (.not.stemup .and. nolev.le.ncm+2)) .and.
- * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
- end if
- ivoff = ivoff+ivoffinc
- end if
- if (idcode.eq.1 .and. tmove) then
-c
-c t-slur height adjustment
-c
- iupdn = 1
- if (slurudq .eq. 'd') iupdn = -1
- end if
- call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
- if (slurudq.eq.'u' .and.
- * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
- islhgt = nolevs+iupdn+ivoff
-c
-c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
-c
- if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
- if (idcode .eq. is2n1) is1n1=0
- end if
- end if
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (ihoff .ne. 0) then
- shift = ihoff*0.1
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- lform = lfmt1(shift)
- write(notexq(lnote+1:lnote+lform),
- * '(f'//chax(48+lform)//'.1)')shift
- lnote = lnote+lform
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- call addstr(notexq,lnote,soutq,lsout)
-c
-c Clear the bit from list of slurs in use
-c
- listslur = ibclr(listslur,ndxslur)
-c
-c Zero out the entire strings for start and stop
-c
- isdata = 0
- isdat2(isdat) = 0
- isdat1(j) = 0
- isdat2(j) = 0
- isdat3(isdat) = 0
-c
-c Set midi info for slur ending
-c
- if (ismidi .and. idcode.eq.32) then
- icm = midchan(iv,kv)
- if (slmon(icm)) then
- if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
- * iand(7,nacc).eq.0) then
-c
-c There is a tie here. NB!!! assumed no accidental on 2nd member of tie.
-c
- levsoff(icm) = nolevs+miditran(instno(iv))
- settie = .true.
- else
- levsoff(icm) = 0
- levson(icm) = 0
- slmon(icm) = .false.
- end if
- end if
- end if
- end if
- isdat1(isdat) = isdata
- end if
-1 continue
-c
-c Clear and collapse the slur data list
-c
- numdrop = 0
- do 2 isdat = 1 , nsdat
- if (isdat1(isdat) .eq. 0) then
- numdrop = numdrop+1
- else if (numdrop .gt. 0) then
- isdat1(isdat-numdrop) = isdat1(isdat)
- isdat2(isdat-numdrop) = isdat2(isdat)
- isdat3(isdat-numdrop) = isdat3(isdat)
- isdat1(isdat) = 0
- isdat2(isdat) = 0
- isdat3(isdat) = 0
- end if
-2 continue
- nsdat = nsdat-numdrop
-c call report(nsdat,isdat1,isdat2)
- return
- end
- subroutine dotmov(updot,rtdot,soutq,lsout,iddot)
-c
-c iddot = 0 for single dot, 1 for double
-c
- character*80 soutq,notexq
- character*1 sq,chax
- sq = chax(92)
- lfmtup = lfmt1(updot)
- lfmtrt = lfmt1(rtdot)
- write(notexq,'(a37,f'//chax(48+lfmtup)//'.1,a2,f'//chax(48+lfmtrt)
- * //'.1,a15)')
- * sq//'makeatletter'//sq//'def'//sq//'C@Point#1#2{'//sq//
- * 'PMXpt{',updot,'}{',rtdot,'}'//chax(48+iddot)//'}'//sq
- * //'makeatother'
-c
-c Example of string just created:
-c \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\
-c
- lnote = 54+lfmtup+lfmtrt
- call addstr(notexq(1:lnote),lnote,soutq,lsout)
- return
- end
- subroutine dotrill(iv,ip,iornq,noteq,lnoten,notexq,lnote)
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- character*1 chax
- character*8 noteq
- character*79 notexq
- logical tronly,btest
- do 1 itr = 1 , ntrill
- if (iv.eq.ivtrill(itr) .and. ip.eq.iptrill(itr)) go to 2
-1 continue
- print*,'Problem in dotrill. Call Dr. Don'
- stop
-2 continue
- tronly = xnsktr(itr) .lt. 0.01
- if (tronly) then
- notexq = chax(92)//'zcharnote'
- lnote = 10
- else if (btest(iornq,7)) then
- notexq = chax(92)//'Trille'
- lnote = 7
- else
- notexq = chax(92)//'trille'
- lnote = 7
- end if
- notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
- lnote = lnote+lnoten+1
-c
-c Write trill duration to nearest tenth of a noteskip
-c
- if (tronly) then
- notexq = notexq(1:lnote)//chax(92)//'it tr}'
- lnote = lnote+7
- return
- end if
- if (xnsktr(itr) .lt. .95) then
- nfmt = 2
- else if (xnsktr(itr) .lt. 9.95) then
- nfmt = 3
- else
- nfmt = 4
- end if
- write(notexq(lnote+1:lnote+nfmt),'(f'//chax(48+nfmt)//'.1)')
- * xnsktr(itr)
- lnote = lnote+nfmt
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- return
- end
- subroutine endslur(stemup,upslur,nolev,iupdn,ndxslur,ivoff,ncm,
- * soutq,lsout,fontslur)
-c
-c Only called to end slur started in dograce.
-c
- logical shift,stemup,upslur,fontslur
- character*80 soutq
- character*79 notexq
- character*8 noteq
- character*1 chax
- shift = .not.stemup .and. .not.upslur
- if (.not.shift) then
-c
-c No shift needed
-c
- notexq = chax(92)//'tslur'
- lnote = 6
- else
-c
-c Shift needed
-c
- notexq = chax(92)//'ts'
- lnote = 3
- end if
-c if (ndxslur .lt. 10) then
-c notexq = notexq(1:lnote)//chax(48+ndxslur)
-c lnote = lnote+1
-c else
-c notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}'
-c lnote = lnote+4
-c end if
-c
-cc Print 11-ndxslur
-c Print 23-ndxslur
-c
-c if (11-ndxslur .lt. 10) then
- if (23-ndxslur .lt. 10) then
-c notexq = notexq(1:lnote)//chax(59-ndxslur)
- notexq = notexq(1:lnote)//chax(71-ndxslur)
- lnote = lnote+1
- else if (23-ndxslur .lt. 20) then
-c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
- notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
- lnote = lnote+4
- end if
- call notefq(noteq,lnoten,nolev+iupdn+ivoff,ncm)
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- if (shift) then
- if (fontslur) then
- notexq = notexq(1:lnote)//'{-.6}'
- else
- notexq = notexq(1:lnote)//'{-.8}'
- end if
- lnote = lnote+5
- end if
- call addstr(notexq,lnote,soutq,lsout)
- return
- end
- subroutine errmsg(lineq,iccount,ibarno,msgq)
- parameter(nm=24)
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- logical lastchar,fbon,issegno,isheadr,isvolt
- character*128 lineq
- character*78 outq
- character*(*) msgq
- character*1 chax
- common /truelinecount/ linewcom(20000)
- if (iccount .le. 78) then
- outq = lineq(1:78)
- iposn = iccount
- else
- outq = '... '//lineq(55:128)
- iposn = iccount-50
- end if
- print*
- ibarnop = ibarno
- if (linesinpmxmod.eq.0 .or.
- * nline .gt. line1pmxmod+linesinpmxmod) then
-c
-c Error is in main .pmx file
-c
-c nlinep = nline-linesinpmxmod
-c Correct for comments not copied into buffer
- nlinep = linewcom(nline)-linesinpmxmod
- else
-c
-c Error is in include file
-c
- ibarnop = 0
- nlinep = nline-line1pmxmod+1
- call printl(
- * 'ERROR in include file named above, description given below')
- end if
- open(19,file='pmxaerr.dat')
- write(19,'(i6)') nlinep
- close(19)
- ndigbn = max(1,int(log10(ibarnop+.1)+1))
- ndignl = int(log10(nlinep+.1)+1)
- lenmsg = index(msgq,'!')-1
-c
-c Split off msgq(..) since UNIX compilers don't allow concat substring!!!
-c
- write(*,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
- *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
- write(*,'(1x,a)')msgq(1:lenmsg)
- write(15,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
- *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
- write(15,'(a)')msgq(1:lenmsg)
- i10 = iposn/10
- i1 = iposn-10*i10
- write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
- write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
- print*,outq(1:78)
- write(15,'(a)')' '//outq(1:78)
- write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
- write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
- return
- end
- subroutine eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
-c
-c Get elemskips to previous note. Called only for graces, no xtups involved.
-c
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig
- real*4 tstart(80),space(80)
- common /comtol/ tol
- itnd = nint(to(in))
- if (ip.eq.1 .or. itnd.eq.itrpt) then
-c
-c Start of bar or after rpt.
-c
- esk = fbar
- return
- else
- esk = 0.
- itprev = itnd-nodur(ivx,ip-1)
- do 1 iib = ib , 1 , -1
- if (tstart(iib) .lt. itprev+tol) then
-c
-c This is the block
-c
- nnsk = nint(float((itnd-itprev))/space(iib))
- esk = esk+nnsk*feon(space(iib))
- return
- else
- nnsk = nint((itnd-tstart(iib))/space(iib))
- esk = esk+nnsk*feon(space(iib))
- itnd = nint(tstart(iib))
- end if
-1 continue
- end if
- print*,'Problem in eskb4. Send files to Dr. Don'
- stop
- end
- function f1eon(time)
- f1eon = sqrt(time/2)
- return
- end
- function feon(time)
- common /comeon/ eonk,ewmxk
- feon = sqrt(time/2)**(1.-eonk)*ewmxk
- return
- end
- subroutine findbeam(ibmrep,numbms,mapfb)
-c
-c Called once per voice per bar, after setting forced beams.
-c
- parameter (nm=24)
- dimension mask(49,3),nummask(3),eqonly(49,3)
-c integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16),
-c * itr(48),nodue(48)
-c logical short(48),eqonly
- integer numbms(nm),ipr(248),nip1(0:247),nip2(0:247),mapfb(16),
- * itr(248),nodue(248)
- logical short(248),eqonly
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
- common /combeam/ ibmtyp
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtol/ tol
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,
- * isfig,btest
- data nip1,nip2 /496*0/
- data nummask / 29 , 49 , 12 /
- data mask
- * / 65535, 4095, 65520, 255, 65280, 63,
- * 252, 16128, 64512, 15, 240, 3840,
- * 61440, 7, 14, 112, 224, 1792,
- * 3584, 28672, 57344, 3, 12, 48,
- * 192, 768, 3072, 12288, 49152, 20*0 ,
- * 16777215, 65535, 16776960, 4095, 65520, 1048320,
- * 16773120, 255, 65280, 16711680, 63, 252,
- * 16128, 64512, 4128768, 16515072, 15, 60,
- * 240, 3840, 15360, 61440, 983040, 3932160,
- * 15728640, 7, 14, 112, 224, 1792,
- * 3584, 28672, 57344, 458752, 917504, 7340032,
- * 14680064, 3, 12, 48, 192, 768,
- * 3072, 12288, 49152, 196608, 786432, 3145728,
- * 12582912,
- * 4095, 255, 4080, 15, 240, 3840,
- * 3, 12, 48, 192, 768, 3072,
- * 37*0 /
- data eqonly /3*.true.,46*.false.,7*.true.,91*.false./
- ip = 0
- nreal = 0
- itnow = 0
-1 continue
- ip = ip+1
- if (ip .gt. nn(ivx)) go to 9
-11 if (nodur(ivx,ip).eq.0) then
-c
-c Ignore all xtup notes except the last, the one with nodur > 0 .
-c Xtups are irrelevant here since they are already all in forced beams.
-c Will update itnow by nodur at the END of this loop
-c
- ip = ip+1
- go to 11
- end if
- nreal = nreal+1
- nodue(nreal) = nodur(ivx,ip)
- short(nreal) = nodue(nreal).lt.16 .and.
- * .not.btest(irest(ivx,ip),0)
-c
-c Rule out notes that have 'alone'-flag set
-c
- * .and..not.btest(islur(ivx,ip),18)
- ipr(nreal) = ip
- itr(nreal) = itnow
- if (nodue(nreal) .eq. 1) then
-c
-c 64th gap
-c
- if (mod(itnow,2) .eq. 0) then
-c
-c Start of 32nd gap, lump with following note
-c
- ip = ip+1
- nodue(nreal) = 1+nodur(ivx,ip)
- itnow = itnow+nodue(nreal)
- else
-c
-c End of 32nd gap, lump with preceeding note
-c
- nreal = nreal-1
- nodue(nreal) = 1+nodue(nreal)
- itnow = itnow+1
- end if
- else
- itnow = itnow+nodur(ivx,ip)
- end if
- go to 1
-9 continue
- ir1 = 1
- itseg = lenbar/ibmrep
- do 13 irep = 1 , ibmrep
-c
-c Set bitmaps for all shorts neighbored by a short. Each bit represents a
-c span of 32nd note. maps, mapm, mape record start, full duration, and end
-c of consecutive span of beamable (<1/4) notes.
-c
- maps = 0
- mapm = 0
- mape = 0
- itend = itseg*irep
- itoff = itend-itseg
- do 2 ir = ir1 , nreal
- it2 = itr(ir)+nodue(ir)-2
- if (it2 .ge. itend) then
- ir1 = ir
- go to 14
- end if
-c if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal
- if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or.
- * (ir.lt.nreal.and.short(ir+1)))) then
- ib1 = (itr(ir)-itoff)/2
- ib2 = (it2-itoff)/2
- if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or.
- * min(ib1,ib2).lt.0) return
-c
-c Must have an odd number obe beats in a long bar. Auto-beam won't work
-c
- nip1(ib1) = ipr(ir)
- nip2(ib2) = ipr(ir)
-c
-c nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip
-c
- maps = ibset(maps,ib1)
- mape = ibset(mape,ib2)
- do 3 ib = ib1 , ib2
- mapm = ibset(mapm,ib)
-3 continue
- end if
-2 continue
-14 continue
- if (mapm .eq. 0) go to 13
-c
-c Zero out bits from forced beams
-c
- maps = iand(maps,not(mapfb(irep)))
- mapm = iand(mapm,not(mapfb(irep)))
- mape = iand(mape,not(mapfb(irep)))
-c
-c Compare map with template.
-c
- do 4 it = 1 , nummask(ibmtyp)
- masknow = mask(it,ibmtyp)
- if (iand(masknow,mapm) .eq. masknow) then
-c
-c Find least significant bit in the mask to check start time
-c
- mtemp = masknow
- maskm = masknow
- do 5 is1 = 0 , 47
- if (iand(1,mtemp) .eq. 1) go to 6
- mtemp = ishft(mtemp,-1)
-5 continue
-6 continue
- if (iand(ishft(1,is1),maps) .eq. 0) go to 4
-c
-c is1 is the bit where the beam starts. Continue shifting to
-c find most significant bit in the mask to check ending time
-c
- do 7 is2 = is1 , 47
- mtemp = ishft(mtemp,-1)
- if (iand(1,not(mtemp)) .eq. 1) go to 8
-7 continue
-8 continue
-c
-c is2 is now the bit on which the beam ends.
-c
- if (iand(ishft(1,is2),mape) .eq. 0) go to 4
-c
-c Did we pick out a single note from the middle of a longer sequence?
-c
- if (nip1(is1) .eq. nip2(is2)) go to 4
-c
-c We almost have a beam. Check equality of notes if needed.
-c
- if (eqonly(it,ibmtyp)) then
- do 10 ip = nip1(is1) , nip2(is2)
- if (nodur(ivx,ip) .ne. 8) then
-c
-c There is a non-1/8th note in this beam. Exit if not 2 quarters
-c
- if (is2-is1 .ne. 15) go to 4
-c
-c Beam is 2 quarters long. Check if can split in half.
-c
- ithalf = 0
- do 20 iip = nip1(is1) , nip2(is2)
- ithalf = ithalf+nodur(ivx,iip)
- if (ithalf .gt. 16) go to 4
- if (ithalf .eq. 16) go to 21
-20 continue
- print*,'Problem in findbeam, please call Dr. Don'
- go to 4
-21 continue
-c
-c Otherwise, split in half by keeping only the first half. Other half will
-c be picked up later, assuming masks are listed longest first.
-c
- is2 = is1+7
-c
-c Reset maskm (since only used part of mask), used later to zero out
-c bits that contain beams
-c
- maskm = 0
- do 15 is = is1 , is2
- maskm = ibset(maskm,is)
-15 continue
- go to 16
- end if
-10 continue
- end if
-16 continue
-c
-c This is a beam. If last "effective" ends on odd 64th, add 1 more
-c
-c if (abs(mod(to(iand(255,ipl(ivx,nip2(is2))))
-c * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then
- if (abs(amod(to(ipl2(ivx,nip2(is2)))
- * +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then
- nip2(is2) = nip2(is2)+1
- end if
- numbms(ivx) = numbms(ivx)+1
- numnew = numbms(ivx)
- call logbeam(numnew,nip1(is1),nip2(is2))
-c
-c Zero out the appropriate bits so these notes don't get used again
-c
- mapm = iand(mapm,not(maskm))
- if (mapm.eq.0) go to 13
- maps = iand(maps,not(maskm))
- mape = iand(mape,not(maskm))
- end if
-4 continue
-13 continue
- return
- end
- subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
- parameter (nkb=3999,maxblks=9600)
-c
-c Compute an exponent eonk for use in the "flattened" formula for elemskips
-c vs time. We must solve the eqution f = 0. Initial quess is eonk0.
-c
-c logical gotclef
- common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
- * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
- * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
- common /comtol/ tol
- common /comeon/ eonk,ewmxk
- eonk = eonk0
- niter = 0
-1 continue
- ewmxk = f1eon(dtmax)**eonk
- niter = niter+1
- esum = 0.
- desum = 0.
- do 2 iptr = nptr1 , nptr2
- targ = durb(iptr)/sqzb(iptr)
- esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ)
- detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ)
- desum = desum+nnpd(iptr)*sqzb(iptr)*detarg
-2 continue
- f = wovera*feon(dtmin)-xelsk-esum
- fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin)
- * -desum
- if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then
- call printl(
- * 'Error in findeonk. Please send source to Dr. Don')
- eonk = 0.
- ewmxk = 1.
- return
- end if
- dsoln = -f/fp
- if (abs(dsoln) .lt. .1*tol) return
-c
-c Not converged yet, try again
-c
- eonk = eonk+dsoln
- go to 1
- end
- function fnote(nodur,ivx,ip,nacc)
-c
-c This return the real duration of a note
-c
- parameter (nm=24)
- integer*4 nodur(nm,200),nacc(nm,200)
- logical btest
- ipback = ip
- if (nodur(ivx,ip) .gt. 0) then
- if (ip .gt. 1) then
-c
-c Check if this is last note of xtup
-c
- if (nodur(ivx,ip-1).eq.0) then
- ipback = ip-1
- go to 2
- end if
- end if
- fnote = nodur(ivx,ip)
- return
- end if
-2 continue
-c
-c Count back to prior non zero note. Start at ip to avoid neg index if ip=1.
-c Count how many doubled xtups notes there are from ip-1 to first note.
-c
- ndoub = 0
- do 1 ip1m1 = ipback , 1 , -1
- if (nodur(ivx,ip1m1) .gt. 0) go to 4
- if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1
-1 continue
-4 continue
-c
-c count forward to next non-0 nodur. Start at ip in case last note of xtup.
-c
- do 3 iip = ip , 200
-c
-c Count doubled xtup notes from ip to end.
-c
- if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1
- if (nodur(ivx,iip) .gt. 0) then
-c fnote = nodur(ivx,iip)/float(iip-ip1m1)
- fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub)
- if (btest(nacc(ivx,ip),18)) then
- fnote = 2*fnote
- else if (btest(nacc(ivx,ip),27)) then
- fnote = 1.5*fnote
- else if (ip .gt. 1) then
- if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote
- end if
- return
- end if
-3 continue
- print*,' '
- call printl
- * ('Probable misplaced barline or incorrect meter, stopping')
- print*,'ivx,ip:',ivx,ip
- call stop1()
- end
- subroutine g1etchar(lineq,iccount,charq)
- parameter(nm=24)
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- logical lastchar,issegno,isheadr,isvolt,fbon
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- logical mrecord,mplay,endmac
- character*1 charq
- character*128 lineq,lnholdq
-c
-c Gets the next character out of lineq*128. If pointer iccount=128 on entry,
-c then reads in a new line. Resets iccount. Ends program if no more input.
-c
- if (iccount .eq. 128) then
- call read10(lineq,lastchar)
- if (lastchar) return
- if (.not.endmac) then
- iccount = 0
- if (.not.mplay) nline = nline+1
- else
- endmac = .false.
- iccount = icchold
- lineq = lnholdq
- end if
- if (mrecord) then
- call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
- end if
- end if
- iccount = iccount+1
- charq = lineq(iccount:iccount)
- return
- end
- subroutine g1etnote(loop,ifig,optimize,fulltrans)
- parameter (nm=24,nkb=3999,mv=24576,maxblks=9600)
- character*1 chax
- logical twotrem
- common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
- * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
- * nbars,itsofar(nm),nib(nm,15),nn(nm),
- * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
- common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
- * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
- * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- common /compage/ widthpt,ptheight,hoffpt,voffpt,
- * nsyst,nflb,ibarflb(0:40),
- * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
- * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
- * nistaff(0:40)
- common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
- common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
- * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
- logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend,
- * isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt,
- * stickyS
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- common /commus/ musize,whead20
- logical mrecord,mplay,endmac,shifton,gotclef,optimize
- character*128 lineq,lnholdq
- character*1 charq,dotq,dumq,durq,charlq
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- logical novshrinktop,upslur,fontslur,ztrans,
- * WrotePsslurDefaults,cstuplet
- common /comnvst/ novshrinktop,cstuplet
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- character*51 literq(3),lyrerq(5)
- common /comligfont/ isligfont
- logical isligfont
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- logical fulltrans
- common /comsize/ isize(nm)
- common /commidisig/ midisig
- common /comis4bignv/ is4bignv,AIset
- logical is4bignv,AIset
- common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
- * poefa
- real*4 poefa(125)
- logical nocodabn
- data literq
- * /'Literal TeX string cannot start with 4 backslashes!',
- * 'TeX string must have <129 char, end with backslash!',
- * 'Type 2 or 3 TeX string can only start in column 1!'/
- data lyrerq
- * /'pmxlyr string must end with " followed by blank!',
- * 'pmxlyr string cannot extend past position 120!',
- * 'There must be "a" or "b" here!',
- * 'There must be "+" or "-" here!',
- * 'There must be an integer here!'/
- cdot = .false.
- twotrem = .false.
-1 call g1etchar(lineq,iccount,charq)
- if (charq .ne. ' ') charlq = charq
- if (lastchar) then
- if (index('/%',charlq) .eq. 0) then
- print*
- print*,'WARNING:'
- print*,'Last non-blank character is "',charlq,'", not "/,%"'
- print*,'ASCII code:',ichar(charlq)
- write(15,'(/a)')'Last non-blank character is "'//charlq//
- * '", not "/,%"'
- write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq)
-c
-c Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1.
-c
- ilbuf = ilbuf-1
- lbuf(ilbuf) = lbuf(ilbuf)+2
- bufq = bufq(1:ipbuf)//' /'
- write(15,*)'appending <blank>/'
- print*,'appending <blank>/'
- lineq = lineq(1:iccount)//' /'
- lastchar = .false.
- go to 1
- end if
- return
- end if
- if (charq .eq. ' ') then
- go to 1
- else if (charq.eq.'%' .and. iccount.eq.1) then
- iccount = 128
- go to 1
-c
-c Replacement 1/22/12 since gfortran 4.7 with -O was choking here!
-c
-c else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
- else if (index('abcdefg',charq).gt.0 .or.
- * charq.eq.'r') then
-c
-c This is a note/rest. gotclef is only used for checking for clef before "/"
-c
- if (cdot) go to 28
-c if (gotclef) gotclef=.false.
- idotform = 0
- numnum = 0
- plusmin = .false.
-28 nnl(ivx) = nnl(ivx)+1
- if (nnl(ivx) .gt. 200) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '>200 notes in line of music. Use smaller blocks!')
- call stop1()
- end if
- dotq = 'x'
-c
-c Check if this is 'r ' and previous note was full-bar-pause
-c
- fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' '
- * .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and.
- * nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar
-2 call g1etchar(lineq,iccount,durq)
- ic = ichar(durq)
- if (ic.le.57 .and. ic.ge.48) then
-c
-c Digit
-c
- if (numnum .eq. 0) then
- nnodur = ic-48
- numnum = 1
- go to 2
- else if (numnum .eq. 1) then
- if (charq .eq. 'r') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only one digit allowed after rest symbol "r"!')
- call stop1()
- end if
- numnum = 2
- if (plusmin) then
- print*
- print*,'*********WARNING*********'
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Before version 1.2, +/- was ignored if octave was!')
- print*,
- * 'explicitly specified. May need to edit old editions'
- end if
- go to 2
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '>2 digits in note symbol!')
- call stop1()
- end if
- else if (durq.eq.'d') then
- dotq = durq
- if (lineq(iccount+1:iccount+1) .eq. 'd') then
- iddot = 1
- iccount = iccount+1
-c
-c Since we flow out, double dots won't work with other dot options
-c
- end if
- if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c move a dot, provided a number follows.
-c
- call g1etchar(lineq,iccount,durq)
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789-.',durq) .eq. 0) then
-c
-c Backup, exit the loop normally
-c
- iccount = iccount-2
- go to 2
- end if
- call readnum(lineq,iccount,dumq,fnum)
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift also
-c
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789-.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected number after 2nd +/- (shift dot)!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- end if
- iccount = iccount-1
- end if
- go to 2
- else if (index('<>',durq) .gt. 0) then
-c
-c Accidental shift
-c
-c if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
- if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
-c * 'Expected "f", "s", or "n" before "<" or ">"!')
- * 'Expected "f", "s", "n" or "A" before "<" or ">"!')
- call stop1()
- end if
- ipm = 1
- if (durq .eq. '<') ipm=-1
- call g1etchar(lineq,iccount,durq)
- if (index('123456789.0',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected number after </> (accidental shift)!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- fnum = ipm*fnum
- if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Horizontal accidental shift must be >-5.35 and <1.0!')
- call stop1()
- end if
- iccount = iccount-1
- go to 2
- else if (index('+-',durq) .gt. 0) then
- if (charq .ne. 'r') then
- if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then
- ipm = 1
- if (durq .eq. '-') ipm=-1
- if (index('0123456789',lineq(iccount+1:iccount+1))
- * .gt.0) then
-c
-c This may be start of accidental shift, but may be octave jump; then duration
-c
- icsav = iccount
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (index('+-',durq) .gt. 0) then
-c
-c This is an accid shift since there's a 2nd consecutive signed number.
-c Check size of 1st number.
-c
- if (fnum .gt. 30.5) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Vertical accidental shift must be less than 31!')
- call stop1()
- end if
- ipm = 1
- if (durq .eq. '-') ipm = -1
- call g1etchar(lineq,iccount,durq)
- if (index('1234567890.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected 2nd number of accidental shift)!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- fnum = ipm*fnum
- if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Horiz. accidental shift must be >-5.35 and <1.0!')
- call stop1()
- end if
- iccount = iccount-1
- go to 2
- else
-c
-c Not accid shift, reset, then flow out
-c
- iccount = icsav
- end if
- end if
- end if
- plusmin = .true.
- if (numnum .eq. 2) then
- print*
- print*,'*********WARNING*********'
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Before version 1.2, +/- was ignored if octave was!')
- print*,
- * 'explicitly specified. May need to edit old editions'
- end if
- go to 2
-c
-c It's a rest containing +|- . Must refer to a vertical shift. Read past.
-c
- else
- call g1etchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,dum)
- if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1
- iccount = iccount-1
- go to 2
- end if
-c else if (index('ulare',durq) .gt. 0) then
- else if (index('ularec',durq) .gt. 0) then
- go to 2
- else if (index('LS',durq) .gt. 0) then
-c
-c Stemlength change
-c
- call g1etchar(lineq,iccount,durq)
- if (index('.0123456789:',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be a number or colon here!')
- call stop1()
- end if
- if (durq .eq. ':') then
- if (.not.stickyS) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Turned off sticky stemlegth changes without turning on!')
- call stop1()
- end if
- stickyS = .false.
- go to 2
- end if
- call readnum(lineq,iccount,durq,dum)
-c if (dum.lt..5 .or. dum.gt.4.) then
- if ((durq.eq.'L'.and.dum.gt.20.).or.
- * (durq.eq.'S'.and.dum.gt.4.)) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Stemlength change amount too big!')
- call stop1()
- end if
- if (durq .ne. ':') then
- iccount = iccount-1
- else
- if (stickyS) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Turned on sticky stemshrinks when already on!')
- call stop1()
- end if
- stickyS = .true.
- end if
- go to 2
- else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c MUST come right after "f,s,n"
-c
- if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
- go to 2
- else if (durq .eq. 'p') then
- fulbrp = charq.eq.'r'
- if (.not. fulbrp) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'The option "p" only works with "r" (rest)!')
- call stop1()
- end if
- go to 2
- else if (durq .eq. 'b') then
- if (charq .ne. 'r') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'You entered "b"; I expected "rb"!')
- call stop1()
- else if (numnum .eq. 2) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'You entered "r" & "b" with two numbers!')
- end if
- go to 2
- else if (durq .eq. 'x') then
-c
-c Xtuplet. Count number of doubled notes (for unequal xtups)
-c
- if (btest(nacc(ivx,nnl(ivx)),18)) then
- ndoub = 1
- else
- ndoub = 0
- end if
-c
-c Will set all durations to 0 except last one.
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789T',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'First char after "x" in xtuplet must be "1"-"9" or "T"!')
- call stop1()
- end if
- if (durq .eq. 'T') then
-c
-c Set a flag for checking 2nd note inputs if dot is moved
-c
- twotrem = .true.
-c
-c Check all x-tremolo inputs here; set fnum=2
-c
- fnum = 2
- call getchar(lineq,iccount,durq)
- if (index('0123 ',durq).eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'First char after "T" in xtuplet must be "0"-"3" or blank!')
- call stop1()
- else if (durq .ne. ' ') then
- call getchar(lineq,iccount,durq)
- if (index('0123 ',durq).eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This char must be "0"-"3" or blank!')
- call stop1()
- else if (durq .ne. ' ') then
- call getchar(lineq,iccount,durq)
-c
-c Probably blank unles other options entered
-c
- end if
- end if
- else
-c
-c durq is digit, normal xtup
-c
- call readnum(lineq,iccount,durq,fnum)
-c
-c Leaves durq at next char after number
-c
- if (fnum .gt. 99) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Xtuplet cannot have more than 99 notes!')
- call stop1()
- else if (index(' DFnd',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only legal characters here are " ","D","F","n"!')
- call stop1()
- end if
- end if
-c
-c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n.
-c
- if (index('DF',durq) .gt. 0) then
-c
-c Double xtup note to make an un= xtup. Here, number already set, but may also
-c have used this before number was set.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- ndoub = 1
- call g1etchar(lineq,iccount,durq)
- else if (durq .eq. 'd') then
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
- call g1etchar(lineq,iccount,durq)
- end if
- if (durq .eq. 'n') then
-c
-c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'.
-c
- numshft = 0
-30 call g1etchar(lineq,iccount,durq)
- if (durq .eq. 'f') then
- go to 30
- else if (index('+-',durq) .gt. 0) then
- numshft = numshft+1
- if (numshft .eq. 3) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only 2 shifts are allowed after "n" in xtup!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This character should be a digit or "."!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,snum)
- iccount = iccount-1
-c if ((numshft.eq.1 .and. snum.gt.15.1) .or.
- if ((numshft.eq.1 .and. snum.gt.64.) .or.
- * (numshft.eq.2 .and. snum.gt.1.51)) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Shift number after "n" in xtup is out of range!')
- call stop1()
- end if
- go to 30
- else if (durq .eq. 's') then
-c
-c Slope alteration for bracket
-c
- call getchar(lineq,iccount,durq)
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'For slope adjustment, this character must be "+" or "-"!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This character should be a digit!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,snum)
- iccount = iccount-1
- if (nint(snum) .gt. 15) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slope adjustment cannot exceed 15!')
- call stop1()
- end if
- go to 30
- else if (index('123456789',durq) .gt. 0) then
-c
-c Unsigned integer => alternate printed number
-c
- call readnum(lineq,iccount,durq,snum)
- if (snum .gt. 15.1) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Alternate xtup number after "n" must be <16!')
- call stop1()
- end if
- iccount = iccount-1
- go to 30
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "n" in xtup!')
- call stop1()
- end if
- end if
- ntup = nint(fnum)
- do 6 itup = 2 , ntup
- nodur(ivx,nnl(ivx)) = 0
- nnl(ivx) = nnl(ivx)+1
-110 call g1etchar(lineq,iccount,durq)
- if (durq.eq.' ') then
- go to 110
- else if (durq .eq. 'o') then
-c
-c Ornament in xtup. "o" symbol must come AFTER the affected note
-c
- call g1etchar(lineq,iccount,dumq)
- if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then
- if (index('fg',dumq) .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Fermata or segno not allowed in xtuplet!')
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal ornament!')
- end if
- call stop1()
- end if
- if (dumq .eq. 'T') then
-c
-c Trill. may be followed by 't' and/or number. read 'til blank
-c
-29 call g1etchar(lineq,iccount,dumq)
- if (dumq .ne. ' ') go to 29
- else if (dumq .eq. 'e') then
- call g1etchar(lineq,iccount,dumq)
- if (index('sfn?',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "e" in edit. accid. symbol!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
- else if (dumq .eq. ':') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '":" must be followed by blank in "o: "!')
- call stop1()
- else if (.not.ornrpt) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Turned off repeated ornaments before they were on!')
- call stop1()
- end if
- ornrpt = .false.
- else
- call g1etchar(lineq,iccount,dumq)
- end if
- if (index('+- :',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in ornament symbol!')
- call stop1()
- end if
- if (dumq .eq. ':') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '":" must be followed by blank in "o: "!')
- call stop1()
- else if (ornrpt) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Turned on repeated ornaments but already on!')
- call stop1()
- end if
- ornrpt = .true.
- end if
- if (index('+-',dumq) .gt. 0) then
- if (index('0123456789',lineq(iccount+1:iccount+1))
- * .eq. 0) then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'There should be an integer here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (durq .eq. ':') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot shift AND repeat an ornament!')
- call stop1()
- end if
-c
-c 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas.
-c
- if (index('+-',durq) .gt. 0) then
- if (index('.0123456789',lineq(iccount+1:iccount+1))
- * .eq. 0) then
- call errmsg(lineq,iccount+1,
- * ibarcnt-ibaroff+nbars+1,
- * 'There should be a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- end if
- end if
- go to 110
- else if (index('st(){}',durq) .gt. 0) then
-c
-c Slur in xtup
-c
- iposn = 0
- numint = 0
-15 call g1etchar(lineq,iccount,dumq)
- iposn = iposn+1
- if (index('udlbfnhtv',dumq) .gt. 0) then
- if (dumq.eq.'t' .and. durq.eq.'t') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot use "t" as an option on a tie!')
- call stop1()
- end if
- go to 15
- else if (index('+-',dumq) .gt. 0) then
- numint = numint+1
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (numint .eq. 1) then
- if (nint(fnum) .gt. 30) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Magnitude of slur height adjustment cannot exceed 30!')
- call stop1()
- end if
- else if (numint .eq. 2) then
- if (abs(fnum).gt.6.3) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur horiz shift must be in the range (-6.3,6.3)!')
- call stop1()
- end if
- else
-c
-c Third signed integer, must be a midslur or curve spec.
-c
- if (abs(fnum).gt.31) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur midheight must be in the range (-31,31)!')
- call stop1()
- end if
- if (durq .eq. ':') then
-c
-c Expecting curve parameters. Get two numbers
-c
- do 40 i = 1 , 2
- iccount = iccount+1
- fnum = ichar(lineq(iccount:iccount))-48
- if (abs(fnum-3.5) .gt. 3.6) then
- call errmsg(lineq,iccount,
- * ibarcnt-ibaroff+nbars+1,
- * 'Slur curve parameter must be in range (0,7)!')
- call stop1()
- end if
-40 continue
- iccount = iccount+1
- end if
- end if
- iccount = iccount-1
- go to 15
-
- else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
- if (fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'May not use linebreak slur options with font-based slurs!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('+-',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This character must be "+" or "-"!')
- call stop1()
- end if
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (nint(fnum) .gt. 30) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Magnitude of slur height adjustment cannot exceed 30!')
- call stop1()
- end if
- if (index('+-',dumq) .gt. 0) then
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (abs(fnum) .gt. 6.3) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur horiz shift must be in range (-6.3,6.3)!')
- call stop1()
- end if
- end if
- iccount = iccount-1
- go to 15
- else if (dumq .eq. 'H' .and. iposn.gt.1) then
- if (lineq(iccount+1:iccount+1) .eq. 'H')
- * iccount=iccount+1
- go to 15
- else if (dumq .eq. 'p') then
-c
-c local change in postscript slur/tie adjustment default
-c
- if (fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must use postscript slurs ("Ap") to use this option!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('+-',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected "+" or "-" here!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('st',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected "s" or "t" here!')
- call stop1()
- end if
- go to 15
- else if (dumq .ne. ' ') then
- ic = ichar(dumq)
- if ((ic.ge.48.and.ic.le.57) .or.
- * (ic.ge.65.and.ic.le.90)) then
- if (iposn .eq. 1) then
- if (durq.eq.'t' .and. fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slur ID not allowed on non-postscript tie!')
- call stop1()
- end if
- if (lineq(iccount+1:iccount+1).eq.'x')
- * iccount = iccount+1
- go to 15
- end if
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slur ID must be 2nd character in slur symbol!')
- call stop1()
- end if
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in slur symbol!')
- call stop1()
- end if
- go to 110
- else if (index('0123456789#-nx_',durq) .gt. 0) then
-c
-c We have a figure. Only allow on 1st note of xtup
-c
- if (itup .ne. 2) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Figure in xtup only allowed on 1st note!')
- call stop1()
- else if (durq.eq.'x') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'No floating figures in xtuplets!')
- call stop1()
- end if
- if (usefig .and. ivx.eq.1) ifig = 1
-26 call g1etchar(lineq,iccount,durq)
-c if (index('0123456789#-n_.:',durq) .gt. 0) then
- if (index('0123456789#-n_.:v',durq) .gt. 0) then
- go to 26
- else if (durq .eq. 's') then
- isligfont = .true.
- go to 26
- else if (durq .eq. '+') then
-c
-c vertical offset, must be integer then blank
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .ne. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Integer for vertical offset expected here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Vertical offset must terminate figure!')
- call stop1()
- end if
- iccount = iccount-1
- go to 26
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in figure in xtuplet!')
- call stop1()
- end if
- go to 110
- else if (durq .eq. 'G') then
- ngr = 1
-79 call g1etchar(lineq,iccount,charq)
- if (index('123456789',charq) .gt. 0) then
- call readnum(lineq,iccount,durq,fnum)
- ngr = nint(fnum)
- iccount = iccount-1
- go to 79
- else if (index('AWulxs',charq) .gt. 0) then
- go to 79
- else if (charq .eq. 'm') then
- call g1etchar(lineq,iccount,charq)
- if (index('01234',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A digit less than 5 must follow "m" in a grace note!')
- call stop1()
- end if
- go to 79
- else if (charq .eq. 'X') then
-c
-c Space before main note
-c
- call g1etchar(lineq,iccount,charq)
- if (index('0123456789.',charq) .gt. 0) then
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 79
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A number must follow "X" in a grace note!')
- call stop1()
- end if
- end if
-c
-c At this point, charq is first note name in rest (grace?)
-c
- do 71 igr = 1 , ngr
- numnum = 0
- if (igr .gt. 1) then
-75 call g1etchar(lineq,iccount,charq)
- if (charq .eq. ' ') go to 75
- end if
- if (index('abcdefg',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'In grace, expected "a"-"g"!')
- call stop1()
- end if
-78 call g1etchar(lineq,iccount,charq)
- if (charq .ne. ' ') then
- if (index('1234567',charq) .gt. 0) then
- if (numnum .eq. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only one of "+-1234567" allowed here in grace!')
- call stop1()
- end if
- numnum = 1
- go to 78
- else if (index('+-nfs',charq) .gt. 0) then
- go to 78
- end if
-c
-c Digits are possible octave numbers
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after note name in grace!')
- call stop1()
- end if
-71 continue
- go to 110
- else if (durq .eq. chax(92)) then
- call chklit(lineq,iccount,literr)
- if (literr .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * literq(literr))
- call stop1()
- end if
- go to 110
- else if (durq .eq. '"') then
-c
-c pmx lyric
-c
- call chkpmxlyr(lineq,iccount,lyrerr)
- if (lyrerr .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * lyrerq(lyrerr))
- call stop1()
- end if
- go to 110
- else if (durq .eq. 'M') then
-c
-c Temporary trap until I get around putting this in pmxb
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Macros not yet allowed in xtuplets!')
- call stop1()
- else if (durq .eq. 'X') then
- call g1etx(lineq,iccount,shifton,
- * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt)
- go to 110
- else if (durq .eq. 'z') then
-c
-c Chord note in xtup. Read past for now.
-c
-33 call g1etchar(lineq,iccount,durq)
- if (durq .ne. ' ') go to 33
- go to 110
- else if (durq .eq. 'D') then
-c
-c Dynamic mark
-c
- call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
- go to 110
- else if (durq .eq. '%') then
- if (iccount .ne. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Comment must have "%" in column 1!')
- call stop1()
- end if
- iccount = 128
- go to 110
- else if (durq .eq. '?') then
- call getchar(lineq,iccount,durq)
- if (durq .eq. ' ') then
- iccount = iccount-1
- go to 110
- end if
- if (durq .ne. '-') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expecting "-"')
- call stop1()
- end if
- call getchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expecting number')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 110
-c
-c 140215 Allow clef change inside xtup
-c
- else if (durq .eq. 'C') then
- call g1etchar(lineq,iccount,durq)
- if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
- * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
- call stop1()
- end if
-c gotclef = .true.
- go to 110
-c+++
- else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'['
- * .and. lineq(iccount+2:iccount+2).eq.' ') then
- iccount = iccount+2
- go to 110
-c+++
-c
-c Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo
-c
- end if
-c
-c End of xtup options. At this point symbol can only be note or rest
-c
- if (index('abcdefgr',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'In xtup, this character is not allowed!')
- call stop1()
- end if
-7 call g1etchar(lineq,iccount,durq)
- if (index('12345678ulcb',durq) .gt. 0) then
- go to 7
- else if (index('sfn',durq) .gt. 0) then
-c
-c Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift.
-c
- if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
- go to 7
- else if (index('+-<>',durq) .gt. 0) then
-c
-c May have either octave jump or shifted accid. on main xtup note
-c
- if (index('+-',durq).gt.0 .and.
- * index('01234567890',lineq(iccount+1:iccount+1)).eq.0)
- * go to 7
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 7
- else if (index('DF',durq) .gt. 0) then
-c
-c Double an xtup note to make an unequal xtup
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- ndoub = ndoub+1
- go to 7
- else if (durq .eq. 'd') then
- if (twotrem) then
-c
-c 2-note trem, get shift
-c
- call g1etchar(lineq,iccount,durq)
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected +/- for shifted dot on end of 2-note trem!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,dumq,fnum)
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift also
-c
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789-.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected number after 2nd +/- (shift dot)!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- end if
- iccount = iccount-1
- go to 7
- else
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
- end if
- go to 7
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal option on xtuplet note!')
- call stop1()
- end if
- if (itup .eq. ntup-ndoub) go to 3
-6 continue
-3 continue
-c
-c 6==End of loop for xtuplet input
-c
- else if (durq .eq. 'm') then
-c
-c Multi-bar rest: next 1 or two digits are # of bars.
-c
- if (mod(itsofar(iv),lenbar) .ne. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Multibar rest must start at beginning of bar!')
- call stop1()
- else if (iv.eq.1.and.ibarmbr.gt.0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Multibar rest only OK at one time per block!')
- call stop1()
- end if
-c
-c For some purposes, pretend its one bar only
-c
- nodur(iv,nnl(iv)) = lenbar
- ibarmbr = nbars+1
- mbrest = 0
-c20 call g1etchar(lineq,iccount,durq)
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected an integer after "rm"!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- mbrest = nint(fnum)
-c iccount = iccount-1
- if (nv .gt. 1) then
- if (iv .eq. 1) then
- mbrestsav = mbrest
- else
- if (mbrest .ne. mbrestsav) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must enter same multi-bar rest in every voice!')
- call stop1()
- end if
- end if
-c
-c Zero out mbrestsav so can check at end of input block whether
-c all voices have one
-c
- if (iv .eq. nv) mbrestsav=0
- end if
- if (durq .eq. 'n') then
-c
-c Get new height
-c
- call g1etchar(lineq,iccount,durq)
- if (index('+-123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected an integer after "rm[x]n"!')
- call stop1()
- end if
- if (index('+-',durq).ne.0) iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- end if
- if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "rm"!')
- call stop1()
- end if
- else if (durq .eq. '.') then
-c
-c Dotted pattern. Close out note. Mult time by 3/4.
-c Set time for next note to 1/4. Start the note.
-c
- idotform = 1
- else if (durq .eq. ',') then
- idotform = 3
-c
-c Now flow to duration setting, as if durq=' '
-c
- else if (index('oL',durq) .gt. 0) then
-c
-c Suppress full bar rest, or look left for height
-c
- if (charq .ne. 'r') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"o","L" options only legal for rest, not note!')
- call stop1()
- end if
- go to 2
- else if (index('DF',durq) .gt. 0) then
-c
-c Double note for xtup. Must check here in case "D" or "F" came before "x" or on
-c last note of xtup. Need to flag it in pmxa since affects horiz. spacing.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- go to 2
- else if (durq .eq. 'A') then
-c
-c Main note accidental option
-c
- call getchar(lineq,iccount,durq)
- if (index('o+-<>',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"o",+","-","<",">" are the only legal options here!')
- call stop1()
- end if
-c
-c Need more stuff here
-c
- if (durq .ne. "o") then
-c
-c Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will
-c proceed to number input checking
-c
- iccount = iccount-1
- end if
- go to 2
- else if (durq .eq. 'T') then
-c
-c Single stem tremolo. Only option (optional) is 1,2,3, or 4.
-c
- call getchar(lineq,iccount,durq)
- if (index('1234',durq) .eq. 0) iccount = iccount-1
- go to 2
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character!')
- print*,'ASCII code:',ichar(durq)
- call stop1()
- end if
-c
-c End of block for note options.
-c
-c Set the duration
-c
- if (idotform .gt. 0) then
- if (idotform .eq. 1) then
- nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2
- else if (idotform .eq. 2) then
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
- else if (idotform .eq. 3) then
- nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
- else if (idotform .eq. 4) then
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
- end if
- else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then
- nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
-c
-c Check for double dot
-c
- if (iddot .eq. 1) then
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
- iddot = 0
- end if
- else if (fulbrp) then
- nodur(ivx,nnl(ivx)) = lenbar
-c
-c Use a one-line function to set nnodur. It gives inverse of ifnodur.
-c
- nnodur = index('62514x0x37',
- * chax(48+int(log(.1+lenbar)/.69315)))-1
- fulbrp = .false.
- end if
- rest(ivx,nnl(ivx)) = charq.eq.'r'
-c
-c If inside forced beam, check if note is beamable
-c
- if (fbon) then
- if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120
- if (nnl(ivx) .gt. 1) then
- if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120
- end if
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Unbeamable thing in forced beam!')
- call stop1()
- end if
-120 continue
-c
-c Get number of prior bars for later check on whether note spans bar line
-c
- nbb4 = itsofar(ivx)/lenbar
- itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
- if (mod(itsofar(ivx),lenbar) .eq. 0) then
- nbars = nbars+1
- if (shifton) barend = .true.
-c
-c Will check barend when 1st note of next bar is entered.
-c
- if (nbars .gt. 15) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot have more than 15 bars in an input block!')
- call stop1()
- end if
- nib(ivx,nbars) = nnl(ivx)
- if (firstline .and. lenbar.ne.lenbr1) then
-c
-c Just finished the pickup bar for this voice.
-c
- if (itsofar(ivx) .ne. lenbr0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Pickup bar length disagrees with mtrnum0!')
- call stop1()
- end if
- lenbar = lenbr1
- itsofar(ivx) = 0
- end if
- else if (barend) then
- if (shifton) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Bar ended with user-defined shift still on!')
- call stop1()
- end if
- barend = .false.
- else if (itsofar(ivx)/lenbar .gt. nbb4) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'This note spans a bar line!')
- call stop1()
- end if
- if (idotform.eq.1 .or. idotform.eq.3) then
- call g1etchar(lineq,iccount,charq)
- if (index('abcedfgr',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected note name or "r" here!')
- call stop1()
- end if
- idotform = idotform+1
- numnum = 1
- go to 28
- end if
-c
-c End of sub block for note-rest
-c
- else if (charq .eq. 'z') then
- call g1etchar(lineq,iccount,charq)
- if (index('abcdefg',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected chord note name here!')
- call stop1()
- end if
-25 call g1etchar(lineq,iccount,durq)
-c if (index('dre12345678',durq) .gt. 0) then
- if (index('dre12345678c',durq) .gt. 0) then
- go to 25
- else if (index('fsn',durq) .gt. 0) then
-c
-c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
-c MUST come right after "f,s,n"
-c
- if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
- go to 25
- else if (durq .eq. 'A') then
- if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Must have "f,s,n" before "A" in chord note!')
- call stop1()
- end if
- go to 25
- else if (index('<>',durq) .gt. 0) then
- if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
-c if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Must have "f,s,n,A" before "<" or ">"!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('1234567890.',durq) .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Expected a number to start here for accidental shift!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 25
- else if (index('+-',durq) .gt. 0) then
- if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0)
- * go to 25
-c
-c Number or '.' (durq) follows +/- . Get it.
-c
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. '.' .and. index('1234567890',
- * lineq(iccount+1:iccount+1)) .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * '"." here must be followed by a digit!')
- call stop1()
- else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Number after +/- must follow "d,s,f,n,A"!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (index('+-',durq) .eq. 0) then
- iccount = iccount-1
- go to 25
- end if
-c
-c 2nd +/-
-c
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. '.') call g1etchar(lineq,iccount,durq)
- if (index('1234567890',durq) .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Expected a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 25
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in chord note!')
- call stop1()
- end if
- else if (charq .eq. 'G') then
- ngr = 1
-9 call g1etchar(lineq,iccount,charq)
- if (index('123456789',charq) .gt. 0) then
- call readnum(lineq,iccount,durq,fnum)
- ngr = nint(fnum)
- iccount = iccount-1
- go to 9
- else if (index('AWulxs',charq) .gt. 0) then
- go to 9
- else if (charq .eq. 'm') then
- call g1etchar(lineq,iccount,charq)
- if (index('01234',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A digit less than 5 must follow "m" in a grace note!')
- call stop1()
- end if
- go to 9
- else if (charq .eq. 'X') then
-c
-c Space before main note
-c
- call g1etchar(lineq,iccount,charq)
- if (index('0123456789.',charq) .gt. 0) then
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 9
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A number must follow "X" in a grace note!')
- call stop1()
- end if
- end if
-c
-c At this point, charq is first note name in rest (grace?)
-c
- do 19 igr = 1 , ngr
- numnum = 0
- if (igr .gt. 1) then
-55 call g1etchar(lineq,iccount,charq)
- if (charq .eq. ' ') go to 55
- end if
- if (index('abcdefg',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'In grace, expected "a"-"g"!')
- call stop1()
- end if
-18 call g1etchar(lineq,iccount,charq)
- if (charq .ne. ' ') then
- if (index('1234567',charq) .gt. 0) then
- if (numnum .eq. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only one of "+-1234567" allowed here in grace!')
- call stop1()
- end if
- numnum = 1
- go to 18
-c else if (index('nfs',charq) .gt. 0) then
- else if (index('+-nfs',charq) .gt. 0) then
- go to 18
- end if
-c
-c Digits are possible octave numbers
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after note name in grace!')
- call stop1()
- end if
-19 continue
- else if (charq .eq. chax(92)) then
- call chklit(lineq,iccount,literr)
- if (literr .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * literq(literr))
- call stop1()
- end if
- else if (charq .eq. '"') then
-c
-c pmx lyric
-c
- call chkpmxlyr(lineq,iccount,lyrerr)
- if (lyrerr .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * lyrerq(lyrerr))
- call stop1()
- end if
- else if (charq .eq. 'o') then
-c
-c Ornament on non-xtup note. "o" symbol must come AFTER the affected note
-c
- if (nnl(ivx) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"o" must be in same input block, after affected note!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
-c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then
- if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal ornament!')
- call stop1()
- end if
- if (dumq .eq. ':') then
- call g1etchar(lineq,iccount,dumq)
- if (dumq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected blank after "o:"!')
- call stop1()
- else if (.not.ornrpt) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Turned off repeated ornaments before they were on!')
- call stop1()
- end if
- ornrpt = .false.
- else if (dumq .eq. 'g') then
- if (issegno) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Sorry, only one "segno" per input block!')
- call stop1()
- else if (ivx .ne. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'segno can only be in voice 1!')
- call stop1()
- end if
- issegno = .true.
-12 call g1etchar(lineq,iccount,dumq)
- if (dumq.eq.'-' .or.
- * (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12
- if (dumq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in segno ornament symbol!')
- call stop1()
- end if
- else if (dumq .eq. 'T') then
-c
-c Trill. may be followed by 't' and/or number. read 'til blank
-c
-22 call g1etchar(lineq,iccount,dumq)
- if (dumq .eq. ':') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected blank after ":"!')
- call stop1()
- end if
- go to 32
- else if (dumq .ne. ' ') then
- go to 22
- end if
- else if (dumq .eq. 'f') then
- call g1etchar(lineq,iccount,dumq)
- if (index(' d+-:',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "f" in fermata ornament symbol!')
- call stop1()
- end if
- if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq)
- if (dumq .eq. ':') go to 32
- else if (dumq .eq. 'e') then
- call g1etchar(lineq,iccount,dumq)
- if (index('sfn?',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "e" in edit. accid. symbol!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
- else
- call g1etchar(lineq,iccount,dumq)
- end if
- if (index('+- :',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in ornament symbol!')
- call stop1()
- end if
- if (index('+-',dumq) .gt. 0) then
- if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'There should be an integer here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (durq .eq. ':') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot shift AND repeat an ornament!')
- call stop1()
- end if
-c
-c 12/7/03 Allow horizontal shift on any ornament, not just breath and caes.
-c
- if (index('+-',durq) .gt. 0) then
- if (index('.0123456789',lineq(iccount+1:iccount+1))
- * .eq. 0) then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'There should be a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- end if
- end if
-32 continue
- if (dumq .eq. ':') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '":" must be followed by blank in "o: "!')
- call stop1()
- else if (ornrpt) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Turned on repeated ornaments but already on!')
- call stop1()
- end if
- ornrpt = .true.
- end if
- else if (index('st(){}',charq) .gt. 0) then
- numint = 0
- iposn = 0
-8 call g1etchar(lineq,iccount,dumq)
- iposn = iposn+1
- if (charq.eq.'t' .and. dumq.eq.'t') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot use "t" as an option on a tie!')
- call stop1()
- end if
- if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then
-c
-c Check for explicit ID code.
-c
- ic = ichar(dumq)
- if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or.
- * ic.gt.90) then
-c
-c Not 0-9 or A-Z, so exit
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in slur symbol!')
- call stop1()
- else
-c
-c It is a possible ID code. Right place?
-c
- if (iposn .ne. 1) then
-c
-c Slur ID is not 2nd!
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slur ID must be second character in slur symbol!')
- call stop1()
- else if (charq.eq.'t' .and. fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slur ID not allowed on non-postscript tie!')
- call stop1()
- else if (lineq(iccount+1:iccount+1).eq.'x') then
- iccount = iccount+1
- end if
- end if
-c
-c Slur ID is OK. Note it cannot be "H" at this point..
-c
- go to 8
- else if (dumq .eq. 'H') then
- if (iposn .eq. 1) go to 8
-c
-c "H" is NOT an ID code.
-c
- if (.not.fontslur .and. charq.eq.'t') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot reshape postscript ties this way!')
- call stop1()
- end if
- if (lineq(iccount+1:iccount+1) .eq. 'H') then
- iccount=iccount+1
- iposn = iposn+1
- end if
- go to 8
- else if (index('fh',dumq).gt.0 .and. .not.fontslur
- * .and. charq.eq.'t') then
-c
-c 3/9/03 Can't reshape postscript tie.
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot reshape postscript ties this way!')
- call stop1()
- else if (dumq .eq. 'p') then
-c
-c local change in postscript slur/tie adjustment default
-c
- if (fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must use postscript slurs ("Ap") to use this option!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('+-',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected "+" or "-" here!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('st',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected "s" or "t" here!')
- call stop1()
- end if
- iposn = iposn+2
- go to 8
- end if
- if (index('udltbfnh',dumq) .gt. 0) then
- go to 8
- else if (index('+-',dumq) .gt. 0) then
- numint = numint+1
- if (fontslur .and. charq.eq.'t') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"+|-" for slur height only allowed in "s"-slurs!')
- call stop1()
- end if
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (numint .eq. 1) then
- if (nint(fnum) .gt. 30) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Magnitude of slur height adjustment cannot exceed 30!')
- call stop1()
- end if
- else if (numint .eq. 2) then
- if (abs(fnum) .gt. 6.3) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur horiz shift must be in range (-6.3,6.3)!')
- call stop1()
- end if
- else
-c
-c Third signed integer, must be a midslur or curve spec.
-c
- if (abs(fnum).gt.31) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur midheight must be in the range (-31,31)!')
- call stop1()
- end if
- if (durq .eq. ':') then
-c
-c Expecting curve parameters. Get two numbers
-c
- do 41 i = 1 , 2
- iccount = iccount+1
- fnum = ichar(lineq(iccount:iccount))-48
- if (abs(fnum-3.5) .gt. 3.6) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Slur curve parameter must be in range (0,7)!')
- call stop1()
- end if
-41 continue
- iccount = iccount+1
- end if
- end if
- iccount = iccount-1
- go to 8
- else if (dumq .eq. 's') then
-c
-c What follows should be one or two signed numbers for adjustment of line break
-c slur, end of 1st segment or start of second.
-c
- if (fontslur) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'May not use linebreak slur options with font-based slurs!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,dumq)
- if (index('+-',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This character must be "+" or "-"!')
- call stop1()
- end if
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (nint(fnum) .gt. 30) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Magnitude of slur height adjustment cannot exceed 30!')
- call stop1()
- end if
- if (index('+-',dumq) .gt. 0) then
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (abs(fnum) .gt. 6.3) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Slur horiz shift must be in range (-6.3,6.3)!')
- call stop1()
- end if
- end if
- iccount = iccount-1
- go to 8
- else if (dumq .eq. 'H' .and. iposn.gt.1) then
- if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1
- go to 8
- end if
- else if (charq .eq. '?') then
- call getchar(lineq,iccount,durq)
- if (durq .eq. ' ') then
- iccount = iccount-1
- else
- if (durq .ne. '-') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expecting "-"!')
- call stop1()
- end if
- call getchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expecting number!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- end if
- else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or.
- * index('#-nx_',charq) .gt. 0) then
-c
-c We have a figure. Must come AFTER the note it goes under
-c
- if (itsofar(ivx).eq.0 .and.
- * (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then
-c
-c Figure before first note in block
-c
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot put figure before first note in block!')
- call stop1()
- end if
- if (charq.eq.'x') then
- indxb = index(lineq(iccount:128),' ')
- if (indxb .lt. 5) then
- call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1,
- * 'Cannot have a blank here in floating figure!')
- call stop1()
- end if
- end if
- if (usefig) ifig = 1
-5 call g1etchar(lineq,iccount,charq)
- if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in figure!')
- call stop1()
- else if (charq .eq. '+') then
-c
-c vertical offset, must be integer, then blank
-c
- call g1etchar(lineq,iccount,charq)
- if (index('123456789',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Integer for vertical offset expected here!')
- call stop1()
- end if
- call readnum(lineq,iccount,charq,fnum)
- if (charq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Vertical offset must terminate figure!')
- call stop1()
- end if
- iccount = iccount-1
- go to 5
- else if (charq .eq. 's') then
- isligfont = .true.
- end if
- if (charq .ne. ' ') go to 5
- else if (charq .eq. '[') then
- if (fbon) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Started forced beam while another was open!')
- call stop1()
- end if
- fbon = .true.
-17 call g1etchar(lineq,iccount,charq)
- if (index('uljhf:',charq) .gt. 0) then
- go to 17
- else if (index('+-',charq) .gt. 0) then
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 17
- else if (charq .eq. 'm') then
-c
-c Forced multiplicity, next char should be 1-4
-c
- call g1etchar(lineq,iccount,charq)
- if (index('1234',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Forced multiplicity for a beam must be 1, 2, 3, or 4!')
- call stop1()
- end if
- go to 17
- else if (charq .ne. ' ') then
- if (index('0123456789',charq) .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'After "[", digits must now be preceeded by "+" or "-"!')
- print*,'You will have to edit older sources to meet this rqmt,'
- print*,'but it was needed to allow 2-digit height adjustments.'
- print*,'Sorry for the inconvenience. --The Management'
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after [!')
- end if
- call stop1()
- end if
- else if (charq .eq. ']') then
- if (.not.fbon) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Forced beam stop with no corresponding start!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,charq)
- if (charq .eq. '-') then
- if (lineq(iccount+1:iccount+2) .ne. '[ ') then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'Only sequence allowed here is "[ "!')
- call stop1()
- else
- iccount = iccount+2
- end if
- else if (charq .eq. '[') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'This character must be a blank!')
- call stop1()
- end if
- else
-c
-c Forced beam is really ending
-c
- fbon = .false.
- if (charq .eq. 'j') then
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'This character must be a blank!')
- call stop1()
- end if
- else if (charq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"]" must be followed by blank, "j", "-", or "["!')
- call stop1()
- end if
- end if
- else if (charq .eq. 'D') then
-c
-c Dynamic mark
-c
- if (nnl(ivx) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"D" must not come before any notes have been entered!')
- call stop1()
- end if
- call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
- else if (index('lhw',charq) .gt. 0) then
-c
-c Save position for later check
-c
- icclhw = iccount
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.+- ',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "l", "w", or "h"!')
- call stop1()
- end if
- isheadr = isheadr .or. charq .eq. 'h'
- if (index(' +-',durq) .gt. 0) then
-c
-c There is a header (or lower string?)
-c
- if (index('+-',durq) .gt. 0) then
-c
-c User-defined vert offset (\internote).
-c
- if (charq .ne. 'h') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"+" or "-" not permitted here!')
- call stop1()
- end if
-c
-c Have "h" followed by +/- . Check for digit.
-c Can blow durq since not using fnum for now, but...
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be a digit here!')
- call stop1()
- end if
-c
-c Have "h" followed by +/- followed by a digit. No need to get the number.
-c
-c call readnum(lineq,iccount,durq,fnum)
- end if
- if (charq .ne. 'w') then
-c
-c Header or lower string.
-c
- if (icclhw .ne. 1) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * '"h" or "l" must be first character in line!')
- call stop1()
- end if
-c
-c Read past the next line, which has the string.
-c
- call read10(charq,lastchar)
- nline = nline+1
- iccount = 128
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Symbol "w" (width) must be followed by a digit!')
- call stop1()
- end if
- else
-c
-c Height or width change spec. Check if at start of piece.
-c
- if (ibarcnt .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Symbol must go at top of first input block!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,dimen)
-c
-c Check units. Convert to points
-c
- if (durq .eq. ' ' .or. durq .eq. 'p') then
- dimen = dimen+.5
- else if (durq .eq. 'i') then
- dimen = dimen*72+.5
- else if (durq .eq. 'm') then
- dimen = dimen/25.4*72+.5
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal unit; must be "p","i",or"m"!')
- call stop1()
- end if
-c
-c 151211 fix. May have extra character.
-c
- if (index('pim',durq) .gt. 0) then
-c
-c Get another character, see if it's blank
-c
- if (lineq(iccount+1:iccount+1) .ne. ' ') then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'This character should be a blank!')
- call stop1()
- end if
- end if
- if (charq .eq. 'h') then
- ptheight = int(dimen)
- else
- widthpt = int(dimen)
- end if
- end if
- else if (charq .eq. 'm') then
-c
-c Time signature change. Only allow at beginning of block.
-c mtrnuml, mtrdenl (logical) and p (printable) will be input.
-c mtrnuml=0 initially. (In common)
-c
-c Check whether at beginning of a block
-c
- if (ivx.ne.1 .or. nnl(1).ne.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Meter change only OK in voice 1, at start of block!')
- print*,'voice number is',ivx
- call stop1()
- end if
- newmeter = .true.
- if (index('o0123456789',lineq(iccount+1:iccount+1)).eq.0) then
- call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in "m" command for meter change!')
- call stop1()
- end if
- call readmeter(lineq,iccount,mtrnuml,mtrdenl)
- if (mtrnuml .eq. 0) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Digit 0 not allowed here!')
- call stop1()
- end if
- call readmeter(lineq,iccount,mtrnmp,mtrdnp)
-c
-c Read past printed time signature; not used in pmxa.
-c
- lenbeat = i1fnodur(mtrdenl,'x')
- lenmult = 1
- if (mtrdenl .eq. 2) then
- lenbeat = 16
- lenmult = 2
- end if
- lenbar = lenmult*mtrnuml*lenbeat
- mtrnuml = 0
- else if (charq .eq. 'C') then
- call g1etchar(lineq,iccount,durq)
- if (.not.(index('tsmanrbf',durq).gt.0 .or.
- * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
- call stop1()
- end if
- else if (charq .eq. 'R') then
- if (ivx .ne. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Repeats can only go in voice 1!')
- call stop1()
- end if
-c10 call g1etchar(lineq,iccount,durq)
-c if (index('lrdDbz',durq) .gt. 0) go to 10
-c if (durq .ne. ' ') then
-c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'Illegal character after "R" (repeat/double bar)!')
-c call stop1()
-c end if
- call g1etchar(lineq,iccount,durq)
- call g1etchar(lineq,iccount,dumq)
- if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "R*" (repeat/double bar)!')
- call stop1()
- end if
- if (dumq .ne. ' ') then
- call g1etchar(lineq,iccount,durq)
- if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have blank after "R**" (repeat/double bar)!')
- call stop1()
- end if
- end if
- else if (charq .eq. 'V') then
-c
-c Ending
-c
- if (iv .ne. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Voltas are only allowed in voice #1!')
- call stop1()
- else if (isvolt) then
- print*
- print*,'*******WARNING********'
- write(15,'(/,a)')'*******WARNING********'
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There is more than one volta in this input block.!')
- print*,'This may work in a score, but WILL NOT work in parts.'
- print*,
- *'Safest to have only 1 volta per block, at the start of the block'
- write(15,'(a)')
- * 'This may work in a score, but WILL NOT work in parts.'
- write(15,'(a)')
- *'Safest to have only 1 volta per block, at the start of the block'
- end if
- isvolt = .true.
- lvoltxt = 0
-11 call g1etchar(lineq,iccount,durq)
- if (durq .ne.' ') then
- go to 11
- end if
- else if (charq .eq. 'B') then
- continue
- else if (charq .eq. 'P') then
- if (ivx.ne.1 .or. nnl(1).ne.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only allowed at beginning of block!')
- call stop1()
- end if
-16 call g1etchar(lineq,iccount,durq)
- if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and.
- * ichar(durq).le.57)) go to 16
- if (durq .eq. 'c') then
-c
-c Expect a centered name, and it has to be last option
-c
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. '"') then
-c
-c Quoted name, go to next quote mark
-c
- do 35 iccount = iccount+1 , 127
- if (lineq(iccount:iccount).eq.'"' .and.
- * lineq(iccount-1:iccount-1).ne.'\') go to 36
-35 continue
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Missing close quote after page number command (P)!')
- call stop1()
-36 continue
- else if (durq .ne. ' ') then
-c
-c Space-delimited name, look for next blank
-c
- do 37 iccount = iccount+1 , 127
- if (lineq(iccount:iccount) .eq. ' ') go to 38
-37 continue
-38 continue
- end if
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only "l","r","c" or digit allowed after "P"!')
- call stop1()
- end if
- else if (charq .eq. 'W') then
- call g1etchar(lineq,iccount,durq)
- if (index('.0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a number to start here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1))
- else if (charq .eq. 'T') then
-c
-c Titles
-c
- call g1etchar(lineq,iccount,durq)
- if (index('itc',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must put "i", "t", or "c" after "T"!')
- call stop1()
- end if
- ihead = ihead+2**(index('itc',durq)-1)
-c
-c Maybe a number after 'Tt', but ignore here. Read past string on next line.
-c
- call read10(charq,lastchar)
- nline = nline+1
- iccount = 128
- else if (charq .eq. 'A') then
-27 call g1etchar(lineq,iccount,durq)
-c if (index('rbsdeK',durq) .gt. 0) then
- if (index('rbsdK',durq) .gt. 0) then
- go to 27
- else if (durq .eq. 'e') then
-c
-c Check for is4bignv. Must do here to catch first \internote, written in topfile
-c before ever calling getnote. Initialize as .false. in pmxa. Make it true only
-c if nv>7, AI not set, Ai not set.
-c
- is4bignv = nv.gt.7 .and. .not.AIset
- go to 27
- else if (durq .eq. 'v') then
- if (ibarcnt .eq. 0) novshrinktop = .true.
- go to 27
- else if (durq .eq. 'a') then
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'After "Aa", need decimal number!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fbar)
- iccount = iccount-1
- go to 27
- else if (durq .eq. 'i') then
- is4bignv = .false.
- AIset = .true.
- call g1etchar(lineq,iccount,durq)
-c
-c Local interstaff correction. Set to -1. if not specifiec, or after use,
-c or anytime except at top, since pmxb handles all times except at top.
-c
- call readnum(lineq,iccount,durq,tintstf)
- if (ibarcnt .eq. 0) fintstf = tintstf
- iccount = iccount-1
- go to 27
- else if (durq .eq. 'I') then
-c
-c Global interstaff correction. Use in place of fintstf if fintstf<0
-c
- is4bignv = .false.
- AIset = .true.
- call g1etchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,gintstf)
- iccount = iccount-1
- go to 27
- else if (durq .eq. 'o') then
- optimize = .true.
- go to 27
- else if (durq .eq. 'S') then
- do 50 iiv = 1 , noinst
- call g1etchar(lineq,iccount,durq)
- if (index('-0st',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'After "AS", need nv instances of "s,t,-,0"!')
- call stop1()
- end if
- if (durq.eq.'-'.or.durq.eq.'s') then
- isize(iiv) = 1
- else if (durq.eq.'t') then
- isize(iiv) = 2
- end if
-50 continue
- go to 27
- else if (durq .eq. 'p') then
- fontslur = .false.
-42 continue
- call g1etchar(lineq,iccount,durq)
- if (index('+-',durq) .gt. 0) then
-c
-c Characters to change defaults for ps slurs
-c
- call g1etchar(lineq,iccount,durq)
- if (index('shtc',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only letters allowed here are "s","h","t","c"!')
- call stop1()
- end if
-c
-c Now check for another default modifier
-c
- go to 42
- else if (index('lh',durq) .gt. 0) then
-c
-c Flags for optional linebreak ties or header specials
-c
- go to 42
- else
- iccount = iccount-1
- end if
- go to 27
- else if (durq .eq. 'N') then
-c
-c Override default name for a part file. Must have part number, then
-c partname in quotes. Must be on line by itself, and start in column 1.
-c Will only be passed thru to scor2prt.
-c
- if (iccount .ne. 2) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"AN" must start in column 1!')
- call stop1()
- end if
- ndxquote = index(lineq,'"')
- if (ndxquote.lt.4 .or. ndxquote.gt.5 .or.
- * index('123456789',lineq(3:3)).eq.0 .or.
- * (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"AN" must be followed by inst. #, then quote!')
- call stop1()
- end if
- ndxquote = index(lineq(ndxquote+1:128),'"')
- if (ndxquote .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'In "AN", file name must be in quotes!')
- call stop1()
- end if
- iccount = 128
- else if (durq .eq. 'T') then
- cstuplet = .true.
- else if (durq .eq. 'R') then
-c
-c Get full name of normal include file; must occupy remainder of line
-c
- call getpmxmod(.false.,lineq(iccount+1:128))
- iccount = 128
- else if (durq .eq. 'c') then
- call g1etchar(lineq,iccount,durq)
- if (index('l4',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only "l" or "4" is allowed here!')
- call stop1()
- end if
- if (durq .eq. 'l' ) then
- hoffpt = -25
- voffpt = -45
- else if (durq .eq. '4') then
- ptheight = 745
- widthpt = 499
- hoffpt = -24
- voffpt = -24
- end if
- go to 27
- else if (durq .eq. 'V') then
- call g1etchar(lineq,iccount,durq)
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only "+" or "-" is allowed here!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A number for vert shift before \eject must start here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only "+" or "-" is allowed here!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A number for vert shift after \eject must start here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- go to 27
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'After "A" must follow one of the letters abcdeiINprRsST!')
- * 'After "A" must follow one of abcdeiILNprRsSTvV!')
- print*,'For AS, since ver. 2.7, must only have noinst args.'
- write(15,'(a)')
- * 'For AS, since ver. 2.7, must only have noinst args.'
- call stop1()
- end if
- else if (charq .eq. 'K') then
-c
-c Rules and function of K command
-c
-c Only 1 K +/-n +/-m allowed per block if n.ne.0 (transposition). isig1 is
-c initial sig, and must be passed to pmxb because it is needed when topfile
-c is called, which is before the K+n+m command is read in pmxb. Also, we
-c compute and save ibrkch and newkey for each syst, accounting for key changes,
-c then adjust fbar to make poenom much more accurate.
-c Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#.
-c
-77 continue
- call g1etchar(lineq,iccount,durq)
-c if (index('+-i',durq) .eq. 0) then
- if (index('+-in',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"K" (transpose or key change) must be followed by "+,-,i,n"!')
- call stop1()
- end if
- if (durq .eq. 'n') go to 77
- if (durq .ne. 'i') then
-c
-c Normal key change and/or transposition)
-c
-c iccount = iccount+1
- num1 = 44-ichar(durq)
-c
-c num1= +1 or -1
-c
- ztrans = num1.eq.-1
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '1st +/- must be followed by a number!')
- call stop1()
- end if
-c iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- num1 = nint(fnum)*num1
- ztrans = ztrans .and. num1.eq.0
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '1st number after "K" must be followed by "+,-"!')
- call stop1()
- end if
- iccount = iccount+1
- num2 = 44-ichar(durq)
- call readnum(lineq,iccount,durq,fnum)
- num2 = num2*int(fnum+.1)
- if (num1.eq.0 .and. .not.ztrans) then
-c
-c Key change, only one per block allowed
-c
- if (iskchb) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Only one key change allowed per input block!')
- call stop1()
- end if
- iskchb = .true.
- nkeys = nkeys+1
- kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0
-c
-c Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak.
-c
- ibrkch(nkeys) = ibarcnt+nbars
- if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1
- newkey(nkeys) = num2+idsig
-c 130316
-c do 43 iinst = 1 , noinst
- midisig = newkey(nkeys)
-c43 continue
- else
-c
-c Transposition
-c
- fulltrans = .true.
- if (ibarcnt .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Transposition must be at top of first input block!')
- call stop1()
- end if
- isig1 = num2
- idsig = isig1-newkey(1)
-c
-c idsig is the difference between sig after transposition, and sig in setup.
-c It may alter # of accid's in key changes if there is transposition.
-c
- end if
- else ! durq='i'
-c
-c 110522/110529
-c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c and repeat i[...] for multiple instruments. Store info here if ibarcnt=0
-c so can pass to topfile (via comInstTrans), which is called before getnote.
-c Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here;
-c LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really
-c only needed for instrument-signatures, not transpositions. iTransAmt is
-c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c each staff.
-c
- call GetiTransInfo(.true.,ibarcnt,lineq,iccount,
- * ibaroff,nbars,noinst)
- end if
- else if (charq .eq. '|') then
-c
-c Optional bar symbol
-c
- if (mod(itsofar(ivx),lenbar).ne.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Bar line marker out of place!')
- call stop1()
- else if (shifton) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Bar ended with user-defined shift still on!')
- call stop1()
- end if
- else if (charq .eq. '/') then
- if (ornrpt) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'WARNING: Block ended with repeated ornament still on!')
- ornrpt = .false.
- end if
- if (stickyS) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'WARNING: Block ended with sticky stemshrink still on!')
- stickyS = .false.
- end if
- if (fbon) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Block ended with forced beam open!')
- call stop1()
- else if (shifton) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Bar ended with user-defined shift still on!')
- call stop1()
-c
-c 140215 Temporary to allow clef change in stup
-c
-c else if (gotclef) then
-c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'May not enter clef at end of input block!')
-c call stop1()
- end if
- barend = .false.
-c
-c Perform time checks
-c
- if (mod(itsofar(ivx),lenbar).ne.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Block duration not divisible by lenbar!')
- print*,'lenbar, timesofar are ',lenbar,itsofar(ivx)
- call stop1()
- else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
- print*
- print*,'No of bars in voice 1, current voice:',
- * itsofar(1)/lenbar,itsofar(ivx)/lenbar
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Block duration not equal to voice 1!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. ' ' .and. iv.eq.nv) then
-c
-c End of input block
-c
- loop = .false.
- else
-c
-c Start a new voice
-c
- if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0
- nbars = 0
- if (durq .eq. ' ') then
-c
-c New voice is on next staff
-c
- iv = iv+1
- ivx = iv
- else
-c
-c New voice is on same staff. Set up for it
-c
- ivx = nv+1
- do 23 iiv = 1 , nv
- if (nvmx(iiv) .eq. 2) ivx = ivx+1
-23 continue
- if (ivx .gt. nm) then
- write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm,
- * ' lines of music at once'
- call stop1()
- end if
- nvmx(iv) = 2
- ivmx(iv,2) = ivx
- itsofar(ivx) = 0
- nnl(ivx) = 0
- do 24 j = 1 , 200
- rest(ivx,j) = .false.
- nacc(ivx,j) = 0
-24 continue
-c
-c For midi stuff, record that there is a 2nd line of music in this voice
-c
- if (ismidi) twoline(iv) = .true.
- end if
- end if
- iccount = 128
- else if (charq .eq. 'S') then
-c
-c New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs.
-c
- if (ibarcnt .gt. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"S" can only be in first input block!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- if (index('123456789 ',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'A digit must follow "S"!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnsyst)
- nsyst = nint(fnsyst)
-14 continue
- if (durq .eq. 'P') then
-c
-c New npages for parts.
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789 ',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnsyst)
- npages = nint(fnsyst)
- go to 14
- else if (durq .eq. 'm') then
-c
-c Reset musize (musicsize).
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789 ',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnsyst)
- musize = nint(fnsyst)
- wheadpt = whead20*musize
- go to 14
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in "S" symbol!')
- call stop1()
- end if
- else if (charq .eq. 'L') then
-c
-c Force line break
-c
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. 'C') then
-c
-c Coda, no real line break, just get coda length
-c
- if (ishort .ne. 1) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot use "LC" without first using "L[n]S"!')
- call stop1()
- end if
- ishort = 0
- call g1etchar(lineq,iccount,durq)
- if (index('1234567890.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need number to define coda length!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,codafrac)
- poefa(isysflb(nflb)) = poefa(isysflb(nflb))+codafrac
- if (index(' n',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need blank or "n" here!')
- call stop1()
- end if
- return
- end if
- nflb = nflb+1
- ibarflb(nflb) = ibarcnt+nbars+1
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need integer to define forced line break!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,sysflb)
- isysflb(nflb) = nint(sysflb)
- if (isysflb(nflb) .eq. 1) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'For now, "L1" not allowed!')
- call stop1()
- end if
- if (nflb .gt. 1) then
-c
-c Check if new number is > prior one
-c
- if (isysflb(nflb) .le. isysflb(nflb-1)) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'You already forced a line break at a later line!')
- call stop1()
- end if
- end if
- if (npages .eq. 0) then
- print*
- print*,'WARNING! You forced a line break at line ',
- * isysflb(nflb),' but npage = 0. Continue?'
- read(*,'(a)') charq
- if (index('yY',charq) .eq. 0) call stop1()
- else if (isysflb(nflb) .gt. nsyst) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Forced line break at line num > nsyst!')
- call stop1()
- else if (index(' PMS',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have " ", "P", "M", or "S" here!')
- call stop1()
- end if
-49 continue ! Transfer up from below to allow S after M
- if (durq .eq. 'S') then
-c
-c Shortened line, get shortening fraction
-c
- ishort = 1
- call g1etchar(lineq,iccount,durq)
- if (index('1234567890.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need number to define line shortening fraction!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,shortfrac)
- poefa(isysflb(nflb)) = shortfrac
- if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need blank here!')
- end if
- end if
- if (durq .eq. 'P') then
-c
-c Forced page break here, get page number.
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Need integer to define forced page break!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- nfpb = nfpb+1
- ipagfpb(nfpb) = nint(fnum)
- isysfpb(nfpb) = isysflb(nflb)
- if (ipagfpb(nfpb) .gt. npages) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Forced page break at page num > npages!')
- call stop1()
- else if (nfpb .gt. 1) then
- if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Forced page break numbers must increase!')
- call stop1()
- end if
- end if
- end if
- if (index(' M',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in linebreak symbol!')
- call stop1()
- else if (durq .eq. 'M') then
- nmovbrk = nmovbrk+1
- isysmb(nmovbrk) = isysflb(nflb)
- call g1etchar(lineq,iccount,durq)
-31 if (durq .eq. '+') then
-c
-c Vertical spacing, read past number.
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Integer required here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- go to 31
- else if (durq .eq. 'i') then
-c
-c Change indentation,
-c
- call g1etchar(lineq,iccount,durq)
- if (index('.123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Decimal number required here!')
- call stop1()
- end if
-c
-c fracsys was initialized in block data to all 0.'s
-c
- call readnum(lineq,iccount,durq,fracsys(nmovbrk))
- go to 31
- else if (durq .eq. 'c') then
- call g1etchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'r') then
- call g1etchar(lineq,iccount,durq)
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have "+" or "-" after "r" as movement break option!')
- call stop1()
- end if
- call g1etchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'n') then
-c
-c Change # of voices. Input ninow, iorig(1...ninow). Will use names,
-c staves per inst. and clefs corr. to iorig in original list of instruments.
-c
- nv = 0
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. ':') then
-c
-c Signals a 2-digit number, get next two characters
-c
- call g1etchar(lineq,iccount,durq)
- call g1etchar(lineq,iccount,dumq)
- if (index('12',durq).eq.0
- * .or.index('0123456789',dumq).eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal new number of instruments '//durq//dumq//
- * ' at movement break!')
- call stop1()
- end if
- read(lineq(iccount-1:iccount),'(i2)')ninow
- else
-c
-c durq is a single digit number for noinow
-c
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal new number of instruments '//durq//
- * ' at movement break!')
- call stop1()
- end if
- ninow = ichar(durq)-48
- end if
- if (ninow.gt.noinst) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'New number of instruments must be <= original!')
- call stop1()
- end if
- do 63 iinow = 1 , ninow
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. ':') then
-c
-c Signals a 2-digit number
-c
- call g1etchar(lineq,iccount,durq)
- call g1etchar(lineq,iccount,dumq)
- if (index('12',durq).eq.0
- * .or.index('0123456789',dumq).eq.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal 2-digit instrument number '//durq//dumq//
- * ' at movement break!')
- call stop1()
- end if
- read(lineq(iccount-1:iccount),'(i2)')iorig
- else
-c
-c durq is a single digit number for iorig
-c
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal instrument number '//durq//
- * ' at movement break!')
- call stop1()
- end if
- iorig = ichar(durq)-48
- end if
- if (iorig .gt. noinst) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'New instrument number must be <= original noinst!')
- call stop1()
- end if
- nv = nv+nsperi(iorig)
-63 continue
- do 61 iiv = 1 , nv
-c
-c Get clef names
-c
- call g1etchar(lineq,iccount,durq)
- if (.not.(index('tsmanrbf',durq).gt.0 .or.
-c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
- * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!')
- call stop1()
- end if
-c
-c Initialize new voices
-c
- nvmx(iiv) = 1
- ivmx(iiv,1) = iiv
- itsofar(iiv) = 0
- nnl(iiv) = 0
- do 62 j = 1 , 200
- rest(iiv,j) = .false.
-62 continue
-61 continue
-c
-c Loop back up, this might not be last option in M
-c
- call g1etchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'S') then
- go to 49
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after Movement break symbol!')
- call stop1()
- end if
- if (fracsys(nmovbrk) .lt. 0.001) then
-c
-c Since fracsys was not explicitly set, set it to prior value.
-c
- if (nmovbrk .eq. 1) then
- fracsys(nmovbrk) = fracindent
- else
- fracsys(nmovbrk) = fracsys(nmovbrk-1)
- end if
- end if
- end if
-c
-c Just before exiting if-block for forced line breaks, set counter to use when
-c dealing with vertical space calcs
-c
- nistaff(nflb) = nv-1
- else if (charq .eq. 'F') then
- usefig = .false.
- else if (charq .eq. 'X') then
- call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1,
- * udsp(ibarcnt+nbars+1),wheadpt)
- else if (charq .eq. 'I') then
-c
-c MIDI settings.
-c
- if (ivx.ne.1 .or. nnl(1).ne.0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'MIDI stuff only allowed at start of block!')
- call stop1()
- end if
- if (nv .gt. 15) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Sorry but MIDI does not work with more than 15 voices!')
- call stop1()
- end if
- ismidi = .true.
- call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
- * mtrdenl,nv,.true.)
- else if (charq .eq. 'M') then
- call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx,
- * nline)
- else if (index(',.',charq) .gt. 0) then
-c
-c Continued rhythmic shortcut
-c
- idotform = index('. ,',charq)
- if (idotform .eq. 1) then
-c
-c Change duration of prior note
-c
- itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2
- itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
- end if
- idotform = idotform+1
- numnum = 1
- cdot = .true.
- go to 1
- else
- print*,'ASCII code:',ichar(charq)
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'This character is not allowed here!')
- print*,'ASCII code:',ichar(charq)
- call stop1()
- end if
- return
- end
- subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
- * xmtrnum0,newkey,npages,nsyst,musize,bottreb)
- parameter(nm=24,maxblks=9600)
- character*131072 bufq
- character*1 chax
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- character*128 lineq
- logical lastchar,issegno,isheadr,isvolt,fbon,bottreb,
- * newway
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- common /commidisig/ midisig
-c
-c Get the first line
-c
- iccount = 0
- nline = 1
-9 call getbuf(lineq)
- if (lineq(1:1) .eq. '%') then
- nline = nline+1
- go to 9
- end if
- if (lineq(1:3) .eq. '---') then
-c
-c Have TeX input until next line that starts with '---'
-c
-3 nline = nline+1
- call getbuf(lineq)
- if (ilbuf .gt. nlbuf) go to 1
- go to 2
-1 print*,'You did not terminate type 0 TeX input with "---"'
- call stop1()
-2 continue
- if (lineq(1:3) .ne. '---') go to 3
-c
-c Force a new line read on first call to readin
-c
- iccount = 128
- end if
-c
-c Here, lineq and nline are first non-TeX lines.
-c
- nv = nint(readin(lineq,iccount,nline))
- if (nv .gt. nm) then
- write(*,'(1x,a46,i3)')
- * 'In setup data, number of voices cannot exceed',nm
- call stop1()
- end if
- noinst = nint(readin(lineq,iccount,nline))
- if (noinst .gt. nv) then
- write(*,'(a)')
- * 'In setup data, cannot have more instruments than staves'
- call stop1()
- end if
- newway = noinst.le.0
- if (newway) noinst = -noinst
- do 10 iinst = 1 , noinst
-c
-c Seve # of staves per inst in case later drop some inst's.
-c
- if (newway) then
- nsperi(iinst) = nint(readin(lineq,iccount,nline))
- else if (iinst .gt. 1 ) then
- nsperi(iinst) = 1
- else
- nsperi(iinst) = nv-noinst+1
- end if
-10 continue
- mtrnuml = nint(readin(lineq,iccount,nline))
- mtrdenl = nint(readin(lineq,iccount,nline))
-cc
-cc Kluge!!!
-cc
-c if (mtrdenl .eq. 1) then
-c mtrdenl = 2
-c mtrnuml = mtrnuml*2
-c end if
- mtrnmp = nint(readin(lineq,iccount,nline))
- mtrdnp = nint(readin(lineq,iccount,nline))
- if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then
- write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8'
- call stop1()
- end if
- xmtrnum0 = readin(lineq,iccount,nline)
- newkey = nint(readin(lineq,iccount,nline))
-c 130316
-c do 11 iinst = 1 , noinst
- midisig = newkey
-c11 continue
- npages = nint(readin(lineq,iccount,nline))
- nsyst = nint(readin(lineq,iccount,nline))
- musize = nint(readin(lineq,iccount,nline))
- fracindent = readin(lineq,iccount,nline)
- if (fracindent .ge. 1.) then
- write(*,'(a)')'In setup data, fracindent must be <1'
- call stop1()
- end if
- if (npages .gt. nsyst) then
- print*,'Error in input file: npages > nsyst'
- call stop1()
- else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then
- call printl('Musicsize must be 16, 20, 24, or 29')
- call stop1()
- end if
-c
-c Next noinst non-comment lines are names of instruments.
-c
- do 4 i = 1 , abs(noinst)
-5 call getbuf(lineq)
- nline = nline+1
- if (lineq(1:1) .eq. '%') go to 5
-4 continue
-c
-c Mext non-comment line has nv clef names
-c
-6 call getbuf(lineq)
- nline = nline+1
- if (lineq(1:1) .eq. '%') go to 6
- do 7 iv = 1 , nv
-c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then
- if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then
- call errmsg(lineq,iv,0,
- * 'There should be a clef symbol here!')
- call stop1()
- end if
-7 continue
- if (lineq(nv+1:nv+1) .ne. ' ') then
- call errmsg(lineq,nv+1,0,
- * 'There should be a blank here!')
- call stop1()
- end if
-c
-c Set flag if voice 1 is treble, since it affects vertical spacing
-c
-c bottreb = lineq(1:1).eq.'t'
- bottreb = index('t08',lineq(1:1)).gt.0
-c
-c Next non-comment line has path name
-c
-8 call getbuf(lineq)
- nline = nline+1
- if (lineq(1:1) .eq. '%') go to 8
- lpath = index(lineq,' ')-1
- if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then
- call errmsg(lineq,lpath,0,
- * 'Last character of pathname is not "/",":", or "'
- * //chax(92)//'"!')
- call stop1()
- end if
- return
- end
- subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt)
-c
-c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol.
-c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
-c
- logical shifton,number,btest
- character*128 lineq
- character*1 charq,dumq
- number = .false.
- nPBSc = 0
-1 call g1etchar(lineq,iccount,charq)
- if (index('PBS:',charq) .gt. 0) then
-c
-c Continue checking here even if "P".
-c
- ipbsc = index('PBS:',charq)
- if (btest(nPBSc,ipbsc)) then
- call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!')
- call stop1()
- end if
- nPBSc = ibset(nPBSc,ipbsc)
- go to 1
- else if (index('+-.0123456789',charq) .gt. 0) then
- number = .true.
- if (index('+-',charq) .gt. 0) then
- call g1etchar(lineq,iccount,dumq)
- if (index('.0123456789',dumq) .eq. 0) then
- call errmsg(lineq,iccount,ibar,'Expected a number here!')
- call stop1()
- end if
- end if
- call readnum(lineq,iccount,dumq,fnum)
- if (charq.eq.'-') fnum = -fnum
- if (dumq .ne. 'p') then
- iccount = iccount-1
- fnum = fnum*wheadpt
- end if
- go to 1
- else if (charq .ne. ' ') then
- call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!')
- call stop1()
- end if
-c
-c Done with parsing. Other checks
-c
- if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Cannot have both "P" and "B" or "S" and ":"!')
- call stop1()
- end if
- if (btest(nPBSc,4)) then
- if (number) then
- if (shifton) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Started a group shift without stopping prior one!')
- call stop1()
- else
- shifton = .true.
- end if
- else
- if (.not. shifton) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Ended a group shift without starting one!')
- call stop1()
- else
- shifton = .false.
- end if
- end if
- end if
-c
-c P off, S off, c off => normal user-defined space. Add to udsp (later fsyst)
-c
- if (iand(nPBSc,26).eq.0) udsp = udsp+fnum
- if (.not.number .and. .not.btest(nPBSc,4)) then
- call errmsg(lineq,iccount-1,ibar,
- * 'Must have either a number or a colon in "X" symbol!')
- call stop1()
- end if
- return
- end
-c integer*4 function mytime()
-c CHARACTER(10) tq
-c CALL DATE_AND_TIME(TIME=tq)
-c read(tq,'(2i2,f6.3)')ih,im,ts
-c mytime = 1000*(ts+60*(im+60*ih))
-c return
-c end
- subroutine getbuf(lineq)
- parameter (maxblks=9600)
- character*(*) lineq
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
- ipbuf = ipbuf+lbuf(ilbuf)
- ilbuf = ilbuf+1
- return
- end
- subroutine getchar(lineq,iccount,charq)
- parameter (nm=24)
-c
-c Gets the next character out of lineq*128. If pointer iccount=128 on entry,
-c then reads in a new line. Resets iccount. Ends program if no more input.
-c
- common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
- * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
- * rptprev,equalize,rptfq1,rptfq2
- logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- logical mrecord,mplay,endmac,equalize,stickyS
- character*1 charq,rptfq1,rptfq2
- character*128 lineq,lnholdq
- if (iccount .eq. 128) then
- call read10(lineq,lastchar)
- if (lastchar) return
- if (.not. endmac) then
- iccount = 0
- else
- endmac = .false.
- iccount = icchold
- lineq = lnholdq
- end if
- if (mrecord) then
- call mrec1(lineq,iccount,ndxm)
- end if
- end if
- iccount = iccount+1
- charq = lineq(iccount:iccount)
- return
- end
- subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount)
- parameter (nm=24)
- common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
- * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
- * idynda2(99),levhssav(nm),listcresc,listdecresc
- character*128 txtdynq
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- logical fontslur,upslur,WrotePsslurDefaults
- character*1 durq,chax
- character*4 dynsymq
- character*128 lineq
-c
-c Get info for dynamic mark. Enter after getting "D", iccount sits on "D"
-c Bits in idyndat are as follows
-c 00-03 ivx
-c 04-11 ip
-c 12-15 code for type of mark
-c 0 => arbitrary text
-c 1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff
-c If (.not. fontslur)
-c 13 => hairpin start, 14,15 => <,> (ending)
-c else
-c 13 < start, 14 > start, 15 ending
-c end if
-c 16 flag for vertical offset
-c 17-23 vertical offset + 64 , \internote
-c 31 Hairpin start (0), stop (1)
-c
-c idynda2
-c
-c 00 flag for horizontal offset
-c 01-09 (horizontal offset)/10 + 25.6 notehead widths
-c 10 5th bit for ivx (5/15/10)
-c
- irest = ibset(irest,26)
- ndyn = ndyn+1
- idyn = ivx
- idynda2(ndyn) = 0
- if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1)
- call setbits(idyn,8,4,ip)
- if (lineq(iccount+1:iccount+1) .eq. '"') then
-c
-c text-dynamic
-c
- ntxtdyn = ntxtdyn+1
- iccountt = iccount
-3 continue
- iend = iccountt+index(lineq(iccountt+2:128),'"')+2
- if (lineq(iend-2:iend-2) .eq. '\') then
- iccountt = iend-2
- go to 3
- end if
- txtdynq(ntxtdyn) = lineq(iccount+2:iend-2)
-c
-c Store ivx, ip in bits 0-12
-c
- ivxiptxt(ntxtdyn) = ivx+32*ip
- ipm = index('- +',lineq(iend:iend))
- idno = 0
- else
-c
-c Word-group or hairpin
-c
- do 1 iend = iccount+2 , 128
- ipm = index('- +',lineq(iend:iend))
-c
-c Exit the loop at first blank, "+", or "-"
-c
- if (ipm .gt. 0) go to 2
-1 continue
-2 continue
- read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
- * dynsymq
- idno = (index(
- * 'ppppppp pp p mp mf f fp sfz ff fff ffff < > ',
- * dynsymq)+3)/4
-c
-c Save for later down
-c
- idno1 = idno
- end if
-c
-c Set flag to check level later if in beam
-c
- iornq = ibset(iornq,23)
- if (idno.ge.14) then
-c
-c Hairpin here. Check if opposite type from one that's already on
-c
- if (idno.eq.14.and.btest(listdecresc,ivx) .or.
- * idno.eq.15.and.btest(listcresc,ivx)) then
- call printl(' ')
- call printl('Started one kind of hairpin while other is on')
- call stop1()
- end if
-c
-c Start or stop?
-c
- if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then
-c
-c Cresc/decresc is on, this is an ending. If fontslur, leave idno as is.
-c
- if (.not.fontslur) idno = 15
- else if (fontslur) then
-c
-c Start of font slur
-c
- idno = 13
- else
-c
-c Start of postscript slur
-c
- idno = idno-1
- end if
- end if
-c
-c Now that we used list[de]cresc, update
-c
- if (idno .ge.13) then
- if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then
-c
-c Something's ending
-c
- if (btest(listcresc,ivx)) then
-c
-c It's a cresc!
-c
- listcresc = ibclr(listcresc,ivx)
- else
- listdecresc = ibclr(listdecresc,ivx)
- end if
- else
-c
-c Something's starting
-c
- if (idno1 .eq. 14) then
-c
-c It's a cresc!
-c
- listcresc = ibset(listcresc,ivx)
- else
- listdecresc = ibset(listdecresc,ivx)
- end if
- end if
- end if
- call setbits(idyn,4,12,idno)
- iccount = iend
- if (ipm .ne. 2) then
-c
-c There is a vertical shift
-c
- idyn = ibset(idyn,16)
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- idno = nint(fnum)
- call setbits(idyn,7,17,(ipm-2)*idno+64)
- ipm = index('- +',durq)
- if (ipm .ne. 2) then
-c
-c There is a horizontal shift
-c
-c idynda2(ndyn) = ibset(idyn,23)
- idynda2(ndyn) = ibset(idynda2(ndyn),0)
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- idno = nint(10*fnum)
- call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256)
- end if
-c
-c iccount should be on the blank at the end of the entire symbol
-c
- end if
- idyndat(ndyn) = idyn
- return
- end
- subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig,
-c * itsofar,nodur,figq,ivupfig,nfigs)
- * itsofar,nodur,figq,ivupfig,ivvfig,nfigs)
- logical isfig
- character*1 charq
- character*10 figq
- character*128 lineq
- nfigs = nfigs+1
- ivupfig = 0
- ivvfig = 0
- itoff = 0
- if (charq .eq. 'x') then
-c
-c Floating figure.
-c
- call getchar(lineq,iccount,charq)
- read(charq,'(i1)')noff
- call getchar(lineq,iccount,charq)
- read(charq,'(i1)')loff
- itoff = noff*ifnodur(loff,'x')
- call getchar(lineq,iccount,charq)
- else
-c
-c Figure on a note
-c
- isfig = .true.
- end if
- itfig = itsofar+itoff-nodur
- lfig = 1
- figq = charq
-5 call getchar(lineq,iccount,charq)
-c if (index(' +',charq) .eq. 0) then
- if (index(' +v',charq) .eq. 0) then
- figq = figq(1:lfig)//charq
- lfig = lfig+1
- go to 5
- else if (charq .eq. '+') then
-c
-c Get vertical offset for figure. Next character after number has to be blank.
-c
- iccount = iccount+1
- call readnum(lineq,iccount,charq,fnum)
- ivupfig = nint(fnum)
- else if (charq .eq. 'v') then
-c
-c Get vertical change in figdrop. Must be last item in figure word.
-c
- isign = 1
- call getchar(lineq,iccount,charq)
- if (charq .eq. '-') then
- isign=-1
- call getchar(lineq,iccount,charq)
- end if
- ivvfig = isign*(ichar(charq)-48)
- end if
- return
- end
- subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
- * lastlev,iv,nv)
- parameter (nm=24)
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg
- character*1 charq,durq
- character*20 voltxtq
- character*128 lineq,litq
- integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm),
- * ndlev(nm,2)
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
-c
-c Grace, comes *before* main note:
-c UNLESS there's an 'A' or 'W' after the 'G'
-c ngrace = # of grace note groups so far in block
-c ivg(ngrace), ipg(ngrace)
-c nng(ngrace) = # of notes in this group: default = 1
-c ngstrt(ngrace) = starting position in nolevg of levels for this grace
-c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)'
-c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
-c slurg(ngrace) = logical for slur; default F, input 's'
-c slashg(ngrace) = T if slash; default is F, input 'x'
-c These data MUST precede note name of first note
-c nolevg, naccg: lists of levels and accid's, indexed as described above.
-c
- ngrace = ngrace+1
- ivg(ngrace) = ivx
- ipg(ngrace) = nnl(ivx)+1
- if (ngrace .eq. 1) then
- ngstrt(ngrace) = 1
- else
- ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1)
- end if
- islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4)
- nng(ngrace) = 1
- multg(ngrace) = 1
- upg(ngrace) = .true.
- slurg(ngrace) = .false.
- slashg(ngrace) = .false.
-18 call getchar(lineq,iccount,charq)
- if (index('WA',charq) .gt. 0) then
-c
-c Grace is on note that was already done, so shift flags forward one note.
-c This puts flag on actual note with grace; later for W will go ahead one more.
-c
- ipg(ngrace) = nnl(ivx)
- islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4)
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4)
- if (slurg(ngrace))
- * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24)
- if (charq .eq. 'A') then
-c
-c close After, clear way-after bit, to ensure priority of most recent A/W
-c
- ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29)
- else
-c
-c Way after; later assign to following note, and position like normal grace.
-c
- ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31)
- end if
- else if (charq .eq. 'm') then
- call getchar(lineq,iccount,charq)
- multg(ngrace) = ichar(charq)-48
- else if (index('123456789',charq) .gt. 0) then
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- nng(ngrace) = nint(fnum)
- else if (charq .eq. 'l') then
- upg(ngrace) = .false.
- else if (charq .eq. 's') then
- slurg(ngrace) = .true.
- if (nnl(ivx) .gt. 0) then
-c
-c If A- or W-grace, set signal to start slur on main note.
-c
- if(btest(ipl(ivx,nnl(ivx)),31) .or.
- * btest(ipl(ivx,nnl(ivx)),29))
- * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24)
- end if
- else if (charq .eq. 'x') then
- slashg(ngrace) = .true.
- else if (charq .eq. 'u') then
- else if (charq .eq. 'X') then
-c
-c Space before main note of grace. Number will come next.
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,graspace(ngrace))
- iccount = iccount-1
- end if
- if (index('abcdefg',charq) .eq. 0) go to 18
-c
-c At this point, charq is first note name in grace
-c
- do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1
- naccg(ing) = 0
- ioct = 0
- if (ing .gt. ngstrt(ngrace)) then
-55 call getchar(lineq,iccount,charq)
- if (charq .eq. ' ') go to 55
- endif
- iclastlev = 0
-9 call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') then
- if (durq.eq.'+') then
- lastlev = lastlev+7
- iclastlev = iclastlev+7
- else if (durq.eq.'-') then
- lastlev = lastlev-7
- iclastlev = iclastlev-7
- else if (index('fsn',durq) .gt. 0) then
- if (naccg(ing) .eq. 0) then
- naccg(ing) = index('fsn',durq)
- else
-c
-c Double accidental
-c
- naccg(ing) = ibset(naccg(ing),2)
- end if
- else
- ioct = ichar(durq)-48
- end if
- go to 9
- end if
- if (ioct .gt. 0) then
- lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
- else
- if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then
- if (ivx .le. nv) then
- kv = 1
- else
- kv = 2
- end if
- lastlev = ndlev(iv,kv)+iclastlev
- end if
- lastlev = lastlev-3
- * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
- end if
- nolevg(ing) = lastlev
-19 continue
-c
-c Grace could come before first note of block, so reset end level.
-c
- if (nnl(ivx).eq.0) then
- if (ivx .le. nv) then
- kv = 1
- else
- kv = 2
- end if
- ndlev(iv,kv) = lastlev
- end if
- return
- end
- subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount,
- * ibaroff,nbars,noinst)
-cccccccccccccccccccccccc
-cc
-cc GetiTransInfo.for
-cc
-cccccccccccccccccccccccc
-c
-c Called from both g1etnote and getnote, after first 'i' in Ki[...]
-c On entry, iccount points to last char retrieved, which is 'i'
-c
-c From1: locgical, true if called from g1etnote
-c ibarcnt: tells whether to set EarlyTransOn to true.
-c EarlyTransOn set false in blkdata, true here, back to false in topfile.
-c
-c 110522/110529
-c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
-c and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0
-c so can pass to topfile (via comInstTrans), which is called before getnote.
-c Otherwise, will store info from getnote. Initialize EarlyTransOn and
-c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote;
-c LaterInstTrans from getnote. Zero both out after use. nInstTrans really
-c only needed for instrument-signatures, not transpositions. iTransAmt is
-c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
-c each staff.
-c
-c iTransAmt stored as fn of instrument #, not like iTransKey which is
-c fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This
-c simplifies use of iTransAmt for all calls to ifnolev.
-c
- parameter (nm=24)
- logical From1
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans,store
- character*128 lineq
- character*1 durq
- durq = 'x' ! Can't initialize in declaration stmt, only works once.
- if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0
- store = (EarlyTransOn.and.ibarcnt.eq.0) .or.
- * (ibarcnt.gt.0.and..not.From1)
- LaterInstTrans = .not.From1 .and. ibarcnt.gt.0
- if (store) nInstTrans = 0
-1 continue
- if (durq .eq. ' ') return
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be an instrument number here!')
- call stop1()
- end if
- if (store) nInstTrans = nInstTrans+1
- call readnum(lineq,iccount,durq,fnum)
- instn = nint(fnum)
- if (instn.gt.noinst) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Instrument number out of range!')
- call stop1()
- end if
- if (store) iInstTrans(nInstTrans) = instn
-c
-c durq is +/- following inst # (for iTransAmt), iccount is on it.
-c
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '1st character after instrument number must be "+,-"!')
- call stop1()
- end if
- itramt = 44-ichar(durq) ! +1/-1 for itramt
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be a transposition amount here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (store) iTransAmt(instn) = nint(fnum)*itramt
-c
-c durq is +/- following iTransAmt (for iTransKey), iccount is on it.
-c
- if (index('+-',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '1st character after transposition amount must be "+,-"!')
- call stop1()
- end if
- ikey = 44-ichar(durq) ! +1/-1
- call g1etchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be a key indicator here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- if (store) iTransKey(nInstTrans) = nint(fnum)*ikey
-c
-c durq is now 1st character after iTransKey, should be either 'i' or ' '
-c
- if (durq.ne.'i'.and.durq.ne.' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'There must be blank or "i" here!')
- call stop1()
- end if
- go to 1
- end
- subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars,
- * lenbar,mtrdenl,nv,first)
-c
-c Use this from both pmxa and pmxb to input and check midi data. "first" tells
-c whether pmxa or pmxb. If .not.first, then tempo and pause commands cause
-c things to be written immediately into the midi storage buffers.
-c
- parameter (nm=24,mv=24576)
- common /comevent/ miditime,lasttime
- logical mmacrec,gottempo
- common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
- * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
- * mmacrec,gottempo
-c
-c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing
-c nmidsec section starts and stops based on PLAYING macros (not recording).
-c
- integer*2 mmidi,midinum(26)
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm)
- integer*2 iinsiv
- character*1 durq
- character*2 instq
- character*128 lineq
- logical first
- common /comdiag/ n69(0:nm),n34(0:nm)
-c
-c Instrument codes
-c
- data midinum
- * / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67,
-c XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX
-c
- * 68,69,71,72,74,75, 8,55 /
-c bsXobXbaXclXflXreXctXvo
-c
-1 call getchar(lineq,iccount,durq)
- if (durq .eq. 't') then
-c
-c Tempo in beats ber minute
-c
- call getchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected an integer here for the pause!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,qpm)
- iccount = iccount-1
- if (.not.first) then
- call midievent('t',nint(qpm),0)
- gottempo = .true.
- end if
- go to 1
- else if (durq .eq. 'p') then
-c
-c Insert a pause. pausemid = pause in 1/4's
-c
- call getchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a number here for the pause!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,pausemid)
- iccount = iccount-1
- if (.not.first) then
-c
-c Compute a meter for the pause. This is only to keep MidiNotate on track.
-c Round pause to nearest 16th. Let denominator always be 16.
-c
- numb16 = nint(pausemid*4)
- call midievent('m',numb16,16)
-c
-c Put in pausemid beats of rest
-c
- do 3 icm = 0 , numchan-1
- call addmidi(icm,0,0,0,4.*numb16,.true.,.false.)
-3 continue
- miditime = miditime+nint(240*pausemid)
-c
-c Restore meter
-c
- call midievent('m',mtrdenl*lenbar/64,mtrdenl)
- end if
- go to 1
- else if (durq .eq. 'i') then
-c
-c Instrument numbers or letters. Expect noinst of them.
-c
- do 2 ivx = 1 , noinstarg
- call getchar(lineq,iccount,durq)
- if (ichar(durq) .gt. 96) then
-c
-c It's a lowercase letter. Get another, find corr. instrument #.
-c
- instq(1:1) = durq
- call getchar(lineq,iccount,durq)
- instq = instq(1:1)//durq
- iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'//
- * 'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3
- if (iname .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Unrecognized 2-letter midi instrument name!')
- call stop1()
- end if
- midinst(ivx) = midinum(iname)-1
- else
-c
-c Expect a number, followed by ":" if that is followed by another number.
-c I.e., if after call to readnum, durq is not ":", it must be either blank
-c or next instrument letter.
-c
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a midi instrument number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- midinst(ivx) = nint(fnum)-1
- if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Midi instrument number must be in range 1-128!')
- call stop1()
- end if
- if (durq .ne. ':') iccount = iccount-1
- end if
-2 continue
- go to 1
- else if (durq .eq. 'v') then
-c
-c Get volumes for each instrument. Expect noinst of them.
-c Follow same pattern as for insttrument numbers above.
-c
- do 7 ivx = 1 , noinstarg
- call getchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a midi velocity number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- midivel(ivx) = nint(fnum)-1
- if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Midi velocity must be in range 1-128!')
- call stop1()
- end if
- if (durq .ne. ':') iccount = iccount-1
-7 continue
- if (.not. first) then
- call inst2chan(midvelc,midivel,midchan,nv,iinsiv,twoline)
- end if
- go to 1
- else if (durq .eq. 'b') then
-c
-c Get balance for each instrument. Expect noinst of them.
-c Follow same pattern as for instrument numbers above.
-c
- do 8 ivx = 1 , noinstarg
- call getchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a balance number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- midibal(ivx) = nint(fnum)-1
- if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Midi balance must be in range 1-128!')
- call stop1()
- end if
- if (durq .ne. ':') iccount = iccount-1
-8 continue
- if (.not. first) then
- call inst2chan(midbc,midibal,midchan,nv,iinsiv,twoline)
- end if
- go to 1
- else if (durq .eq. 'T') then
-c
-c Get transposition for each instrument. Expect noinst of them.
-c Follow similar pattern as above, but separator is +|-.
-c
- do 9 ivx = 1 , noinstarg
- call getchar(lineq,iccount,durq)
- ipm = index('-+',durq)
- if (ipm .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected "+" or "-" for midi transposition here!')
- call stop1()
- end if
- ipm = 2*ipm-3
- call getchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected a number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- miditran(ivx) = ipm*nint(fnum)
-c if (mod(miditran(ivx),12).ne. 0) then
-c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
-c * 'Midi transposition limited to multiples of 12!')
-c call stop1()
-c end if
- iccount = iccount-1
-9 continue
- if (.not. first) then
- call inst2chan(midtc,miditran,midchan,nv,iinsiv,twoline)
- end if
- go to 1
- else if (durq .eq. 'g') then
- call getchar(lineq,iccount,durq)
- if (index('0123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected an integer here for the midi gap!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- mgap = nint(fnum)
- iccount = iccount-1
- go to 1
- else if (durq .eq. 'M') then
-c
-c MidiMacros
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'R') then
-c
-c Start recording
-c
- if (mmacrec) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'You tried to record a MidiMacro while already recording!')
- call stop1()
- end if
- mmacrec = .true.
- call getchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected MidiMacro ID number here!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- if (.not.first) then
- immac = nint(fnum)
- if (immac .gt. 20) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'MidiMacro ID cannot exceed 20!')
- call stop1()
- end if
-c
-c Save the start time
-c
- mmactime(immac) = miditime
- do 4 icm = 0 , numchan
- if (icm .lt. numchan) then
- if (restpend(icm)) then
-c
-c Adjust if there's a rest at end of prior section. Insert dummy turnoff.
-c (This causes two turn-offs in a row, which testmidi sees as an error).
-c
-c Before: section1 ------rest------- section2(to be recorded)
-c After: section1 rest1 now rest2 section2(recorded)
-c
- call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
- trest(icm) = 0
- restpend(icm) = .false.
- end if
- else
- if (miditime .gt. lasttime) then
-c
-c Insert a dummy turnoff in conductor track
-c
- call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
- * .false.,.true.)
- lasttime = miditime
- end if
- end if
- mmacstrt(icm,immac) = imidi(icm)+1
-4 continue
- end if
- go to 1
- else if (index('123456789P',durq) .eq. 0) then
-c
-c End recording; close the open macro. Get immac from common.
-c
- if (.not.mmacrec) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'You tried to end a MidiMacro before starting one!')
- call stop1()
- end if
- mmacrec = .false.
- iccount = iccount-1
- if (.not.first) then
-c
-c Save the macro duration
-c
- mmactime(immac) = miditime-mmactime(immac)
- do 5 icm = 0 , numchan
- if (icm .lt. numchan) then
- if (restpend(icm)) then
- call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
- trest(icm) = 0
- restpend(icm) = .false.
- end if
- else
- if (miditime .gt. lasttime) then
-c
-c Insert a dummy turnoff in conductor track if needed.
-c
- call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
- * .false.,.true.)
- lasttime = miditime
- end if
- end if
- mmacend(icm,immac) = imidi(icm)
-5 continue
- end if
- if (durq .ne. ' ')go to 1
- else if (durq .eq. 'P') then
-c
-c Play Back a Macro
-c
- call getchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Expected MidiMacro ID number here!')
- call stop1()
- end if
- if (mmacrec) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'You tried to play a MidiMacro before ending recording!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- if (.not.first) then
- immac = nint(fnum)
- if (mmactime(immac) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Cannot play a MIDI macro before recording it!')
- call stop1()
- end if
- do 6 icm = 0 , numchan
- if (icm .lt. numchan) then
- if (restpend(icm)) then
- call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
- trest(icm) = 0.
- restpend(icm) = .false.
- end if
- else
- if (miditime .gt. lasttime) then
-c
-c Insert a dummy turnoff in conductor track
-c
- call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
- * .false.,.true.)
- end if
- end if
- msecend(icm,nmidsec) = imidi(icm)
- msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac)
- msecend(icm,nmidsec+1) = mmacend(icm,immac)
- msecstrt(icm,nmidsec+2) = imidi(icm)+1
-6 continue
- nmidsec = nmidsec+2
-c
-c Update running time
-c
- miditime = miditime+mmactime(immac)
- lasttime = miditime
- end if
- go to 1
- else
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in MidiMacro sub-command!')
- call stop1()
- end if
- else if (durq .eq. 'd') then
- debugmidi = .true.
- go to 1
- else if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character in MIDI input data!')
- write(*,'(a)')
- * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
- * 'should be noinst, not nv'
- write(15,'(a)')
- * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
- * 'should be noinst, not nv'
- call stop1()
- end if
- if (.not.gottempo .and. .not.first) then
-c
-c If no tempo is set on first call on the pmxb pass, then set it
-c
- call midievent('t',96,0)
- gottempo = .true.
- end if
- return
- end
- subroutine getnote(loop)
- parameter (nm=24,mv=24576)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink,ignorenats,newmbrhgt
- common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*10 figq
- character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax
- logical beamon,firstgulp,figbass,figchk,isfig
- character*60 cheadq
- character*120 instrq,titleq,compoq
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
- * inhead
- common /cominbot/ inbothd
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
- * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
- * OptLineBreakTies,HeaderSpecial
- common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
- * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
- * rptprev,equalize,rptfq1,rptfq2
- common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg,fbon,ornrpt,shifton,setis,notcrd,isbjmp,
- * was2,nobar1,quoted,isbj2,stickyS,
- * OptLineBreakTies,HeaderSpecial
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- character*128 litq
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- common /combc/ bcspec
- common /comas3/ ask(2500),iask,topmods
-c
-c nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined
-c ivx is current ivmx, and is the index for all notes, acc's etc.
-c
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
- common /comtrans/ cheadq
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
- * ic1mac(20),ilmac,iplmac
- common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
- * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
- * idynda2(99),levhssav(nm),listcresc,listdecresc
- common /comclefq/ clefq(nm)
- common /comtol/ tol
- common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
- * ArpShift(20)
- character*128 txtdynq
- logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur,
- * fontslur,WrotePsslurDefaults
- character*128 lineq,lnholdq,lineqt
- character*80 headrq, lowerq
- character*79 inameq
- character*59 hdlndq
- character*20 voltxtq
- character*1 charq,dotq,durq,ulfbq,dumq
- logical loop,lastchar,lower,rptnd1,rptprev,bcspec,moved,
- * topmods,headlog,btest,sluron,cdot,equalize
- character*24 tempq
- logical novshrinktop,cstuplet
- common /comnvst/ novshrinktop,cstuplet
- logical kbdrests
- common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idumm1,isig1,
- * mbrestsav,kchmid(18),logdumm1,logdumm2,barend,noinst,logdumm3
- logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3
- common /combibarcnt/ ibarcnt
- common /commidisig/ midisig
- common /comlyr/ inputmlyr
- logical inputmlyr
- common /combottop/ botamt,topamt,bottopgap
- logical bottopgap
- logical inxtup
- common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
- * poefa
- real*4 poefa(125)
- logical nocodabn
- cdot = .false.
- inxtup = .false.
-1 call getchar(lineq,iccount,charq)
- if (lastchar) return
- if (charq .eq. ' ') go to 1
- if (charq .eq. '%') then
-c
-c Check for a bar number format:
-c
- if (iccount.eq.1 .and. lineq(2:2).eq.' ' .and.
- * index('bB1234567890',lineq(3:3)).gt.0) then
- if (islast) write(11,'(a)')lineq(1:lenstr(lineq,128))
- end if
- iccount = 128
- go to 1
- end if
-c
-c Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r'
-c
- if (rptprev) then
- rptnd1 = charq .eq. '/'
- rptprev = .false.
- end if
-c
-c Repeat at end of a piece
-c
- if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
- * charq.eq.'r') then
- if (cdot) go to 28
-c
-c This is a note/rest.
-c
- idotform = 0
- numnum = 0
-c
-c If start of line of music, set pitch from previous
-c
- if (ivx .le. nv) then
- kv = 1
- else
- kv = 2
- end if
- if (nnl(ivx).eq.0) lastlev = ndlev(iv,kv)
-c
-c notcrd is used to tell if orn. goes on main note or chord note
-c
-c notcrd = .true. !Move dow. Was not observed if dotted shortcut.
-c
-c Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts.
-c
-28 continue
-c
-c Moved this from just above, 2 Feb 02
-c
- notcrd = .true.
- nnl(ivx) = nnl(ivx)+1
- if (ornrpt) then
-c
-c Replicate ornament bits, also bit 23 for beam handling if chord.
-c
- iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),iornq(ivx,0))
- if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c This is a trill (bit 7 or 15) so must dup the parameters
-c
- ntrill = ntrill + 1
- ivtrill(ntrill) = ivx
- iptrill(ntrill) = nnl(ivx)
- xnsktr(ntrill) = xnsktr(ntrill-1)
- end if
- end if
- if (stickyS) then
-c
-c Grab stemlength shortening parameters from prior note
-c
- mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
-c call setbits (mult(ivx,nnl(ivx)),3,28,
-c * igetbits(mult(ivx,nnl(ivx)-1),3,28))
- call setbits (mult(ivx,nnl(ivx)),6,10,
- * igetbits(mult(ivx,nnl(ivx)-1),6,10))
- end if
- if (autofbon .and. tautofb.gt.tol .and. .not.fbon) then
-c
-c Doing auto forced beams, and period has been set, so check if this note
-c starts a period.
-c
-c if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then
- if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
-c
-c Start a forced beam here
-c
- nfb(ivx) = nfb(ivx)+1
- fbon = .true.
- ulfbq(ivx,nfb(ivx)) = 'x'
- t1fb(ivx,nfb(ivx)) = itsofar(ivx)
- end if
- end if
- if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
- dotq = 'x'
- if (charq.eq.'r')
- * irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
- if (btest(irest(ivx,nnl(ivx)),0)) then
-c
-c Rest stuff. First check if previous note was full-bar-pause
-c
- if (lineq(iccount+1:iccount+1) .eq.' '
- * .and. nnl(ivx).gt.1) then
- if (btest(islur(ivx,nnl(ivx)-1),19))
- * islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
- end if
-c
-c Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2
-c for voice a or b. Set a-types at 0 as encountered and adjust later
-c after '//'. (Override heights will be set to 100+offset)
-c
- if (ivx .le. nv) then
- nolev(ivx,nnl(ivx)) = 0
- else
- nolev(ivx,nnl(ivx)) = 2
- end if
- end if
-2 call getchar(lineq,iccount,durq)
- ic = ichar(durq)
- if (ic.le.57 .and. ic.ge.48) then
-c
-c Digit
-c
- if (numnum .eq. 0) then
- nnodur = ic-48
- numnum = 1
- go to 2
- else if (numnum .eq. 1) then
- ioct = ic-48
- numnum = 2
- go to 2
- else
- print*,'>2 digits in note sym., ivx,nn:',ivx,nnl(ivx)
- call stop1()
- end if
- else if (durq .eq. 'd') then
- dotq = durq
- if (lineq(iccount+1:iccount+1) .eq. 'd') then
-c
-c Double dot.
-c
- iccount = iccount+1
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),3)
- end if
- if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c move a dot, unless next char is not part of a number
-c
- if (index('0123456789.',lineq(iccount+2:iccount+2)) .eq. 0)
- * go to 2
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19)
- call getchar(lineq,iccount,durq)
- ndotmv(ivx) = ndotmv(ivx)+1
- iccount=iccount+1
- call readnum(lineq,iccount,dumq,updot(ivx,ndotmv(ivx)))
- if (durq .eq. '-')
- * updot(ivx,ndotmv(ivx)) = -updot(ivx,ndotmv(ivx))
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift also
-c
- iccount=iccount+1
- call readnum(lineq,iccount,durq,rtdot(ivx,ndotmv(ivx)))
- if (dumq .eq. '-')
- * rtdot(ivx,ndotmv(ivx)) = -rtdot(ivx,ndotmv(ivx))
- else
- rtdot(ivx,ndotmv(ivx)) = 0.
- end if
- iccount = iccount-1
- end if
- go to 2
- else if (durq .eq. 'p') then
-c
-c Full-bar rest as pause
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
- go to 2
- else if (durq .eq. 'b') then
-c
-c Blank rest
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
- go to 2
- else if (index('fsn',durq) .gt. 0) then
-c
-c Accidental
-c
-c if (nacc(ivx,nnl(ivx)) .eq. 0) then
-c 171209 May have set bit 18 earlier if D or F preceded accidental
- if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then
-c
-c No accidental has been set yet
-c
-c nacc(ivx,nnl(ivx)) = index('fsn',durq)
- nacc(ivx,nnl(ivx)) =
- * ior(nacc(ivx,nnl(ivx)),index('fsn',durq))
- else
-c
-c Repeated accid, so must be double
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
- end if
- go to 2
- else if (durq .eq. 'i') then
-c
-c Set flag for MIDI-only accidental.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17)
- go to 2
- else if (durq .eq. 'c') then
-c
-c Set flags for cautionary accidental
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
- iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
- go to 2
- else if (index('+-<>',durq) .gt. 0) then
- ipm = index('- +',durq)-2
- if (.not.btest(irest(ivx,nnl(ivx)),0)) then
-c
-c A note, not a rest.
-c
- call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
- if (moved) go to 2
-c
-c Octave jump with a note
-c
- if (numnum .lt. 2) then
- lastlev = lastlev+ipm*7
- else
- ioct = ioct+ipm*1
- end if
- go to 2
- else
-c
-c Override default height of a rest
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (lineq(iccount-1:iccount-1) .eq. '.') then
-c
-c Kluge in case there is a shortcut ".". It will have been sucked up by
-c readnum. (Same doesn't hold for ",")
-c
- iccount = iccount-1
-c go to 2
- end if
- nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
-c
-c There may be more characters for this rest
-c
- iccount = iccount-1
- go to 2
- end if
- else if (durq .eq. 'x') then
-c
-c Xtuplet. Count number of doubled notes (for unequal xtups)
-c
- if (btest(nacc(ivx,nnl(ivx)),18)) then
- ndoub = 1
- else
- ndoub = 0
- end if
-c
-c Initialize counter for # of non-rests, so can later unbeam if = 1.
-c
- inxtup = .true.
- note1xtup = nnl(ivx)
- nnb = 0
- if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1
-c
-c Will set all durations to 0 except last one. Set flag on this note.
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28)
-c
-c Next input will be digit unless its a "T"
-c
- iccount = iccount+1
- if (lineq(iccount:iccount) .eq. 'T') then
-c
-c Set up tremolo
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2)
- ntup = 2
-c
-c Set default beaming, based on Wikipedia article
-c May be a problem here is nnodur is inherited
-c
- if (nnodur .eq. 4) then
- nsolid = 0
- nindent = 3
- else if (nnodur .eq. 2) then
- nsolid = 3
- nindent = 0
- else if (nnodur .eq. 8) then
- nsolid = 1
- nindent = 2
- end if
- call getchar(lineq,iccount,durq)
- if (index('0123456789',durq) .gt. 0) then
- nsolid = index('0123456789',durq)-1
- if (nsolid.eq.0 .and. nnodur.eq.2) then
- print*,''
- print*,'Unbeamed half-note 2-note tremolo forbidden.'
- call stop1()
- end if
- call getchar(lineq,iccount,durq)
- if (index('0123456789',durq) .gt. 0) then
- nindent = index('0123456789',durq)-1
- end if
- end if
- call setbits(irest(ivx,nnl(ivx)),2,3,nsolid)
- call setbits(irest(ivx,nnl(ivx)),2,5,nindent)
- if (nsolid .eq. 0) then
- islur(ivx,nnl(ivx)) =
- * ibset(islur(ivx,nnl(ivx)),18)
- end if
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31)
- islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21)
- call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid)
-c
-c Set some force-beam parameters for the tremolo
-c
-c Need to check if there's already a forced beam explicitly set here.
-c If there was, shouldn't do any harm resetting parameters.
-c
- if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx))
- * nfb(ivx) = nfb(ivx)+1
- fbon = .true.
- ulfbq(ivx,nfb(ivx)) = 'x'
- t1fb(ivx,nfb(ivx)) = itsofar(ivx)
- t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq)
- nadj = 0
-c
-c Set open beamed notehead flag for half-note tremolo
-c Just gave 2 quarters with or without flag set. Need to fix
-c
- else
- call readnum(lineq,iccount,durq,fnum)
- ntup = nint(fnum)
- end if
- if (index('DF',durq) .gt. 0) then
-c
-c
-c Double xtup note to make an un= xtup. Here xtup number already set but may also
-c have this command before.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
- * ibset(nacc(ivx,nnl(ivx)),19)
- ndoub = 1
- call getchar(lineq,iccount,durq)
- else if (durq .eq. 'd') then
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
- call getchar(lineq,iccount,durq)
- end if
-c
-c Only other possibilities here are ' ' or 'n'
-c
- if (durq .eq. 'n') then
-c
-c Alter xtup number
-c
- if (lineq(iccount+1:iccount+1) .eq. ' ') then
-c
-c If the only modifier is 'n', cancel the number
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31)
- else
- numshft = 0
-30 call getchar(lineq,iccount,durq)
- if (durq .eq. 'f') then
-c
-c Flip up-down-ness
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),14)
- go to 30
- else if (index('+-',durq) .gt. 0) then
-c
-c Vertical or horiz shift
-c
- numshft = numshft+1
- iofforn = 1
- if (durq .eq. '-') iofforn = -1
- iccount = iccount+1
- call readnum(lineq,iccount,durq,xofforn)
- iccount = iccount-1
- if (numshft .eq. 1) then
-c
-c Vertical shift
-c 160214 Allow (-64,64)
-c iofforn = iofforn*nint(xofforn) + 16
- iofforn = iofforn*nint(xofforn) + 64
-c
-cc Turn on bit 1; set bits 2-6 to iofforn
-c Turn on bit 1 of irest; set bits 16-22 of mult to iofforn
-c
-c irest(ivx,nnl(ivx)) =
-c * ior(irest(ivx,nnl(ivx)),2+4*iofforn)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),1)
- call setbits(mult(ivx,nnl(ivx)),8,16,iofforn)
- else
-c
-c Horizontal shift
-c
- iofforn = iofforn*nint(xofforn*10)+16
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),7)
- call setbits(irest(ivx,nnl(ivx)),5,9,iofforn)
- end if
- go to 30
- else if (durq .eq. 's') then
-c
-c Slope adjustment for bracket
-c
- mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),4)
- call getchar(lineq,iccount,durq)
- iofforn = index('- +',durq)-2
- iccount = iccount+1
- call readnum(lineq,iccount,durq,xofforn)
- iccount = iccount-1
- iofforn = nint(iofforn*xofforn+16)
- call setbits(mult(ivx,nnl(ivx)),5,5,iofforn)
- else if (index('123456789',durq) .gt. 0) then
-c
-c Replacement printed number
-c
- call readnum(lineq,iccount,durq,xofforn)
- call setbits(nacc(ivx,nnl(ivx)),5,22,nint(xofforn))
- iccount = iccount-1
- go to 30
- end if
- end if
- end if
-c
-c Set note level of 1st note of xtup, provided not a rest
-c
- if (.not.btest(irest(ivx,nnl(ivx)),0)) then
- if (numnum .eq. 2) then
- lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
- nolev(ivx,nnl(ivx)) = lastlev
- else
- lastlev = lastlev-3
- * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
- nolev(ivx,nnl(ivx)) = lastlev
- end if
- end if
- do 40 npreslur = npreslur , 1 , -1
-c
-c Set note level for preslur on starting note of xtuplet
-c
- call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
-40 continue
- numnum = 0
- nodur(ivx,nnl(ivx)) = 0
- do 6 itup = 2 , ntup
- if (ornrpt) then
- iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
- * iand(iornq(ivx,nnl(ivx)-1),10026991))
- if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c This is a trill (bit 7 or 15) so must dup the parameters
-c
- ntrill = ntrill + 1
- ivtrill(ntrill) = ivx
- iptrill(ntrill) = nnl(ivx)
- xnsktr(ntrill) = xnsktr(ntrill-1)
- end if
- end if
- nnl(ivx) = nnl(ivx)+1
- if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
-7 call getchar(lineq,iccount,charq)
- if (charq .eq. ' ') then
- go to 7
- else if (charq .eq. '%') then
- iccount = 128
- go to 7
- else if (charq .eq. 'o') then
-c
-c Ornament in xtuplet. "o" symbol must come AFTER the affected note
-c
- if (notcrd) then
- nole = nolev(ivx,nnl(ivx)-1)
- else
- nole = iand(127,ishft(icrdat(ncrd),-12))
- end if
- call getorn(lineq,iccount,iornq(ivx,nnl(ivx)-1),
- * iornq(ivx,0),ornrpt,noffseg,
- * nnl(ivx)-1,ivx,.false.,notcrd,nole)
- go to 7
- else if (index('st(){}',charq) .gt. 0) then
- nnlivx = nnl(ivx)-1
- if (charq.eq.'(' .or. charq.eq.'{') then
-c
-c Detected preslur in xtuplet loop, non-chord note
-c
- nnlivx = nnlivx+1
- npreslur = npreslur+1
- end if
- islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
- if (charq.eq.'t') islur(ivx,nnlivx) =
- * ibset(islur(ivx,nnlivx),1)
- if (ivx .le. nv) then
- kv = 1
- else
- kv = 2
- end if
- if (fontslur) then
- call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
- * isdat3,nsdat,notcrd,nolev(ivx,nnlivx),charq)
- else
- call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
- * isdat3,isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
- end if
- go to 7
- else if (charq .eq. 'G') then
-c
-c Kluge to get grace in xtup at right location
-c
- nnl(ivx) = nnl(ivx)-1
- call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
- * lastlev,iv,nv)
- nnl(ivx) = nnl(ivx)+1
- go to 7
- else if (charq .eq. sq) then
- call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
- go to 7
- else if (charq .eq. '"') then
-c
-c pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\
-c
- if (.not. inputmlyr) then
- ictemp = 0
- lineqt = sq//sq//sq//'input musixlyr '//sq
- call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp)
- inputmlyr = .true.
- end if
- call dopmxlyr(lineq,iccount)
- charq = sq
- call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
- go to 7
- else if (index('0123456789#-nx_',charq) .gt. 0) then
-c
-c Figure. Must come AFTER the first note of xtup
-c
- ivf = 1
- if (ivx .gt. 1) then
- if (ivxfig2 .eq. 0) then
- ivxfig2 = ivx
- else if (ivx .ne. ivxfig2) then
- print*
- print*,'Figures not allowed in >1 voice above first'
- stop
- end if
- ivf = 2
- end if
- nfig1 = nfigs(ivf)+1
- call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
- * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx),
-c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf))
- * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),
- * nfigs(ivf))
- go to 7
- else if (charq .eq. 'X') then
- call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)),
- * shifton,wheadpt,iornq(ivx,nnl(ivx)),ivx,
- * irest(ivx,nnl(ivx)),itsofar(ivx),ntup,itup,nnodur,
- * dotq,ndoub)
- go to 7
- else if (charq .eq. 'z') then
-c
-c Chord note in xtup. Goes with *prior* note.
-c
- notcrd = .false.
- ncrd = ncrd+1
- ipl(ivx,nnl(ivx)-1) = ibset(ipl(ivx,nnl(ivx)-1),10)
- numnum = 0
-c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
- icrdat(ncrd) = nnl(ivx)-1
- call setbits(icrdat(ncrd),4,8,mod(ivx,16))
- if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
- icrdorn(ncrd) = 0
-c
-c Get note name
-c
- call getchar(lineq,iccount,charq)
-c
-c Get optional inputs
-c
-34 call getchar(lineq,iccount,durq)
-c
-c When chord note is done, will get ' ', making ndx=0, so go past this block
-c
- ndx = index('fsn+-<>12345678reicd',durq)
- if (ndx .gt. 0) then
- if (ndx .le. 3) then
- if (.not.btest(icrdat(ncrd),19)) then
- icrdat(ncrd) = ibset(icrdat(ncrd),19)
- icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
- else
- icrdat(ncrd) = ibset(icrdat(ncrd),22)
- end if
- else if (durq .eq. 'd') then
-c
-c Get dot on chord note in xtup. Assume +n+n
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),26)
- call getchar(lineq,iccount,durq)
- iccount=iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (durq .eq. '+') then
- icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64)
- else
- icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64)
- end if
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift specified also
-c
- iccount=iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (dumq .eq. '+') then
- ifnum = nint(fnum*10)+64
- else
- ifnum = -nint(fnum*10)+64
- end if
- else
- ifnum = 64
- end if
- icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7))
- iccount = iccount-1
-c iccount = iccount+4
-c
-c
-c
- else if (ndx .eq. 19) then
-c
-c Set flags for cautionary accidental
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),31)
- iornq(ivx,nnl(ivx)-1) =
- * ibset(iornq(ivx,nnl(ivx)-1),31)
- else if (ndx .le. 7) then
-c
-c +/-/</> Check whether octave or accidental shift
-c
- nactmp = 0
- call chkpm4ac(lineq,iccount,nactmp,moved)
- if (moved) then
-c
-c Transfer accidental shift values
-c
- call setbits(icrdot(ncrd),6,14,
- * igetbits(nactmp,6,4))
- call setbits(icrdot(ncrd),7,20,
- * igetbits(nactmp,7,10))
- else
- if (durq .eq. '+') then
- lastlev = lastlev+7
- else if (durq .eq. '-') then
- lastlev = lastlev-7
- end if
- end if
- else if (durq .eq. 'e') then
- icrdat(ncrd) = ibset(icrdat(ncrd),23)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
- else if (durq .eq. 'r') then
- icrdat(ncrd) = ibset(icrdat(ncrd),24)
- irest(ivx,nnl(ivx)-1) =
- * ibset(irest(ivx,nnl(ivx)-1),20)
- else if (durq .eq. 'i') then
-c
-c Midi-only accidental
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),27)
- else
-c
-c must be a number, save it in ioct
-c
- numnum = 1
- ioct = ndx-7
- end if
- go to 34
- end if
- if (numnum .eq. 1) then
- lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
- else
- lastlev = lastlev-3
- * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
- end if
- icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
- do 41 npreslur = npreslur , 1 , -1
-c
-c Set note level for preslur on chord note in xtup
-c
- call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-c
-c Following lines copied from loop for non-xtup, chord note, preslur
-c Initially I assigned the slur(s) to next note, so fix.
-c
- islur(ivx,nnl(ivx)) = ibclr(islur(ivx,nnl(ivx)),0)
- islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),0)
- isdat2(nsdat-npreslur+1) =
- * ibset(isdat2(nsdat-npreslur+1),0)
- call setbits(isdat1(nsdat-npreslur+1),8,3,
- * igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
-41 continue
- go to 7
- else if (charq .eq. '?') then
-c
-c Arpeggio
-c
- if (btest(ipl(ivx,nnl(ivx)-1),10)) then
-c
-c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note
-c of chord, will not set icrdat(25), but iornq(27)
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),25)
- else
- iornq(ivx,nnl(ivx)-1) = ibset(iornq(ivx,nnl(ivx)-1),27)
- end if
-c
-c Check for shift
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. ' ') then
- iccount = iccount-1
- else
-c
-c durq must be "-"
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
-c
-c record the shift
-c
- NumArpShift = NumArpShift+1
- IvArpShift(NumArpShift) = ivx
- IpArpShift(NumArpShift) = nnl(ivx)-1
- ArpShift(NumArpShift) = fnum
- end if
- go to 7
- else if (charq .eq. 'D') then
- call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1),
- * iornq(ivx,nnl(ivx)-1),lineq,iccount)
- go to 7
-c
-c 140215 Allow clef change inside xtuplet. With normal code, came out one
-c note too late, so try making it come earlier.
-c
- else if (charq .eq. 'C') then
-c
-c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music.
-c
- if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1
-c
-c 140218 Need to get time differently inside xtup, since itsofar doesn't get
-c updated until after xtup is done
-c
- nodurt = ifnodur(nnodur,dotq)
- tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1))
- isl = ibset(islur(iv,nnl(iv)),11)
- call getchar(lineq,iccount,durq)
-c
-c Store clef number, or 7 if clef number = 9 (French violin clef)
-c
- isl = ior(isl,ishft(min(numclef(durq),7),12))
- ncmidcc(iv,ncc(iv)) = ncmidf(durq)
- if (durq .eq. '8') then
- ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2)
- iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
- end if
-c
-c Set marker on note with lowest voice # starting at same time.
-c
- if (iv .eq. 1) then
- isl = ibset(isl,15)
- else
- do 70 iiv = 1 , iv
-c nnliiv = nnl(iiv)
- nnliiv = nnl(iiv)-1
- if (iiv .eq. iv) nnliiv = nnliiv+1
- itother = 0
- do 71 iip = 1 , nnliiv
- if (itother .lt. itsofar(iv)) then
- itother = itother+nodur(iiv,iip)
- go to 71
- else if (itother .eq. itsofar(iv)) then
- islur(iiv,iip) = ibset(islur(iiv,iip),15)
- go to 72
- end if
-71 continue
-70 continue
-72 continue
- end if
-c
-c Need 'or' since may have set bit 15 in the above loop
-c
-c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
- islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv)))
- go to 7
-c+++
- else if (charq .eq. ']') then
-c
-c Multiplicity up-down, must have '][ '
-c
- islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),20)
- iccount = iccount+2
- go to 7
-cc+++
- end if
-c
-c End of loop for xtup options. If here, charq must be a (non-crd) note name.
-c or rest
-c
- if (charq .eq. 'r') then
-c
-c Rest in xtup
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
- if (index('+-b',lineq(iccount+1:iccount+1)) .gt. 0) then
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'b') then
-c
-c Blank rest in middle of xtup
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
- else
-c
-c Override height of embedded xtup rest
-c
- ipm = index('- +',durq)-2
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
- iccount = iccount-1
- end if
- else if (ivx .le. nv) then
- nolev(ivx,nnl(ivx)) = 0
- else
- nolev(ivx,nnl(ivx)) = 2
- end if
- else
-c
-c Counter for non-rests
-c
- nnb = nnb+1
- end if
- notcrd = .true.
-8 call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') then
- if (index('+-<>',durq) .gt. 0) then
-c
-c Accidental horizontal shift
-c
- call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
- if (.not.moved) then
- if (durq.eq.'+') then
- lastlev = lastlev+7
- else if (durq.eq.'-') then
- lastlev = lastlev-7
- end if
- end if
- else if (index('fsn',durq) .gt. 0) then
-c
-c if (nacc(ivx,nnl(ivx)) .eq. 0) then
-c May have set other bits earlier
- if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then
-c
-c No accid set yet
-c
-c nacc(ivx,nnl(ivx)) = index('fsn',durq)
- nacc(ivx,nnl(ivx)) =
- * ior(nacc(ivx,nnl(ivx)),index('fsn',durq))
- else
-c
-c Symbol must be repeated, so it's a double
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
- end if
- else if (durq .eq. 'i') then
-c
-c Set flag for midi-only accidental
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17)
-
- else if (durq .eq. 'c') then
-c
-c Set flags for cautionary accidental
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
- iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
- else if (index('ul',durq) .gt. 0) then
-c
-c Force stem direction for non-beamed xtup note
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
- if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
- * ibset(islur(ivx,nnl(ivx)),17)
- else if (durq .eq. 'e') then
-c
-c Left-shift main xtup note
-c
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
- else if (durq .eq. 'r') then
-c
-c Right-shift main xtup note
-c
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
- else if (index('DF',durq) .gt. 0) then
-c
-c Double an xtup note to make an unequal xtup
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
- * ibset(nacc(ivx,nnl(ivx)),19)
- ndoub = ndoub+1
- else if (durq .eq. 'd') then
-c
-c Dotted xtup note
-c
-c if (btest(irest(ivx,nnl(ivx))-1,2)) then
- if (btest(irest(ivx,nnl(ivx)-1),2)) then
-c
-c Move dot on 2nd note of 2-note tremolo
-c
- ndotmv(ivx) = ndotmv(ivx)+1
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19)
- call g1etchar(lineq,iccount,durq) ! Will be + or -
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,
- * updot(ivx,ndotmv(ivx)))
- if (durq .eq. '-') updot(ivx,ndotmv(ivx)) =
- * -updot(ivx,ndotmv(ivx))
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift also
-c
- call readnum(lineq,iccount,durq,
- * rtdot(ivx,ndotmv(ivx)))
- if (durq .eq. '-') rtdot(ivx,ndotmv(ivx))
- * = -rtdot(ivx,ndotmv(ivx))
- end if
- iccount = iccount-1
- else
-c
-c Dot for 3:1 pair of xtup notes
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
- end if
- else
-c
-c Must be an octave number
-c
- lastlev = ifnolev(charq,ichar(durq)-48
- * ,iTransAmt(instno(iv)))
- end if
- go to 8
- end if
- if (itup .lt. ntup) then
-c
-c Last note is handled *after* flowing out of the xtup if block, but still
-c within block for a note-rest. Set note level now (rest already done).
-c Could have problem here if rests & doubled notes are combined in xtup,
-c since might exit the loop at the wrong place. Worry about it later.
-c
- if (.not.btest(irest(ivx,nnl(ivx)),0)) then
- lastlev = lastlev-3+mod(ifnolev(charq,10,
- * iTransAmt(instno(iv)))-lastlev+3,7)
- nolev(ivx,nnl(ivx)) = lastlev
- end if
- nodur(ivx,nnl(ivx)) = 0
- do 42 npreslur = npreslur , 1 , -1
-c
-c Set note level for preslur on internal xtup note
-c
- call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-42 continue
- end if
- if (itup .eq. ntup-ndoub) go to 12
-6 continue
-12 continue
- if (ornrpt) then
- iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
- * iand(iornq(ivx,nnl(ivx)-1),10026991))
- if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
-c
-c This is a trill (bit 7 or 15) so must dup the parameters
-c
- ntrill = ntrill + 1
- ivtrill(ntrill) = ivx
- iptrill(ntrill) = nnl(ivx)
- xnsktr(ntrill) = xnsktr(ntrill-1)
- end if
- end if
-c
-c End of if-block for xtuplet input
-c
- else if (durq .eq. 'm') then
-c
-c Multi-bar rest: next 1 or two digits are # of bars.
-c For some purposes, pretend its one bar only
-c
- nodur(ivx,nnl(ivx)) = lenbar
- ibarmbr = nbars+1
- mbrest = 0
- xb4mbr = 0.
-20 call getchar(lineq,iccount,durq)
- if (ichar(durq).ge.48.and.ichar(durq).le.57) then
- mbrest = 10*mbrest+ichar(durq)-48
- go to 20
- end if
-c
-c durq will either be blank or 'n'
- if (durq .eq. 'n') then
-c
-c Get new height
-c
- iplmi = 1
- call g1etchar(lineq,iccount,durq)
- if (durq .eq. '-') then
- iplmi = -1
- iccount = iccount+1
- end if
- call readnum(lineq,iccount,durq,hgt)
- mbrhgt = nint(iplmi*hgt)
- newmbrhgt = .true.
- end if
- else if (index('ul',durq) .gt. 0) then
-c
-c Set stem flipper
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
- if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
- * ibset(islur(ivx,nnl(ivx)),17)
- go to 2
- else if (durq .eq. 'a') then
-c
-c "Alone", i.e., prohibit beam
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),18)
- go to 2
- else if (durq .eq. 'r') then
-c
-c Right offset by one notehead
-c
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
- go to 2
- else if (durq .eq. 'e') then
-c
-c Left offset by one notehead
-c
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
- go to 2
- else if (index('LS',durq) .gt. 0) then
-c
-c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5
-c Set mult(27). Map value to 0 to 63, store in mult(10-15). Later convert to
-c interbeams = internotes*2/3.
-c
-c
- isign = 1
- if (durq .eq. 'S') isign = -1
- mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
- call getchar(lineq,iccount,durq)
- if (durq .eq. ':') then
-c
-c End stickyS. Grab data now from prior note, since we have to shut off stickyS.
-c
- call setbits (mult(ivx,nnl(ivx)),6,10,
- * igetbits(mult(ivx,nnl(ivx)-1),6,10))
- stickyS = .false.
- go to 2
- end if
-c
-c If durq .ne. ':' then iccount is now on the start of the number
-c
- call readnum(lineq,iccount,durq,dum)
- dum = isign*dum
- call setbits (mult(ivx,nnl(ivx)),6,10,nint((dum+4.)*2))
- if (durq .eq. ':') then
- stickyS = .true.
- else
- iccount = iccount-1
- end if
- go to 2
- else if (durq .eq. ',') then
-c
-c 2:1 pattern
-c
- idotform = 3
-c
-c Now flow to duration setting, as if durq=' '
-c
- else if (durq .eq. '.') then
-c
-c Dotted pattern. Close out note. Mult time by 3/4.
-c Set time for next note to 1/4. Start the note.
-c
- idotform = 1
- else if (durq .eq. 'o') then
-c
-c Suppress rest centering
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),25)
- go to 2
- else if (durq .eq.'L') then
-c
-c With keyboard rest option, look left
-c
-c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30)
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1)
- go to 2
- else if (index('DF',durq) .gt. 0) then
-c
-c Double note for xtup. Must check here in case "D" came before "x" or on
-c last note of xtup. Need to flag it in pmxa since affects horiz. spacing.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
- if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
- * ibset(nacc(ivx,nnl(ivx)),19)
- go to 2
- else if (durq .eq. 'A') then
-c
-c Accidental option
-c
- call getchar(lineq,iccount,durq)
-c
- if (durq .eq. 'o') then
-c
-c Ordered accidentals in a chord. Mark the main note.
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),28)
- else
-c
-c Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),29)
- iccount = iccount-1
- end if
- go to 2
- else if (durq .eq. 'T') then
- call getchar(lineq,iccount,durq)
- multtrem = index('1234',durq)
- if (multtrem .eq. 0) then
- iccount = iccount-1
- multtrem = 1
- end if
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4)
- call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1)
- go to 2
- else if (durq .ne. ' ') then
- print*,'Illegal character in note: ',durq,', ivx,nn:',
- * ivx,nnl(ivx)
- call stop1()
- end if
-c
-c Done with note/rest options. Set level and duration.
-c
- if (.not.btest(irest(ivx,nnl(ivx)),0)) then
- if (numnum .eq. 2) then
- lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
- nolev(ivx,nnl(ivx)) = lastlev
- else
- lastlev = lastlev-3
- * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
- nolev(ivx,nnl(ivx)) = lastlev
- end if
- do 43 npreslur = npreslur , 1 , -1
-c
-c Set level for preslur on normal note, non-chord
-c
- call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
-43 continue
-c
-c Only matters if last note, non-rest of xtuplet
-c
- nnb = nnb+1
- end if
-c
-c Set flag for unbeamed xtup if it just has 1 note
-c
- if (inxtup .and. nnb.eq.1) then
- islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18)
- end if
- if (idotform .gt. 0) then
- if (idotform .eq. 1) then
- nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)*3/2
- else if (idotform .eq. 2) then
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
- else if (idotform .eq. 3) then
- nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
- else if (idotform .eq. 4) then
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
- end if
- else if (btest(islur(ivx,nnl(ivx)),19)) then
-c
-c Set duration of full-bar rest as pause
-c
- nodur(ivx,nnl(ivx)) = lenbar
-c
-c Use a one-line function to set nnodur. It gives inverse of ifnodur.
-c
- nnodur = index('62514x0x37',
- * chax(48+int(log(.1+lenbar)/.69315)))-1
- else if (ibarmbr.ne.nbars+1) then
- nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
- if (btest(islur(ivx,nnl(ivx)),3))
- * nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
- end if
- if (shifton .and. .not.btest(irest(ivx,nnl(ivx)),16)) then
-c
-c Shift is on, and this is not first shifted note. Check for duration change
-c
- if (nodur(ivx,nnl(ivx)) .ne. nodur(ivx,nnl(ivx)-1)) then
-c
-c Must stop and restart the offset.
-c
- irest(ivx,nnl(ivx)-1) = ibset(irest(ivx,nnl(ivx)-1),17)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),16)
- nudoff(ivx) = nudoff(ivx)+1
- udoff(ivx,nudoff(ivx)) = udoff(ivx,nudoff(ivx)-1)
- end if
- end if
- itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
- if (autofbon .and. tautofb.gt.tol .and. fbon) then
-c
-c Check to see if need to terminate auto forced beam
-c
- if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
-c
-c Terminate autofb
-c
- t2fb(ivx,nfb(ivx)) = itsofar(ivx)
- fbon = .false.
- end if
- end if
- if (mod(itsofar(ivx)-lenb0,lenbar) .eq. 0) then
-c
-c Finished a bar
-c
- nbars = nbars+1
- nib(ivx,nbars) = nnl(ivx)
- if (firstgulp.and.lenb0.ne.0.and.nbars.eq.1) then
-c
-c Just finished the pickup bar for this voice.
-c
- lenbar = lenb1
- end if
- end if
- if (idotform .eq. 1) then
- call getchar(lineq,iccount,charq)
- idotform = 2
- numnum = 1
- go to 28
- else if (idotform .eq. 3) then
- call getchar(lineq,iccount,charq)
- idotform = 4
- numnum = 1
- go to 28
- end if
-c
-c End of sub block for note-rest
-c
- else if (charq .eq. 'z') then
-c
-c Chord note. Must have note name, may have octave#,+,-,s,f,n,d
-c Actually the 'd' is not used, since time value comes from
-c basic note. Unless dot is to be shifted!
-c Doesn't increase # of notes, so must handle separately
-c ncrd: index of crd
-c Set bit 10 of ipl on main note as flag
-c Bits in icrdat:
-c 0-7 ip within voice
-c 8-11 ivx
-c 12-18 note level
-c 19 accidental?
-c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
-c 23 shift left
-c 24 shift right
-c 25 arpeggio start or stop
-c 26 flag for moved dot (here, not icrdot, since this is always reset!)
-c 27 Midi-only accidental
-c 29 Tag for accidental shift...means add to autoshifts.
-c 31 Cautionary accidental
-c
-c Bits in icrdot:
-c 0-6 10*abs(vertical dot shift in \internote) + 64
-c 7-13 10*abs(horizontal dot shift in \internote) + 64
-c 14-19 vert accidental shift-32
-c 20-26 20*(horiz accidental shift+3.2)
-c 27-29 top-down level rank of chord note w/accid. Set in crdaccs.
-c
-c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
-c
- ncrd = ncrd+1
- ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),10)
- numnum = 0
-c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
- icrdat(ncrd) = nnl(ivx)
- call setbits(icrdat(ncrd),4,8,mod(ivx,16))
- if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
- icrdot(ncrd) = 0
- icrdorn(ncrd) = 0
-c
-c Get note name
-c
- call getchar(lineq,iccount,charq)
-c
-c Get optional inputs
-c
-25 call getchar(lineq,iccount,durq)
-c ndx = index('fsn+-<>12345678rediA',durq)
- ndx = index('fsn+-<>12345678rediAc',durq)
- if (ndx .eq. 20) then
-c
-c Expect +|-|<|> , set tag, loop
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),29)
- go to 25
- else if (ndx .gt. 0) then
- if (ndx .le. 3) then
- if (.not.btest(icrdat(ncrd),19)) then
- icrdat(ncrd) = ibset(icrdat(ncrd),19)
- icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
- else
- icrdat(ncrd) = ibset(icrdat(ncrd),22)
- end if
- else if (ndx .eq. 21) then
-c
-c Set flags for cautionary accidental
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),31)
- iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
- else if (ndx .le. 7) then
-c
-c +/-/</> Check whether octave or accidental shift
-c
- nactmp = 0
- call chkpm4ac(lineq,iccount,nactmp,moved)
- if (moved) then
-c
-c Transfer accidental shift values
-c
- call setbits(icrdot(ncrd),6,14,igetbits(nactmp,6,4))
- call setbits(icrdot(ncrd),7,20,igetbits(nactmp,7,10))
- else
- if (durq .eq. '+') then
- lastlev = lastlev+7
- else if (durq .eq. '-') then
- lastlev = lastlev-7
- end if
- end if
- else if (durq .eq. 'e') then
- icrdat(ncrd) = ibset(icrdat(ncrd),23)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
- else if (durq .eq. 'r') then
- icrdat(ncrd) = ibset(icrdat(ncrd),24)
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
- else if (durq .eq. 'i') then
-c
-c Midi-only accidental on chord note
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),27)
- else if (durq .eq. 'd') then
-c
-c Must keep 'd' optional (backward compatibility), unless it is moved!
-c
- if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
-c
-c move a dot, unless next char is not part of a number
-c
- if (index('0123456789.',lineq(iccount+2:iccount+2))
- * .eq. 0) go to 25
- icrdat(ncrd) = ibset(icrdat(ncrd),26)
- call getchar(lineq,iccount,durq)
- iccount=iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (durq .eq. '+') then
- icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64)
- else
- icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64)
- end if
- if (index('+-',dumq) .gt. 0) then
-c
-c Vertical shift specified also
-c
- iccount=iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (dumq .eq. '+') then
- ifnum = nint(fnum*10)+64
- else
- ifnum = -nint(fnum*10)+64
- end if
- else
- ifnum = 64
- end if
- icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7))
- iccount = iccount-1
- end if
- else
-c
-c must be a single digit, save it in ioct
-c
- numnum = 1
- ioct = ndx-7
- end if
- go to 25
- end if
- if (numnum .eq. 1) then
- lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
- else
- lastlev = lastlev-3
- * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
- end if
- icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
- do 44 npreslur = npreslur , 1 , -1
- call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
-c
-c Set level for chord note.
-c Initially I assigned the slur(s) to next note, so fix.
-c
- islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),0)
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),0)
- isdat2(nsdat-npreslur+1) = ibset(isdat2(nsdat-npreslur+1),0)
- call setbits(isdat1(nsdat-npreslur+1),8,3,
- * igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
-44 continue
- if (notcrd) then
-c
-c This is the first chord note in this chord.
-c
- minlev = min(nolev(ivx,nnl(ivx)),lastlev)
- maxlev = max(nolev(ivx,nnl(ivx)),lastlev)
- else
- minlev = min(minlev,lastlev)
- maxlev = max(maxlev,lastlev)
- end if
- notcrd = .false.
- else if (charq .eq. 'G') then
- call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
- * lastlev,iv,nv)
-c
-c Grace, comes *before* main note:
-c UNLESS there's an 'A' or 'W' after the 'G'
-c ngrace = # of grace note groups so far in block
-c ivg(ngrace), ipg(ngrace)
-c nng(ngrace) = # of notes in this group: default = 1
-c ngstrt(ngrace) = starting position in nolevg of levels for this grace
-c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)'
-c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
-c slurg(ngrace) = logical for slur; default F, input 's'
-c slashg(ngrace) = T if slash; default is F, input 'x'
-c These data MUST precede note name of first note
-c nolevg, naccg: lists of levels and accid's, indexed as described above.
-c
- else if (charq .eq. sq) then
-c
-c Literal TeX string
-c
- call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
- else if (charq .eq. '"') then
-c
-c pmxlyr string. Expand "..." to \pmxlyr{...}\
-c
- if (.not. inputmlyr) then
- ictemp = 0
- lineqt = sq//sq//sq//'input musixlyr '//sq
- call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp)
- inputmlyr = .true.
- end if
- call dopmxlyr(lineq,iccount)
- charq = sq
- call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
- else if (charq .eq. 'o') then
-c
-c Ornament on non-xtup note. Symbol must come AFTER the affected note
-c
- if (notcrd) then
- nole = nolev(ivx,nnl(ivx))
- else
- nole = iand(127,ishft(icrdat(ncrd),-12))
- end if
- call getorn(lineq,iccount,iornq(ivx,nnl(ivx)),
- * iornq(ivx,0),ornrpt,noffseg,nnl(ivx),ivx,
- * .true.,notcrd,nole)
- else if (index('st(){}',charq) .gt. 0) then
- nnlivx = nnl(ivx)
- if (charq.eq.'(' .or. charq.eq.'{') then
-c
-c Detect preslur on normal non-chord note
-c
- nnlivx = nnlivx+1
- npreslur = npreslur+1
- end if
- islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
- if (charq.eq.'t')
- * islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),1)
- if (ivx .le. nv) then
- kv = 1
- else
- kv = 2
- end if
- if (fontslur) then
- call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
- * nsdat,notcrd,nolev(ivx,nnlivx),charq)
- else
- call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
- * isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
- end if
- else if (charq .eq. '?') then
-c
-c Arpeggio
-c
- if (btest(ipl(ivx,nnl(ivx)),10)) then
-c
-c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note
-c of chord, will not set icrdat(25), but iornq(27)
-c
- icrdat(ncrd) = ibset(icrdat(ncrd),25)
- else
- iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),27)
- end if
-c
-c Check for shift
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. ' ') then
- iccount = iccount-1
- else
-c
-c durq must be "-"
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
-c
-c record the shift
-c
- NumArpShift = NumArpShift+1
- IvArpShift(NumArpShift) = ivx
- IpArpShift(NumArpShift) = nnl(ivx)
- ArpShift(NumArpShift) = fnum
- end if
- else if (index('0123456789#-nx_',charq) .gt. 0) then
-c
-c We have a figure. Must come AFTER the note it goes under
-c
-
- ivf = 1
- if (ivx .gt. 1) then
- if (ivxfig2 .eq. 0) then
- ivxfig2 = ivx
- else if (ivx .ne. ivxfig2) then
- print*
- print*,'Figures not allowed in >1 voice above first'
- stop
- end if
- ivf = 2
- end if
- nfig1 = nfigs(ivf)+1
- call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
- * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx),
- * nodur(ivx,nnl(ivx)),figq(ivf,nfig1),
-c * ivupfig(ivf,nfig1),nfigs(ivf))
- * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf))
- else if (charq .eq. '[') then
-c
-c Start forced beam. Record barno & time since start of inp. blk. Set signal
-c
- nfb(ivx) = nfb(ivx)+1
- fbon = .true.
- ulfbq(ivx,nfb(ivx)) = 'x'
- t1fb(ivx,nfb(ivx)) = itsofar(ivx)
- nadj = 0
- if (autofbon) then
- autofbon = .false.
- end if
-17 call getchar(lineq,iccount,charq)
- if (index('ulf',charq) .gt. 0) then
- ulfbq(ivx,nfb(ivx)) = charq
- go to 17
- else if (charq .eq. 'j') then
-c
-c Continuing a jumped beam here
-c
- irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),24)
-c
-c Set flag to watch for END of this forced beam, so can set flag rest(30) on
-c NEXT note as signal to start a new notes group there.
-c
- isbj2 = .true.
- go to 17
- else if (charq .eq. 'h') then
- islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),2)
- go to 17
- else if (charq .eq. 'm') then
-c
-c Force multiplicity. Next input is digit
-c
- call getchar(lineq,iccount,charq)
- islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21)
- call setbits(islur(ivx,nnl(ivx)+1),3,22,ichar(charq)-48)
- go to 17
- else if (charq .eq. ':') then
-c
-c Start auto forced beam pattern
-c
- autofbon = .true.
-c
-c When forced later beam ends, check whether tautofv <=0; if so set it.
-c
- tautofb = -itsofar(ivx)
- t1autofb = itsofar(ivx)
- go to 17
- else if (charq .ne. ' ') then
-c
-c Must be '+/-' for height or slope shift
-c
- nadj = nadj+1
-c
-c nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level.
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- iadj = nint(fnum)
- if (charq .eq. '-') iadj = -iadj
- if (nadj .eq. 1) then
-c
-c This is a level shift. Note if 0 was entered, iadj = 30
-c
- call setbits(ipl(ivx,nnl(ivx)+1),6,11,iadj+30)
- else if (nadj .eq. 2) then
-c
-c Must be a slope shift
-c
- call setbits(ipl(ivx,nnl(ivx)+1),6,17,iadj+30)
- else
-c
-c Beam-thk fine tune
-c
- call setbits(islur(ivx,nnl(ivx)+1),2,27,iadj)
- end if
- go to 17
- end if
- else if (charq .eq. ']') then
- if (autofbon .and. tautofb.lt.tol) then
- tautofb=itsofar(ivx)+tautofb
- end if
- call getchar(lineq,iccount,charq)
- if (index('j ',charq) .gt. 0) then
-c
-c Since ']' comes AFTER note, itsofar has been updated. Set ending signal.
-c
- t2fb(ivx,nfb(ivx)) = itsofar(ivx)
- fbon = .false.
- if (charq .eq. 'j') then
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),23)
- end if
- if (isbj2) then
-c
-c This is the end of a fb segment of a jump beam. Set flag on NEXT note to
-c force start of new notes group, provided this is not last note in bar.
-c
- if (mod(itsofar(ivx),lenbar) .ne. 0)
- * irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),30)
- isbj2 = .false.
- end if
- else if (charq .eq. '[') then
-c
-c Multiplicity down-up signal
-c
- islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),20)
- else if (charq .eq. '-') then
-c
-c Set signals for gap in single-slope beam [...]-[...]
-c
- nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),20)
- nacc(ivx,nnl(ivx)+1) = ibset(nacc(ivx,nnl(ivx)+1),21)
-c
-c Next two characters must be "[ ". Skip over them.
-c
- iccount = iccount+2
- end if
- else if (charq .eq. 'D') then
- call getdyn(ivx,nnl(ivx),irest(ivx,nnl(ivx)),
- * iornq(ivx,nnl(ivx)),lineq,iccount)
- else if (charq .eq. 'h') then
-c
-c Heading or height. For heading, only OK if at start of block
-c Check whether at beginning of a block
-c
- if (iv.ne.1 .or. nnl(1).ne.0) then
- print*,'You entered "h" not at beginning of block'
- call stop1()
- end if
- call getchar(lineq,iccount,durq)
- ihdvrt = 0
- if (index('+-',durq) .gt. 0) then
-c
-c Vertical offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,charq,fnum)
- ihdvrt = fnum+.1
- if (durq .eq. '-') ihdvrt = -ihdvrt
- durq = charq
- end if
- if (durq .ne. ' ') then
-c
-c Height symbol. Read past (until next blank)
-c
-3 call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') go to 3
- else
-c
-c Set flag for header & read it in
-c
- ihdht = 16
- call getbuf(headrq)
- iccount = 128
- end if
- else if (charq .eq. 'L') then
-c
-c Linebreak, already handled some in pmxa, but need to get data for
-c shortened line or coda lengths
-c
- iccount = iccount+1
- if (lineq(iccount:iccount) .eq. 'C') then
-c
-c Coda, get length
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,codafrac)
- ishort = 3
- if (durq .eq. 'n') nocodabn = .true.
- return
- end if
-c
-c Get line number
-c
- call readnum(lineq,iccount,durq,fmovbrk)
-48 continue ! Allow transfer up from below if S follows M
- if (durq .eq. 'S') then
-c
-c Shortened line, get shortening fraction
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,shortfrac)
- ishort = 1
- codafrac = 0.
- end if
-c
-c Begin check for movement break
-c
- if (durq .eq. 'P') then
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- end if
- if (durq .eq. 'M') then
- movbrk = nint(fmovbrk)
- movgap = 0
- parmov = -1.
- call getchar(lineq,iccount,durq)
-31 if (durq .eq. '+') then
-c
-c Get vertical space (\internotes)
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- movgap = nint(fnum)
- go to 31
- else if (durq .eq. 'i') then
- iccount = iccount+1
- call readnum(lineq,iccount,durq,parmov)
- go to 31
- else if (durq .eq. 'c') then
- nobar1 = .true.
- call getchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'r') then
-c
-c "rename" can be set on or off.
-c
- call getchar(lineq,iccount,durq)
- rename = durq.eq.'+'
- call getchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'n') then
-c
-c Change # of voices. Input ninow, iiorig(1...ninow). Will use names,
-c staves per inst. and clefs corr. to iiorig in original list of instruments.
-c
- nvold = nv
- nv = 0
- rename = .true.
- call getchar(lineq,iccount,durq)
- if (durq .eq. ':') then
- iccount = iccount+2
- read(lineq(iccount-1:iccount),'(i2)')ninow
- else
- ninow = ichar(durq)-48
- end if
- iiv = 0
- do 63 iinow = 1 , ninow
- call getchar(lineq,iccount,durq)
- if (durq .eq. ':') then
- iccount = iccount+2
- read(lineq(iccount-1:iccount),'(i2)')iiorig(iinow)
- else
- iiorig(iinow) = ichar(durq)-48
- end if
- nspern(iinow) = nsperi(iiorig(iinow))
- nv = nv+nspern(iinow)
- sepsymq(iiv+nspern(iinow)) = '&'
- if (nspern(iinow) .gt. 1) then
- do 64 iis = 1 , nspern(iinow)-1
- sepsymq(iiv+iis) = '|'
-64 continue
- end if
- iiv = iiv+nspern(iinow)
-63 continue
-c
-c 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement
-c
-c if (islast) then
-c if (ninow .lt. 10) then
-c write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%'
-c else
-c write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%'
-c end if
-c end if
- if (nv.eq.1 .and. nvold.gt.1) then
- if (islast) write(11,'(a)')sq//'nostartrule'
- else if (nv.gt.1 .and. nvold.eq.1) then
- if (islast) write(11,'(a)')sq//'startrule'
- end if
- iiv = 0
- do 60 iinow = 1 , ninow
- do 61 iis = 1 , nspern(iinow)
- iiv = iiv+1
-c
-c May not really need to re-enter clefs, but it's easier to program since
-c clef names are not saved but are needed in newvoice to set ncmidcc.
-c
- call getchar(lineq,iccount,clefq(iiv))
- call newvoice(iiv,clefq(iiv),.true.)
- if (nspern(iinow) .eq. 1) then
- hdlndq = chax(48+numclef(clefq(iiv)))
- lclf = 1
- else if (iis .eq. 1) then
- hdlndq = '{'//chax(48+numclef(clefq(iiv)))
- lclf = 2
- else if (iis .lt. nspern(iinow)) then
- hdlndq = hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))
- lclf = lclf+1
- else
- hdlndq =
- * hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))//'}'
- lclf = lclf+2
- end if
-61 continue
-c
-c setstaffs & setclef go by instrument, not voice
-c
- if (islast) then
- if (iinow .lt. 10) then
- write(11,'(a)')sq//'setstaffs'
- * //chax(48+iinow)//chax(48+nspern(iinow))//'%'
- write(11,'(a)')sq//'setclef'//chax(48+iinow)
- * //hdlndq(1:lclf)//'%'
- if (fullsize(iiorig(iinow)).gt.0.9) then
- write(11,'(a)')sq//'setsize'//chax(48+iinow)
- * //sq//'normalvalue%'
-c
-c 140526 Account for staff size specs when noinst changes. May be confusion
-c here if more than one staff per instrument
-c
- else if (fullsize(iiorig(iinow)).gt..7) then
- write(11,'(a)')sq//'setsize'//chax(48+iinow)
- * //sq//'smallvalue%'
- else
- write(11,'(a)')sq//'setsize'//chax(48+iinow)
- * //sq//'tinyvalue%'
- end if
- else
- write(11,'(a11,i2,a)')sq//'setstaffs{',iinow,
- * '}'//chax(48+nspern(iinow))//'%'
- write(11,'(a9,i2,a)')sq//'setclef{',iinow,
- * '}'//hdlndq(1:lclf)//'%'
- end if
- end if
-60 continue
-c
-c Loop back up, this may not be last option in M. Note flow out if durq=' '
-c
- call getchar(lineq,iccount,durq)
- go to 31
- else if (durq .eq. 'S') then
- go to 48
- end if
-c
-c Write instrument names
-c
- if (.not.rename) then
- do 62 iinst = 1 , ninow
- if (islast) then
- if (iinst .lt. 10) then
- write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%'
- else
- write(11,'(a9,i2,a4)')sq//'setname{',iinst,'}{}%'
- end if
- end if
-62 continue
- else
- do 65 iinst = 1 , ninow
- if (islast) then
- if (iinst .lt. 10) then
- write(11,'(a8,i1,a)')sq//'setname',iinst,'{'//
- * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
- else
- write(11,'(a9,i2,a)')sq//'setname{',iinst,'}{'//
- * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
- end if
- end if
-65 continue
- if (ishort.ne.4.and.ishort.ne.2) rename = .false.
-c
-c Reset later and rewrite setname{} in shortening case mcm, since if
-c written here it will be inside {{...}} and will be ignored
-c
- end if
- end if
- else if (charq .eq.'|' ) then
-c
-c End of bar symbol. Check about end of bar hardspace.
-c
- if (btest(iornq(ivx,nnl(ivx)+1),26)) then
-c
-c There was a hardspace followed by a bar line. Remove it from the hardspace
-c list, store with shifts instead, set special bit. Need to repeat this code
-c at '/'.
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
- nudoff(ivx) = nudoff(ivx)+1
- udoff(ivx,nudoff(ivx)) = udsp(nudsp)
- nudsp = nudsp-1
- iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
- end if
- else if (index('wS',charq) .gt. 0) then
-c
-c Width symbol or new nsyst. Read past (until blank)
-c
-4 call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') go to 4
- else if (charq .eq. 'l') then
-c
-c Lower string. Only OK if at start of block
-c Check whether at beginning of a block
-c
- if (iv.ne.1 .or. nnl(1).ne.0) then
- print*,'You entered "l" not at beginning of block'
- call stop1()
- end if
-c
-c Set flag for lower string & read it in
-c
- lower = .true.
- call getbuf(lowerq)
- iccount = 128
- else if (charq .eq. 'm') then
-c
-c Meter change. Only allow at beginning of block.
-c mtrnuml, mtrdenl (logical) and p (printable) will be input.
-c mtrnuml=0 initially. (In common)
-c
-c Check whether at beginning of a block
-c
- if (iv.ne.1 .or. nnl(1).ne.0) then
- print*,'You entered "m" not at beginning of block'
- call stop1()
- end if
- call readmeter(lineq,iccount,mtrnuml,mtrdenl)
- call readmeter(lineq,iccount,mtrnmp,mtrdnp)
- lenbeat = ifnodur(mtrdenl,'x')
- if (mtrdenl .eq. 2) lenbeat = 16
- lenbar = mtrnuml*lenbeat
- if (mtrdenl .eq. 2) lenbar = lenbar*2
- lenb1 = lenbar
- lenb0 = 0
- if (ismidi) call midievent('m',mtrnuml,mtrdenl)
- else if (charq .eq. 'C') then
-c
-c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music.
-c
- if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1
- tcc(iv,ncc(iv)) = itsofar(iv)
- isl = ibset(islur(iv,nnl(iv)+1),11)
- call getchar(lineq,iccount,durq)
-c
-c Store clef number, or 7 if clef number = 9 (French violin clef)
-c
- isl = ior(isl,ishft(min(numclef(durq),7),12))
- ncmidcc(iv,ncc(iv)) = ncmidf(durq)
- if (durq .eq. '8') then
- ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2)
- iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
- lastlev = lastlev+7
- if (nnl(iv).eq.0) then
- ndlev(iv,1) = ndlev(iv,1)+7
- ndlev(iv,2) = ndlev(iv,2)+7
- end if
- else
-c
-c This won't work if you really had an octave transposition with some
-c other clef. Need a check on whether prior clef was an octave clef.
-c
- if (iTransAmt(instno(iv)).eq.7) then
- iTransAmt(instno(iv))=iTransAmt(instno(iv))-7
- lastlev = lastlev-7
- if (nnl(iv).eq.0) then
- ndlev(iv,1) = ndlev(iv,1)-7
- ndlev(iv,2) = ndlev(iv,2)-7
- end if
- end if
- end if
-c
-c Set marker on note with lowest voice # starting at same time.
-c
- if (iv .eq. 1) then
- isl = ibset(isl,15)
- else
- do 13 iiv = 1 , iv
- nnliiv = nnl(iiv)
- if (iiv .eq. iv) nnliiv = nnliiv+1
- itother = 0
- do 14 iip = 1 , nnliiv
- if (itother .lt. itsofar(iv)) then
- itother = itother+nodur(iiv,iip)
- go to 14
- else if (itother .eq. itsofar(iv)) then
- islur(iiv,iip) = ibset(islur(iiv,iip),15)
- go to 15
- end if
-14 continue
-13 continue
-15 continue
- end if
-c
-c Need 'or' since may have set bit 15 in the above loop
-c
- islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
- else if (charq .eq. 'R') then
-c
-c Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1)
-c
-10 call getchar(lineq,iccount,durq)
-c
-c Save designator in case it's a terminal Rr or Rd
-c
- if (durq .eq. 'l') then
- islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),5)
- go to 10
- else if (index('rdDbz',durq) .gt. 0) then
- if (durq .eq. 'r') then
- islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),6)
- else if (durq .eq. 'd') then
- islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),8)
- else if (durq .eq. 'D') then
- islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),26)
- else if (durq .eq. 'b') then
- islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25)
- else if (durq .eq. 'z') then
-c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29)
- ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0)
- end if
- rptprev = .true.
- rptfq1 = durq
- go to 10
- end if
- else if (charq .eq. 'V') then
-c
-c Ending
-c
- nnnl = nnl(1)+1
- lvoltxt = 0
-11 call getchar(lineq,iccount,durq)
- if (durq.eq.'b' .or. durq .eq.'x') then
-c
-c End Volta, set bit9, and bit10 on if 'b' (end w/ box)
-c
- islur(1,nnnl) = ibset(islur(1,nnnl),9)
- if (durq .eq. 'b') islur(1,nnnl) = ibset(islur(1,nnnl),10)
- go to 11
- else if (durq .ne. ' ') then
-c
-c Start volta; Get text
-c
- if (lvoltxt .eq. 0) then
-c
-c First character for text
-c
- lvoltxt = 1
- islur(1,nnnl) = ibset(islur(1,nnnl),7)
- nvolt = nvolt+1
- voltxtq(nvolt) = durq
- else
- voltxtq(nvolt) = voltxtq(nvolt)(1:lvoltxt)//durq
- lvoltxt = lvoltxt+1
- end if
- go to 11
- end if
- else if (charq .eq. 'B') then
- bcspec = .not.bcspec
- else if (charq .eq. 'P') then
-c
-c Page numbers. Print stuff right now.
-c
- npg1 = 0
-c
-c Will use ltopnam to signal whether there's a centered heading
-c
- ltopnam = 0
- ipg1r = 0
-16 call getchar(lineq,iccount,durq)
- if (ichar(durq).ge.48 .and. ichar(durq).le.57) then
- npg1 = npg1*10+ichar(durq)-48
- go to 16
- else if (durq .eq. 'l') then
- if (npg1.eq.0 .or. mod(npg1,2).eq.1) ipg1r = 1
- go to 16
- else if (durq .eq. 'r') then
- if (npg1.gt.0 .and. mod(npg1,2).eq.0) ipg1r = 1
- go to 16
- else if (durq .eq. 'c') then
-c
-c Top-centered name. Assume this is last option. Read the name.
-c May surround name in double quotes (to allow blanks).
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. ' ') then
- ltopnam = lenstr(cheadq,60)
- else
- namstrt = iccount
- if (durq .eq. '"') then
-c
-c Using quote delimiters.
-c
- quoted = .true.
- namstrt = namstrt+1
- else
- quoted = .false.
- end if
- do 35 iccount = namstrt+1, 128
-c if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or.
- if ((quoted .and. lineq(iccount:iccount).eq.'"' .and.
- * lineq(iccount-1:iccount-1).ne.'\') .or.
- * (.not.quoted .and. lineq(iccount:iccount) .eq. ' '))
- * go to 36
-c
-c On exit, iccount is OK, and name is in (namstrt:iccount-1)
-c
-35 continue
- print*,'Awww, cmon, should not be here.'
- call stop1()
-36 continue
- ltopnam = iccount-namstrt
- cheadq = lineq(namstrt:iccount-1)
- end if
- end if
-c
-c Done getting data, now assemble the command
-c
- if (npg1.eq.0) npg1=1
-c
-c 2/23/03 Don't use \atnextline if on first page and only one system
-c
-c if (ipage.gt.1 .or. nsystp(1).gt.1) then
- hdlndq = sq//'def'//sq//'atnextline{'//sq//'toppageno{'
- lhead = 27
-c else
-c hdlndq = sq//'toppageno{'
-c lhead = 11
-c end if
- if (npg1 .lt. 10) then
-c
-c Note we are overwriting the last "{"
-c
- write(hdlndq(lhead:lhead),'(i1)')npg1
- else if (npg1 .lt. 100) then
- lhead = lhead+3
- write(hdlndq(lhead-2:lhead),'(i2,a1)')npg1,'}'
- else
- lhead = lhead+4
- write(hdlndq(lhead-3:lhead),'(i3,a1)')npg1,'}'
- end if
- hdlndq = hdlndq(1:lhead)//chax(ipg1r+48)//'{'
- lhead = lhead+2
-c if (ipage.gt.1 .or. nsystp(1).gt.1) then
- if (ltopnam .eq. 0) then
- if (islast) write(11,'(a)')hdlndq(1:lhead)//'}}%'
- else
- if (islast)
- * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}}%'
- end if
-c else
-c if (ltopnam .eq. 0) then
-c if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%'
-c else
-c if (islast)
-c * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%'
-c end if
-c end if
- else if (charq .eq. 'W') then
-c
-c Just eat the number that must follow, it was used in pmxa
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- else if (charq .eq. 'T') then
- headlog = .true.
- inhead = 0
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'i') then
- call getbuf(instrq)
-c
-c A kluge for parts from separate score file for later movements.
-c
- if (instrq(1:1) .eq. ' ') headlog = .false.
- cheadq = instrq(1:60)
- else if (durq .eq. 't') then
- call getchar(lineq,iccount,durq)
-c
-c Optionally can include extra vertical \internotes above inbothd
-c
- if (index('-+0123456789',durq) .gt. 0) then
- ipm = 1
- if (index('+-',durq) .gt. 0) then
-c
-c Don't trust readnum to round this negative integer properly
-c
- iccount = iccount+1
- if (durq .eq. '-') ipm = -1
- end if
- call readnum(lineq,iccount,durq,fnum)
- inhead = ipm*nint(fnum)
- end if
- call getbuf(titleq)
- else
- call getbuf(compoq)
- end if
- inhead = inhead+inbothd
- iccount = 128
- else if (charq .eq. 'A') then
-c
-c Accidental handling etc.
-c
-27 call getchar(lineq,iccount,durq)
- if (durq .eq. 'r') then
- if (islast) then
- relacc = .true.
- write(11,'(a)')sq//'relativeaccid%'
- end if
- else if (durq .eq. 's') then
- bacfac = 1.e6
- else if (durq .eq. 'b') then
- if (islast) write(11,'(a)')sq//'bigaccid%'
- accfac = bacfac
- else if (durq .eq. 'a') then
- call getchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,fnum)
- iccount = iccount-1
- else if (durq .eq. 'i') then
- call getchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,tintstf)
- if (.not.firstgulp) fintstf = tintstf
-c
-c Local corrections for first page were handled by pmxa
-c
- iccount = iccount-1
- else if (durq .eq. 'I') then
- call getchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,gintstf)
- iccount = iccount-1
- else if (durq .eq. 'd') then
- lowdot = .true.
- else if (durq .eq. 'o') then
- continue
- else if (durq .eq. 'S') then
- do 50 iiv = 1 , noinst
- call getchar(lineq,iccount,durq)
- if (index('-s',durq) .gt. 0) then
- fullsize(iiv) = 0.8
- else if (durq .eq. 't') then
- fullsize(iiv) = 0.64
- else
-c fullsize(ivx) = 1.0
- fullsize(iiv) = 1.0
- end if
-50 continue
- else if (durq .eq. 'e') then
-c
-c Line-spacing equalization
-c
- equalize = .true.
-c
-c The following redefinition of \parskip was put into pmx.tex in version 2.25 or so.
-c But it causes problems with some older scores and when excerpts are combined
-c with LaTeX. So as of 2.352 we write it here.
-c
- write(11,'(a)')sq//'global'//sq//'parskip 0pt plus 12'//sq
- * //'Interligne minus 99'//sq//'Interligne%'
- tempq = sepsymq(1)
- lentemp = 1
- do 51 iiv = 2 , nv-1
- tempq = tempq(1:lentemp)//sepsymq(iiv)
- lentemp = lentemp+1
-51 continue
- write(11,'(a)')sq//'def'//sq//'upstrut{'//sq//'znotes'
- * //tempq(1:lentemp)//sq//'zcharnote{'//sq//'upamt}{~}'
- * //sq//'en}%'
- else if (durq .eq. 'v') then
-c
-c Toggle usevshrink
-c
- usevshrink = .not.usevshrink
- else if (durq .eq.'p') then
-c
-c Postscript slurs. fontslur is already false (set in g1etnote)
-c
- if (.not.WrotePsslurDefaults) then
-c
-c Set postscrirpt slur adjustment defaults
-c
- write(11,'(a)')sq//'Nosluradjust'//sq//'Notieadjust'
- * //sq//'nohalfties'
- WrotePsslurDefaults = .true.
- end if
-52 continue
- call g1etchar(lineq,iccount,durq) ! might be "+", "-", "h" or "l"
- if (index('+-',durq) .gt. 0) then
-c
-c Characters to change defaults for ps slurs
-c
- call g1etchar(lineq,iccount,charq) ! charq will be "s,t,h,c"
- if (durq .eq. '+') then
- if (charq .eq. 's') then
- write(11,'(a)')sq//'Sluradjust'
- else if (charq .eq. 't') then
- write(11,'(a)')sq//'Tieadjust'
- else if (charq .eq. 'h') then
- write(11,'(a)')sq//'halfties'
- else
- SlurCurve = SlurCurve + 1
- if (SlurCurve .gt. 3.1) then
- call printl('WARNING!')
- call printl
- * ('Default slur curvature advanced past HH, resetting')
- SlurCurve = 3
- end if
- end if
- else
- if (charq .eq. 's') then
- write(11,'(a)')sq//'Nosluradjust'
- else if (charq .eq. 't') then
- write(11,'(a)')sq//'Notieadjust'
- else if (charq .eq. 'h') then
- write(11,'(a)')sq//'nohalfties'
- else
- SlurCurve = SlurCurve - 1
- if (SlurCurve .lt. -1.1) then
- call printl('WARNING!')
- call printl(
- * 'Default slur curvature decremented below f, resetting')
- SlurCurve = -1
- end if
- end if
- end if
- go to 52 ! Check for another set of default changes
- else if (durq .eq. 'l') then
-c
-c Set optional linebreak ties
-c
- OptLineBreakTies = .true.
- go to 52
- else if (durq .eq. 'h') then
-c
-c Set flag to write header special on every page
-c
- HeaderSpecial = .true.
- go to 52
- else
- iccount = iccount-1
- end if
- else if (durq .eq. 'K') then
-c
-c Toggle keyboard rest placement flag
-c
- kbdrests = .not.kbdrests
- else if (durq .eq. 'c') then
- call g1etchar(lineq,iccount,durq)
-c
-c Just eat the input; it was used in pmxa
-c
- go to 27
- else if (durq .eq. 'V') then
- bottopgap = .true.
- topamt = 0.
- call getchar(lineq,iccount,durq)
- pmfac = index('- +',durq)-2
- call g1etchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,botamt)
- botamt = botamt*pmfac
- pmfac = index('- +',durq)-2
- call g1etchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,topamt)
- topamt = topamt*pmfac
- iccount = iccount-1
- go to 27
- end if
- if (index('NR',durq) .gt. 0) then
-c
-c Override default part names for scor2prt, or normal include file.
-c Just bypass rest of input line
-c
- iccount = 128
- else if (durq .ne. ' ') then
- go to 27
- end if
- else if (charq .eq. 'K') then
-77 continue
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'n') then
- ignorenats = .true.
- go to 77
- end if
- if (durq .ne. 'i') then
-c
-c Normal, full-score key change and/or transposition
-c
- num1 = 44-ichar(durq)
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- num1 = num1*nint(fnum)
-c
-c On exit, durq='+','-'. But only need isig if after start, else done in pmxa
-c
- iccount = iccount+1
- call readnum(lineq,iccount,charq,fnum)
- if (ismidi) then
- midisig = nint(fnum)
- if (durq.eq.'-') midisig = -midisig
-c 130317
- midisig = midisig+idsig
- call midievent('k',midisig,0)
-
- end if
-c70 continue
- if (num1 .eq. 0) then
-c
-c Key change, not transposition.
-c
- ipl(ivx,nnl(ivx)+1) = ibset(ipl(ivx,nnl(ivx)+1),28)
- lastisig = isig
- isig = nint(fnum)
- if (durq .eq. '-') isig = -isig
- isig = isig+idsig
- if (ismidi) call midievent('k',isig,0)
- else
-c
-c num1 .ne. 0, so transposition, so must be at beginning. isig came with K...
-c but was passed to pmxb through pmxtex.dat. isig0 comes from setup data
-c (signature before transposition). idsig must be added to future key changes.
-c
- jv = 0
- do while (jv .lt. nm)
- jv = jv+1
- iTransAmt(jv) = num1
- end do
- idsig = isig-isig0
- end if
- else
-c
-c Instrument specific transposition.
-c
- call GetiTransInfo(.false.,ibarcnt,lineq,iccount,
- * ibaroff,nbars,noinst)
-c
-c The sig parameters will have been set 1st time but that's OK
-c
- end if
- else if (charq .eq. '/') then
- if (btest(iornq(ivx,nnl(ivx)+1),26)) then
-c
-c There was a hardspace followed by end of block. Remove it from the hardspace
-c list, store with shifts instead, set special bit. This code also at '|'
-c
- irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
- nudoff(ivx) = nudoff(ivx)+1
- udoff(ivx,nudoff(ivx)) = udsp(nudsp)
- nudsp = nudsp-1
- iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
- end if
- call getchar(lineq,iccount,durq)
-c
-c Save ending note level:
-c
- if (ivx .le. nv) then
-c
-c This is the first line of music on this staff. If previous block had only 1
-c voice, save last pitch from line 1 of prev. block to line 2, in case a
-c 2nd line is started just below
-c
- if (.not.was2(iv)) ndlev(iv,2) = ndlev(iv,1)
- was2(iv) = .false.
- ndlev(iv,1) = lastlev
- else
-c
-c This is the 2nd line of music on this staff.
-c
- was2(iv) = .true.
- ndlev(iv,2) = lastlev
- end if
- if (durq .eq. ' ' .and. iv.eq.nv) then
-c
-c End of input block
-c
- loop = .false.
- else
-c
-c Start a new line of music
-c
- if (lenb0.ne.0 .and. firstgulp) lenbar = lenb0
- nbars = 0
- if (durq .eq. ' ') then
-c
-c New line of music is on next staff
-c
- iv = iv+1
- ivx = iv
- else
-c
-c durq must be 2nd '/'. New line of music is on same staff. Set up for it
-c
- ivx = nv+1
- do 23 iiv = 1 , nv
- if (nvmx(iiv) .eq. 2) ivx = ivx+1
-23 continue
- nvmx(iv) = 2
- ivmx(iv,2) = ivx
- itsofar(ivx) = 0
- nnl(ivx) = 0
- nfb(ivx) = 0
- nudoff(ivx) = 0
- ndotmv(ivx) = 0
- do 24 j = 1 , 200
- irest(ivx,j) = 0
- islur(ivx,j) = 0
- nacc(ivx,j) = 0
- iornq(ivx,j) = 0
- ipl(ivx,j) = 0
- mult(ivx,j) = 0
-24 continue
-c
-c Go back and lower the rests in voice "a" that don't have over-ridden heights
-c
- do 26 j = 1 , nnl(iv)
- if (btest(irest(iv,j),0) .and. nolev(iv,j).eq.0)
- * nolev(iv,j) = -4
-26 continue
- end if
- end if
- iccount = 128
- else if (charq .eq. 'X') then
-c
-c 3rd arg is only for termination of group shifts. Use "max" to avoid zero index,
-c which only happens for normal X at block start, and we took special measures to
-c keep group shifts for crossing block boundaries.
-c
- call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx))),
- * shifton,wheadpt,iornq(ivx,nnl(ivx)+1),ivx,
- * irest(ivx,nnl(ivx)+1),itsofar(ivx),0,0,0,' ',ndoub)
- else if (charq .eq. 'I') then
-c
-c Midi controls.
-c
- call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
- * mtrdenl,nv,.false.)
- else if (charq .eq. 'M') then
-c
-c Macro action
-c
- call getchar(lineq,iccount,charq)
- if (index('RS',charq) .gt. 0) then
-c
-c Record or save a macro. Get the number of the macro.
-c
- call getchar(lineq,iccount,durq)
- call readnum(lineq,iccount,durq,fnum)
- macnum = nint(fnum)
- macuse = ibset(macuse,macnum)
- if (charq .eq. 'R') then
- call mrec1(lineq,iccount,ndxm)
- else
-c
-c Save (Record but don't activate)
-c
-5 call mrec1(lineq,iccount,ndxm)
- if (mrecord) then
- call getbuf(lineq)
- iccount = 0
- go to 5
- end if
- iccount = iccount+ndxm+1
- end if
- else if (charq .eq. 'P') then
-c
-c Playback the macro
-c
- call getchar(lineq,iccount,charq)
- call readnum(lineq,iccount,durq,fnum)
- macnum = nint(fnum)
- icchold = iccount
- lnholdq = lineq
- iccount = 128
- ilmac = il1mac(macnum)
- mplay = .true.
- end if
- else if (index(',.',charq) .gt. 0) then
-c
-c Continued rhythmic shortcut
-c
- idotform = index('. ,',charq)
- if (idotform .eq. 1) then
-c
-c Check for start of forced beam on 2nd member of dotform=1 shortcut
-c
- if (fbon) then
- if (t1fb(ivx,nfb(ivx)).eq.itsofar(ivx))
- * t1fb(ivx,nfb(ivx)) =
- * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2
- end if
-c
-c Change duration of prior note
-c
- itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
- nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2
- itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
- end if
- idotform = idotform+1
- numnum = 1
- cdot = .true.
- go to 1
- end if
- return
- end
- subroutine getorn(lineq,iccount,iornq,iornq0,ornrpt,noffseg,
- * ip,ivx,noxtup,notcrd,nole)
-c
-c iornq: Main note. Do not alter if chord note, except turn on bit 23
-c iornq0: Store iorni + bit 23, in case of repeated ornaments
-c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd.
-c noffseg: horiz. offset for segno
-c nole: level of note w/ orn, used to ID the note/orn if there's a level shift.
-c
-
- common /comivxudorn/ivxudorn(63)
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /comcb/ nbc,ibcdata(36)
- character*1 charq,durq
- character*128 lineq
- logical ornrpt,negseg,noxtup,notcrd
-c
-c Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U
-c 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid.
-c
- call getchar(lineq,iccount,charq)
- if (index('bc',charq) .gt. 0) then
-c
-c caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc)
-c ivx(0-3,28), ip(4-12),
-c vshift (vshift+32 in bits 13-18),
-c hshift (nint(10*vshift)+128 in bits 19-26)
-c bit 27 = 0 if caesura, 1 if breath
-c bit 28: 5th bit of ivx
-c
- iornq = ibset(iornq,28)
- nbc = nbc+1
-c ibcdata(nbc) = ivx+16*ip
- ibcdata(nbc) = mod(ivx,16)+16*ip
- if (ivx.ge.16) ibcdata(nbc) = ibset(ibcdata(nbc),28)
- if (charq .eq. 'b') ibcdata(nbc) = ibset(ibcdata(nbc),27)
- call getchar(lineq,iccount,durq)
- if (index('+-',durq) .gt. 0) then
-c
-c We have a vertical shift, get it
-c
- iccount = iccount+1
- call readnum(lineq,iccount,charq,fnum)
- if (durq .eq. '-') fnum=-fnum
- call setbits(ibcdata(nbc),6,13,nint(32+fnum))
- if (index('+-',charq) .gt. 0) then
-c
-c Horizontal shift, get it
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (charq .eq. '-') fnum=-fnum
- call setbits(ibcdata(nbc),8,19,nint(10*fnum)+128)
- end if
- end if
- return
- end if
-c
-c Set signal on main note that some note at this time has ornament. ONLY used
-c in beamstrt to activate further tests for whether ihornb is needed.
-c
- iornq = ibset(iornq,23)
-c
-c Isolate 21 bits defining exisiting ornaments
-c
- if (notcrd) then
-c iorni = iand(4194303,iornq)
-c iorni = iand(541065215,iornq)
- iorni = iand(1614807039,iornq)
- else
- iorni = iand(4194303,icrdorn(ncrd))
- end if
-c korn = index('stmgx+Tupf._)e:XXX>^',charq)
- korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq)
- if (korn .ne. 15) iorni = ibset(iorni,korn)
-c
-c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later
-c as follows: korn=16-18 for sfn, and or 21 for bare ?.
-c When this if-block is done, korn will = bit# of actual ornament (unless "?").
-c
- if (korn .eq. 15) then
-c
-cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq
-cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq
-c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq
-c
-c iorni = ior(iorni,iand(iornq0,1638383))
-c iorni = ior(iorni,iand(iornq0,3735535))
-c iorni = ior(iorni,iand(iornq0,540606447))
- iorni = ior(iorni,iand(iornq0,1614348271))
- ornrpt = .false.
- call getchar(lineq,iccount,durq)
-c
-c durq will be ' '
-c
- else if (korn .eq. 14) then
-c
-c Editorial accidental
-c
- call getchar(lineq,iccount,durq)
-c korn = 15+index('sfn',durq)
- korn = 15+index('sfn?',durq)
- if (korn .eq. 19) korn=21
- iorni = ibset(ibclr(iorni,14),korn)
- call getchar(lineq,iccount,durq)
- if (durq .eq. '?') then
-c
-c This is "oe[s|f|n]?". Set 21st bit also.
-c
- iorni = ibset(iorni,21)
- korn = korn+6
- call getchar(lineq,iccount,durq)
- end if
-c iorni = ibset(ibclr(iorni,14),korn)
- else if (korn.eq.4 .and. noxtup) then
-c
-c segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points
-c
- noffseg = 0
- negseg = .false.
- call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') then
-c
-c Segno shift is specified
-c
- if (durq .eq. '-') then
- negseg = .true.
- call getchar(lineq,iccount,durq)
- end if
- call readnum(lineq,iccount,durq,fnum)
- noffseg = int(fnum)
- if (negseg) noffseg = -noffseg
- end if
- else if (korn .eq. 7) then
-c
-c Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr"
-c
- ntrill = ntrill + 1
- ivtrill(ntrill) = ivx
- iptrill(ntrill) = ip
- xnsktr(ntrill) = 1.
- call getchar(lineq,iccount,durq)
- if (durq .eq. 't') then
-c
-c Convert to new internal symbol for non-'"tr" trill
-c
- korn = 15
- iorni = ibset(ibclr(iorni,7),15)
- call getchar(lineq,iccount,durq)
- end if
- if (index('0123456789.',durq) .gt. 0) then
-c
-c We have a number for the length
-c
- call readnum(lineq,iccount,durq,xnsktr(ntrill))
- end if
- else if (korn.eq.10 .and. noxtup) then
-c
-c Fermata
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'd') then
- korn = 14
- iorni = ibset(ibclr(iorni,10),14)
- call getchar(lineq,iccount,durq)
- end if
- else
- call getchar(lineq,iccount,durq)
- end if
- if (index('+- :',durq) .eq. 0) then
- print*,'Unexpected character at end of ornament: ',durq
- call stop1()
- end if
- if (index('+-',durq) .gt. 0) then
-c
-c Shift ornament up or down
-c
- nudorn = nudorn+1
-c
-c Set bit 25 in iorni as a signal. This may not really be necessary.
-c
- iorni = ibset(iorni,25)
-c
-c Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev,
-c 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present
-c
- xofforn = 44-ichar(durq)
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- iofforn = nint(xofforn*fnum)
- kudorn(nudorn) = ip+ishft(mod(ivx,16),8)+ishft(nole,12)
- * +ishft(korn,19)+ishft(iofforn+32,25)
- ivxudorn(nudorn) = ivx
- if (index('+-',durq) .gt. 0) then
-c
-c Horizontal shift
-c
- kudorn(nudorn) = ibset(kudorn(nudorn),31)
- xofforn = 44-ichar(durq)
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
-c 141226 ornhshft(nudorn) = nint(xofforn*fnum)
- ornhshft(nudorn) = xofforn*fnum
- end if
- else if (durq .eq. ':') then
-c
-c Turn on repeated ornaments
-c
- ornrpt = .true.
-c
-c Save the ornament value just set
-c
- iornq0 = iorni
- end if
- if (notcrd) then
- iornq = ior(iornq,iorni)
- else
- icrdorn(ncrd) = ior(icrdorn(ncrd),iorni)
- end if
- return
- end
- subroutine getpmxmod(global,includeq)
-c
-c If global=.true., checks for environment variable with path to pmx.mod.
-c Then, if variable exists and points to pmx.mod, insert lines from
-c pmx.mod into buffer
-c If global=.false., checks for existence of includeq and uses it.
-c
-c lenbuf0 = total length of bufq on entry
-c lbuf(i) = length of line (i)
-c nlbuf = number of lines stored in bufq
-c ilbuf = index of first line after setup stuff (on entry). In general, index of
-c next line to be sucked from buffer.
-c ilbufmod = counter for lines in pmx.mod as they are grabbed.
-c Starts at ilbuf. Points to position of next line after
-c pmx.mod stuff in bufq on exiting loop 1
-c ilbuff = transient counter for shifting operations
-c ipbuf = on entry, points to last character in setup stuff. In general, points
-c to last character of most recent line sucked from buffer.
-c ipbufmod = points to last character of most recent inserted line
-c from pmx.mod
-c
- parameter (maxblks=9600,nm=24)
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- logical lastchar,fbon,issegno,isheadr,isvolt
- character*(*)includeq
- character*80 pmxmoddirq
- character*128 lnholdq
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- logical fexist,global
- line1pmxmod = ilbuf
- if (.not.global) then
- inquire(file=includeq,EXIST=fexist)
-c
-c Transfer includeq to temporary char variable with known length
-c
- pmxmoddirq = includeq
- lpmxmoddirq = lenstr(pmxmoddirq,80)
- print*
- write(15,'()')
- if (.not.fexist) then
- call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
- * //', checking further.')
-c
-c File named includeq doesn't not exist. Get directory from PMXMODDIR and
-c see if it's there
-c
- call getenv('PMXMODDIR',pmxmoddirq)
- lpmxmoddirq = lenstr(pmxmoddirq,80)
- if (lpmxmoddirq. gt. 0) then
- pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//includeq
- lpmxmoddirq = lenstr(pmxmoddirq,80)
- else
- call printl(
- * 'No other directory defined by PMXMODDIR, stopping')
- call stop1()
- end if
- inquire(file=pmxmoddirq,EXIST=fexist)
- if (.not.fexist) then
- call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
- * //', stopping.')
- call stop1()
- end if
- end if
- call printl('Opening normal include file '
- * //pmxmoddirq(1:lpmxmoddirq))
- open(18,file=pmxmoddirq)
- else
-c
-c Check for existence of pmx.mod
-c
- call getenv('PMXMODDIR',pmxmoddirq)
- lpmxmoddirq = lenstr(pmxmoddirq,80)
- if (lpmxmoddirq .eq. 0) return
- pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//'pmx.mod'
- lpmxmoddirq = lpmxmoddirq+7
- inquire(file=pmxmoddirq,EXIST=fexist)
- if (.not.fexist) return
- call printl('Opening global include file '
- * //pmxmoddirq(1:lpmxmoddirq))
- open(18,file=pmxmoddirq(1:lpmxmoddirq))
- end if
- call printl('Adding include data')
-c
-c Read lines in from pmx.mod one at a time
-c
- ipbufmod = ipbuf
- lenbufmod = lenbuf0
- do 1 ilbufmod = ilbuf , maxblks
- read(18,'(a)',end=3)lnholdq
-c
-c A line was read. Slide all existing lengths from here forward ahead by 1
-c
- do 2 ilbuff = nlbuf , ilbufmod , -1
- lbuf(ilbuff+1) = lbuf(ilbuff)
-2 continue
-c
-c Get length of line from include file
-c
- lenmodline = lenstr(lnholdq,128)
- if (lenmodline .eq. 0) then
-c
-c Blank line. Make it a single blank with length 1
-c
- lenmodline = 1
- lnholdq = ' '
- end if
- lbuf(ilbufmod) = lenmodline
- call printl(lnholdq(1:lenmodline))
-c
-c Insert new stuff into bufq
-c
- bufq = bufq(1:ipbufmod)//lnholdq(1:lenmodline)//
- * bufq(ipbufmod+1:lenbufmod)
-c
-c Update internal parameters
-c
- ipbufmod = ipbufmod+lbuf(ilbufmod)
- lenbufmod = lenbufmod+lbuf(ilbufmod)
- nlbuf = nlbuf+1
-1 continue
-3 continue
- call printl('Closing '//pmxmoddirq(1:lpmxmoddirq))
- close(18)
- linesinpmxmod = linesinpmxmod+ilbufmod-ilbuf
- lenbuf0 = lenbufmod
-c
-c Fix Andre's error reporting problem 101211 leading to log(neg#) due
-c to nline being 2 bigger than it should be
-c
- nline=nline-2
-c
- return
- end
- subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
- * xmtrnum0,npages,nsyst,musicsize,fracindent,istype0,
- * inameq,clefq,sepsymq,pathnameq,lpath,isig0)
- parameter (nm=24)
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- character*1 clefq(nm),sepsymq(nm)
- character*40 pathnameq
- character*79 inameq(nm)
- character*128 lineq
- logical istype0,newway,rename
- common /commidisig/ midisig
-c
-c Get the first line
-c
- iccount = 0
-9 call getbuf(lineq)
- if (lineq(1:1) .eq. '%') go to 9
- istype0 = lineq(1:3).eq.'---'
- if (istype0) then
-c
-c Have TeX input until next line that starts with '---'. Save in scratch.
-c
- open(17,status='SCRATCH')
-3 call getbuf(lineq)
- if (lineq(1:3) .ne. '---') then
- write(17,'(a)')lineq
- go to 3
- end if
-c
-c Force a new line read on first call to readin
-c
- iccount = 128
- end if
-c
-c Here, lineq is first line w/ numerical setup data.
-c
- nv = nint(readin(lineq,iccount,nline))
- noinst = nint(readin(lineq,iccount,nline))
- newway = noinst.le.0
- if (newway) noinst = -noinst
- do 2 iinst = 1 , noinst
-c
-c Seve # of staves per inst in case later drop some inst's.
-c
- if (newway) then
-c
-c Read in nvi for each instrument
-c
- nsperi(iinst) = nint(readin(lineq,iccount,nline))
- else if (iinst .gt. 1 ) then
- nsperi(iinst) = 1
- else
- nsperi(iinst) = nv-noinst+1
- end if
- iiorig(iinst) = iinst
- nspern(iinst) = nsperi(iinst)
-2 continue
- mtrnuml = nint(readin(lineq,iccount,nline))
- mtrdenl = nint(readin(lineq,iccount,nline))
-cc
-cc Kluge to make mtrdenl work
-cc
-c if (mtrdenl .eq. 1) then
-c mtrdenl = 2
-c mtrnuml = mtrnuml*2
-c end if
- mtrnmp = nint(readin(lineq,iccount,nline))
- mtrdnp = nint(readin(lineq,iccount,nline))
- xmtrnum0 = readin(lineq,iccount,nline)
-c
-c Original key sig (before any trnasposition) in next position. Transposed
-c sig for topfile was transferred thru pmxtex.dat. Need isig0 for key
-c changes if transposed.
-c
- isig0 = nint(readin(lineq,iccount,nline))
-c 130316
-c do 11 iinst = 1 , noinst
-c midisig(iinst) = isig0
- midisig = isig0
-c11 continue
- npages = nint(readin(lineq,iccount,nline))
- nsyst = nint(readin(lineq,iccount,nline))
- musicsize = nint(readin(lineq,iccount,nline))
- fracindent = readin(lineq,iccount,nline)
-c
-c Next noinst non-comment lines are names of instruments.
-c
- do 4 i = 1 , noinst
-5 call getbuf(inameq(i))
- if (inameq(i)(1:1) .eq. '%') go to 5
-4 continue
-c
-c Next non-comment line has nv clef names
-c
-6 call getbuf(lineq)
- if (lineq(1:1) .eq. '%') go to 6
- iv = 0
- nvsofar = 0
- do 1 jinst = 1 , noinst
- nvsofar = nvsofar+nsperi(jinst)
- do 10 ivi = 1 , nsperi(jinst)
- iv = iv+1
- clefq(iv) = lineq(iv:iv)
- if (iv .eq. nvsofar) then
- sepsymq(iv) = '&'
- else
- sepsymq(iv) = '|'
- end if
-10 continue
-1 continue
-c
-c Mext non-comment line has path name
-c
-8 call getbuf(pathnameq)
- if (pathnameq(1:1) .eq. '%') go to 8
- lpath = index(pathnameq,' ')-1
-c
-c 160130 Replace '\' by '/'
-c
-12 ipos = index(pathnameq,'\')
- if (ipos .gt. 0) then
- pathnameq(ipos:ipos)='/'
-c print*,'Changed pathname to ',pathnameq(1:lpath)
- go to 12
- end if
- return
- end
- function getsquez(n,ntot,space,tnote,to)
- real*4 tnote(600),to(600)
- common /comtol/ tol
-c
-c Get the squez factor by checking space against tgovern=minimum duration
-c of all notes sounding at time of n-th note in the list.
-c The starting time of base increment is to(n) and ending time is to(n)+space
-c Sounding notes are those that start at or before to(n) .and. end at or
-c after tend=to(n)+space
-c Since notes are ordered by increasing start times, as soon as we find one
-c that starts too late, we are done checking.
-c
- tgovern = 1000.
- tend = to(n)+space
- do 1 in = 1 , ntot
-c
-c Since to() is ordered by start times, exit loop after first note that
-c starts later than note of interest.
-c
- if (to(in) .gt. to(n)+tol) go to 2
- if (to(in)+tnote(in) .gt. tend-tol) then
-c
-c If here, this note overlaps and must be tested.
-c
- tgovern = min(tgovern,tnote(in))
- end if
-1 continue
-2 continue
- getsquez = space/tgovern
- return
- end
- subroutine getx(lineq,iccount,irest,shifton,wheadpt,iornq1,ivx,
- * irest1,itsofar,ntup,itup,nnodur,dotq,ndoub)
- parameter(nm=24)
-c
-c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol.
-c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
-c Since during getnote phase time is integer itsofar, which is not updated
-c during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if
-c not in xtup.
-c
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- logical shifton,colon,ess,number
- character*128 lineq
- character*1 charq,durq,dotq
- colon = .false.
- ess = .false.
- number = .false.
- nextbl = iccount+index(lineq(iccount:128),' ')-1
- if (index(lineq(iccount:nextbl),'P') .gt. 0) then
-c
-c "Parts only", ignore entire symbol
-c
- iccount = nextbl
- return
- end if
-1 call getchar(lineq,iccount,charq)
- if (charq.eq.'B') then
-c
-c "Both parts and score," ignore character
-c
- go to 1
- else if (charq .eq. ':') then
- colon = .true.
- go to 1
- else if (charq .eq. 'S') then
- ess = .true.
- go to 1
- else if (index('+-.0123456789',charq) .gt. 0) then
- number = .true.
- if (charq.eq.'-') iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (charq .eq. '-') fnum = -fnum
- if (durq .ne. 'p') then
- fnum = fnum*wheadpt
- iccount = iccount-1
- end if
- go to 1
- end if
-c
-c charq must be blank, so done parsing
-c
- if (.not.ess .and. .not.colon) then
-c
-c Ordinary hardspace. Goes before next note.
-c (Later, at "|" or "/", check for presence and switch to udoff if there!)
-c
- nudsp = nudsp+1
- iornq1 = ibset(iornq1,26)
- udsp(nudsp) = fnum
- tudsp(nudsp) = itsofar
- if (ntup .gt. 0) tudsp(nudsp) = tudsp(nudsp)
-c * +float(itup-1)/ntup*ifnodur(nnodur,dotq)
- * +float(itup-1+ndoub)/ntup*ifnodur(nnodur,dotq)
- else if (.not.number) then
-c
-c Must be "X:" End a group offset.
-c
- irest = ibset(irest,17)
- shifton = .false.
- return
- else
-c
-c Only other possibility is start offset, "S" for single, ':' for multiple
-c
- nudoff(ivx) = nudoff(ivx)+1
- udoff(ivx,nudoff(ivx)) = fnum
- if (ess) then
- irest1 = ibset(irest1,15)
- else
- irest1 = ibset(irest1,16)
- shifton = .true.
- end if
- end if
- return
- end
- function i1fnodur(idur,dotq)
- character*1 dotq
- if (idur .eq. 6) then
- i1fnodur=1
- else if (idur .eq. 3) then
- i1fnodur=2
- else if (idur .eq. 1) then
- i1fnodur=4
- else if (idur .eq. 8) then
- i1fnodur=8
- else if (idur .eq. 4) then
- i1fnodur=16
- else if (idur .eq. 2) then
- i1fnodur=32
- else if (idur .eq. 0) then
- i1fnodur=64
- else if (idur .eq. 16) then
-c
-c Only used for denominator of time signatures, not for notes
-c
- i1fnodur=4
- else if (idur .eq. 9) then
- i1fnodur = 128
- else
- print*
- print*,'You entered an invalid note-length value:',idur
- call stop1()
- end if
- if (dotq .eq. 'd') i1fnodur = i1fnodur*3/2
- return
- end
-c integer*4 function longi(ishort)
-c integer*2 ishort
-c longi = ishort
-c return
-c end
- function iashft(nacc)
- integer*4 ias(6)
- data ias /-1,1,0,0,-2,2/
- iashft = ias(nacc)
- return
- end
- function ifnodur(idur,dotq)
- character*1 dotq
- if (idur .eq. 6) then
- ifnodur=1
- else if (idur .eq. 3)then
- ifnodur=2
- else if(idur .eq. 1) then
- ifnodur=4
- else if(idur .eq. 8) then
- ifnodur=8
- else if(idur .eq. 4) then
- ifnodur=16
- else if(idur .eq. 2) then
- ifnodur=32
- else if(idur .eq. 0) then
- ifnodur=64
- else if(idur .eq. 9) then
- ifnodur=128
- else if (idur .eq. 16) then
-c
-c Only used for denominator of time signatures, not for notes
-c
- ifnodur=4
- else
- print*,'You entered an invalid note value'
- stop
- end if
- if (dotq .eq. 'd') ifnodur = ifnodur*3/2
- return
- end
- function ifnolev(noq,oct,ntrans)
- character*1 noq
- integer oct
- ifnolev = 7*oct+mod(ichar(noq)-92,7)+1+ntrans
- return
- end
-c subroutine report(nsdat,isdat1,isdat2)
-c integer*4 isdat1(202),isdat2(202)
-c write(*,'(a)')
-c * ' isd on? iv kv ip id ud1 ud2 ndx ivo iho lev crd lhd rhd'
-c do 1 isdat = 1 , nsdat
-c isdata = isdat1(isdat)
-c ionoff = igetbits(isdata,1,11)
-cc iv = iand(7,isdata)
-c iv = igetbits(isdata,5,13)
-c kv = igetbits(isdata,1,12)+1
-c ip = igetbits(isdata,8,3)
-c idcode = igetbits(isdata,7,19)
-c iud1 = igetbits(isdata,1,26)
-c iud2 = igetbits(isdata,1,27)
-c ndxslur = igetbits(isdata,4,28)
-c isdatb = isdat2(isdat)
-c ivo = igetbits(isdatb,6,6)-32
-c iho = igetbits(isdatb,7,12)-64
-c lev = igetbits(isdatb,7,19)
-c icrd = igetbits(isdatb,1,0)
-c lhd = igetbits(isdatb,1,1)
-c irhd = igetbits(isdatb,7,2)
-c write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur,
-c * ivo,iho,lev,icrd,lhd,irhd
-c1 continue
-c print*
-c return
-c end
- function igetbits(isdata,iwidbit,ishift)
-c
-c Extracts integer given by iwidbit bits of isdata, shifted by ishift, and
-c then added to ioff
-c
- igetbits = iand(2**iwidbit-1,ishft(isdata,-ishift))
- return
- end
- function igetvarlen(mmidi,icm,imidi,nbytes)
-c
-c Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes.
-c
- parameter (nm=24,mv=24576)
- integer*2 mmidi(0:nm,mv)
- igetvarlen = 0
- do 1 nbytes = 1 , 4
- igetvarlen = 128*igetvarlen
- * +iand(127,mmidi(icm,imidi+nbytes))
- if (.not.btest(mmidi(icm,imidi+nbytes),7)) return
-1 continue
- print*,'Messup in igetvarlen'
- call stop1()
- end
- logical function isdotted(nodur,ivx,ip)
- parameter (nm=24)
-c
-c Function returns true if note is dotted or double-dotted.
-c Return false for any xtuplet.
-c
- common /comtol/ tol
- integer*4 nodur(nm,200)
- if (nodur(ivx,ip) .eq. 0) then
- isdotted = .false.
- return
- else if (ip .gt. 1) then
- if (nodur(ivx,ip-1) .eq. 0) then
- isdotted = .false.
- return
- end if
- end if
-c
-c Ruled out all xtups, so is dotted or double-dotted if not a power of 2.
-c
- isdotted =
- * mod(alog(float(nodur(ivx,ip)))/.69314718+.5*tol,1.) .gt. tol
- return
- end
- function isetvarlen(idur,nbytes)
- isetvarlen = 0
- itemp = idur
- do 1 nbytes = 1 , 4
- isetvarlen = isetvarlen + iand(itemp,127)*256**(nbytes-1)
- itemp = ishft(itemp,-7)
- if (itemp .gt. 0) then
- isetvarlen = isetvarlen+2**(8*nbytes+7)
- else
- return
- end if
-1 continue
- print*,'Problem in fn. isetvarlen'
- call stop1()
- end
- subroutine istring(i,string,len)
-c
-c Returns string with integer only if length is 1, otherwise enclosed in
-c brackets.
-c
- character*(*) string
- if (i .ne. 0) then
- len = alog10(abs(i)*1.0001)+1
- if (i .lt. 0) len = len+1
- else
- string = '0'
- len = 1
- return
- end if
- if (len .eq. 1) then
- string = char(48+i)
- else
- string = '{'
- write(string(2:1+len),'(i'//char(48+len)//')')i
- string = string(1:len+1)//'}'
- len = len+2
- end if
- return
- end
- function lenstr(string,n)
- character*(*) string
- do 1 lenstr = n , 1 , -1
- if (string(lenstr:lenstr) .ne. ' ') return
-1 continue
- lenstr = 0
- return
- end
- function levrn(nolev,irest,iud,ncm,mult)
-c
-c Used for placing numbers in xtups. Returns note level if not a rest,
-c else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm.
-c
- logical btest
- if (.not.btest(irest,0)) then
- levrn = nolev
- else
-c
-c Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default.
-c
- if (mult .gt. 0) then
- if (mult .eq. 2) then
- ioff = -1+2*iud
- else if (mult .ne. 4) then
- ioff = iud*mult
- else
- ioff = 1+4*iud
- end if
- else
-c
-c May need to futz with this later for non-beamed xtups (quarter, half rests)
-c
- ioff = iud*2
- end if
- levrn = mod(nolev+20,100)-20+ncm+ioff
- endif
- return
- end
- function lfmt1(x)
-c
-c Computes total length of an "f" format with one decimal place.
-c First round to nearest 0.1
-c
- if (abs(x) .lt. .001) then
- lfmt1 = 2
- else
- y = sign(.1*int(10*abs(x)+.5),x)
- lfmt1 = int(log10(1000*abs(y)+.001))
- if (y .lt. 0) lfmt1 = lfmt1+1
- end if
- return
- end
- subroutine LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
- * ispstie,sepsymq)
- parameter (nm=24)
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /comoct/ noctup
- integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
- logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie
- character*1 udq,chax,sepsymq(nm)
- character*8 noteq
- character*128 notexq
-c
-c This is called twice from pmxb after having input an entire block, before
-c making a bar that starts a new system. So nsdat reflects all slur starts
-c and stops in new block, while listslur, which is only set when bars are
-c made, reflects only open slurs from the old block. So we must check
-c listslur to find open ties, not all nsdat.
-c First of two calls (ispstie=.false. on entry) terminates tie at end of line.
-c Second (ispstie=.true. on entry) restarts tie at start of new line. Only
-c need data from original tie-start for both of these. Tie/slur data from
-c closing of full tie are not used except for shape alterations.
-c
-c do 1 ndx = 0 , 11
- do 1 ndx = 0 , 23
- if (btest(listslur,ndx)) then
-c
-c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie
-c
- do 2 isdat = 1 , nsdat
-c if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index
- if (igetbits(isdat1(isdat),4,28)
- * +16*igetbits(isdat1(isdat),1,18) .ne. ndx) go to 2 ! Wrong index
- if (.not.btest(isdat1(isdat),11)) go to 2 ! Bypass if stop
- if (btest(isdat2(isdat),3)) go to 3 ! "st"
- idcode = igetbits(isdat1(isdat),7,19)
- if (idcode.eq.1) go to 3 ! "t"
- tie = .false.
- go to 5
-2 continue
- end if
- go to 1
-3 continue
- tie = .true.
-5 continue
-c
-c A slur or tie is open, with index ndx
-c
- iv = igetbits(isdat1(isdat),5,13)
- kv = igetbits(isdat1(isdat),1,12)+1
- udq = 'd'
- if (btest(isdat1(isdat),27)) udq='u'
- notexq = chax(92)//'znotes'
- lnote = 7
- do 4 iiv = 1 , iv-1
- notexq = notexq(1:lnote)//sepsymq(iiv)
- lnote = lnote+1
-4 continue
- if (kv .eq. 2) then
- notexq = notexq(1:lnote)//chax(92)//'nextvoice'
- lnote = lnote+10
- end if
-c
-c Compute horiz and vert offsets
-c
-c nolev = igetbits(isdat2(isdat),7,19)
- islhgt = igetbits(isdat3(isdat),8,14)
- ilb12 = 0
- if (ispstie) ilb12 = 1
- ivoff = igetbits(isdat4(isdat),6,ilb12*16)-32
- if (ivoff .eq. -32) ivoff = 0
-C nolev = nolev+ivoff
- islhgt = islhgt+ivoff
- ihoff = (igetbits(isdat4(isdat),7,ilb12*16+6)-64) ! This is 10X hoff
- if (ihoff .eq. -64) ihoff = 0
-c
-c Add starting stuff for command
-c
- if (.not.ispstie) then ! End 1st segment
- notexq = notexq(1:lnote)//chax(92)//'roffset{'
- lnote = lnote+9
-c hoff = ihoff*.1-.5
-c hoff = ihoff*.1-.8
- hoff = ihoff*.1-.4
- if (hoff .lt. 0) then
- hoff = -hoff
- notexq = notexq(1:lnote)//'-'
- lnote = lnote+1
- end if
- call writflot(hoff,notexq,lnote)
- notexq = notexq(1:lnote)//'}{'
- lnote = lnote+2
- else
- notexq = notexq(1:lnote)//chax(92)//'off{-'
- * //chax(92)//'afterruleskip}'
- lnote = lnote+21
-c
-c 091025 add dotting for 2nd segment if needed
-c
- if (btest(isdat2(isdat),4)) then
- notexq = chax(92)//'dotted'//notexq(1:lnote)
- lnote = lnote+7
- end if
- end if
- if (ispstie .and. tie) then
- notexq = notexq(1:lnote)//chax(92)//'tieforis'//udq
- lnote = lnote+10
- end if
- if (btest(isdat3(isdat),0)) then
-c
-c Curvature tweak on termination of 1st seg
-c
- imid = igetbits(isdat3(isdat),6,2)-32
-c
-c Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping:
-c Abs(imid) Postscript slur type
-c 1 f
-c 4 h
-c 5 H
-c 6 HH
-c
- notexq = notexq(1:lnote)//chax(92)//'psforts'//chax(48+imid)
- lnote = lnote+9
-c
-c Zero out the flag in case there's a different curv on term of 2nd,
-c
- isdat3(isdat) = ibclr(isdat3(isdat),0)
- end if
-c
-c Add the command name
-c
- if (ispstie) then
- notexq = notexq(1:lnote)//chax(92)//'is'//udq
- lnote = lnote+4
- else if (tie) then
- notexq = notexq(1:lnote)//chax(92)//'ttie'
- lnote = lnote+5
- else
- notexq = notexq(1:lnote)//chax(92)//'tslur'
- lnote = lnote+6
- end if
-c
-c Add index
-c
-c if (11-ndx .lt. 10) then
-c notexq = notexq(1:lnote)//chax(59-ndx)
-c lnote = lnote+1
-c else
-c notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}'
-c lnote = lnote+4
-c end if
- if (23-ndx .lt. 10) then
- notexq = notexq(1:lnote)//chax(71-ndx)
- lnote = lnote+1
- else if (23-ndx .lt. 20) then
- notexq = notexq(1:lnote)//'{1'//chax(61-ndx)//'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//'{2'//chax(51-ndx)//'}'
- lnote = lnote+4
- end if
- if (ispstie .or. .not.tie) then
-c
-c Add note name for slur height
-c
- noctup = 0
- ncm = igetbits(isdat3(isdat),8,22)
- if (ncm .eq. 23) noctup = -2
-c call notefq(noteq,lnoten,nolev,ncm)
- call notefq(noteq,lnoten,islhgt,ncm)
- notexq = notexq(1:lnote)//'{'//noteq(1:lnoten)//'}'
- lnote = lnote+1+lnoten+1
- end if
- if (ispstie) then
-c
-c Horizontal shift start of new thing
-c
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
-c ihoff = ihoff-13
- if (tie) then
- ihoff = ihoff-12
- else
- ihoff = ihoff-7
- end if
- if (ihoff .lt. 0) then
- ihoff = -ihoff
- notexq = notexq(1:lnote)//'-'
- lnote = lnote+1
- end if
- call writflot(ihoff*.1,notexq,lnote)
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
-c
-c Add closing stuff
-c
- if (ispstie) then
- notexq = notexq(1:lnote)//chax(92)//'off{'
- * //chax(92)//'afterruleskip}'
- lnote = lnote+20
- else
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- notexq = notexq(1:lnote)//chax(92)//'en%'
- lnote = lnote+4
- write(11,'(a)')notexq(1:lnote)
-1 continue
- ispstie = .not.ispstie
- return
- end
- subroutine littex(islur,nnl,iv,topmods,lineq,iccount)
- parameter (nm=24)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink
- integer islur(nm,200)
- logical topmods
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg,merge
- character*128 lineq,litq
- character*20 voltxtq
- character*1 durq,chax
- merge = .false.
- if (nlit .gt. 0) then
- merge = iv.eq.ivlit(nlit) .and. nnl.eq.iplit(nlit)
- end if
- nlit = nlit+1
- ivlit(nlit) = iv
- iplit(nlit) = nnl
- itype = 1
-17 call getchar(lineq,iccount,durq)
- if (durq .eq. chax(92)) then
- itype=itype+1
- go to 17
- end if
- litq(nlit) = chax(92)//durq
- lenlit(nlit) = 2
-18 call getchar(lineq,iccount,durq)
- if (durq.eq.chax(92)) then
- call getchar(lineq,iccount,durq)
- if (durq .ne. ' ') then
-c
-c Starting a new tex command within the string
-c
- litq(nlit) = litq(nlit)(1:lenlit(nlit))//chax(92)//durq
- lenlit(nlit) = lenlit(nlit)+2
- go to 18
- end if
- else
- litq(nlit) = litq(nlit)(1:lenlit(nlit))//durq
- lenlit(nlit) = lenlit(nlit)+1
- go to 18
- end if
-c
-c If here, just read backslash-blank so string is done
-c
- if (itype .eq. 1) then
- islur(iv,nnl) = ibset(islur(iv,nnl),16)
- if (merge) then
-c
-c There are 2 separate strings on the same note, so merge them.
-c
- nlit = nlit-1
- litq(nlit) = litq(nlit)(1:lenlit(nlit))
- * //litq(nlit+1)(1:lenlit(nlit+1))
- lenlit(nlit) = lenlit(nlit)+lenlit(nlit+1)
- if (lenlit(nlit) .gt. 128) then
- print*
- print*,
- * 'Merged type-1 TeX strings longer than 128 characters'
- write(15,'(/,a)')
- * 'Merged type-1 TeX strings longer than 128 characters'
- call stop1()
- end if
- end if
- else
-c
-c Type 2 or 3.
-c
- if (itype .eq. 3) then
-c
-c Write the string NOW
-c
- if (islast)
- * write(11,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
- else
-c
-c Must go at top
-c
- if (.not.topmods) then
- topmods = .true.
- open(16,status='SCRATCH')
- end if
-c
-c Must write '%' here rather than later, in case string ends with blank.
-c
- write(16,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
- end if
- nlit = nlit-1
- end if
- return
- end
- function llen(strq,n)
- character*129 strq
- do 1 llen = n , 0 , -1
- if (strq(llen:llen) .ne. ' ') return
-1 continue
- end
- function log2(n)
-c
-c 5/25/08 Modify to allow more slurs
-c
-c log2 = alog(1.*n)/0.6931472+.0001
-c log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0
- log2 = dlog(1.d0*n)/0.693147181d0+.00000002d0
- return
- end
- subroutine logbeam(numnew,nip1,nip2)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*1 ulq,sepsymq,sq,ulfq,ulfbq
- logical beamon,firstgulp,figbass,figchk,isfig,isxtup,btest,
- * autofbon
- ibm1(ivx,numnew) = nip1
- ibm2(ivx,numnew) = nip2
- numnow = numnew
- if (numnew .gt. 1) then
-c
-c If it starts before any others, must put it in order
-c
- do 11 ib = numnew-1 , 1 , -1
- if (ibm1(ivx,ib) .lt. nip1) go to 12
- ibm1(ivx,ib+1) = ibm1(ivx,ib)
- ibm2(ivx,ib+1) = ibm2(ivx,ib)
- ulq(ivx,ib+1) = ulq(ivx,ib)
- ibm1(ivx,ib) = nip1
- ibm2(ivx,ib) = nip2
- numnow = ib
-11 continue
-12 continue
- end if
- sum = 0.
-c
-c Beam has non-xtup within
-c
- nrests = 0
- isxtup = .false.
- do 9 iip = nip1 , nip2
- if (btest(islur(ivx,nip1),21)) then
-c
-c Forced multiplicity
-c
- call setbits(mult(ivx,iip),4,0,
- * igetbits(islur(ivx,nip1),3,22)+8)
- else if (.not.isxtup) then
- if (nodur(ivx,iip) .gt. 0) then
- call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8)
- else
-c
-c Start xtup within forced beam
-c
- isxtup = .true.
- iip1 = iip
- end if
- else if (isxtup .and. nodur(ivx,iip).gt.0) then
-c
-c End of xtup within forced beam. Must count doubled notes
-c
- ndoub = 0
- do 1 iiip = iip1 , iip
- if (btest(nacc(ivx,iiip),18)) ndoub = ndoub+1
-1 continue
- multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)-
- * alog(nodur(ivx,iip)/2.))/0.69315)-10
- do 74 iiip = iip1 , iip
- call setbits(mult(ivx,iiip),4,0,multx+8)
-c
-c Note the following still works after making mult only the 1st 4 bits.
-c
- if (btest(nacc(ivx,iiip),18))
- * mult(ivx,iiip) = mult(ivx,iiip)-1
- if (btest(nacc(ivx,iiip),19)) then
- mult(ivx,iiip) = mult(ivx,iiip)+1
- else if (iiip .gt. 1) then
- if (btest(nacc(ivx,iiip-1),19))
- * mult(ivx,iiip) = mult(ivx,iiip)+1
- end if
-74 continue
- isxtup = .false.
- end if
- if (btest(irest(ivx,iip),0)) then
- nrests = nrests+1
- else
- sum = sum+nolev(ivx,iip)
- end if
-9 continue
-c
-c Set beam up-down-ness
-c
- if (ifb.gt.0 .and. ulfbq(ivx,max(1,ifb)).ne.'x') then
- if (ulfbq(ivx,ifb) .eq. 'f') then
-c
-c Get default, then trade "l" and "u"
-c
- ulq(ivx,numnow) = char(225-ichar(
- * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))))
- else
- ulq(ivx,ifb) = ulfbq(ivx,ifb)
- end if
-c
-c This probably works only because forced beams are done first, so they
-c don't have to be re-sorted within each voice. ????
-c
- else if (nvmx(iv) .eq. 2) then
-c
-c Multi-voice per staff
-c
- if (ivx .le. nv) then
- ulq(ivx,numnow) = 'l'
- else
- ulq(ivx,numnow) = 'u'
- end if
- else
-c
-c Defaults
-c
- ulq(ivx,numnow) =
- * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))
- end if
- return
- end
- subroutine m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
-c
-c This is called when (a) macro recording is just starting and
-c (b) at the start of a new line, if recording is on
-c
- parameter (maxblks=9600)
- character*128 lineq,lnholdq
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
- * ic1mac(20),ilmac,iplmac
- logical mrecord,mplay,endmac
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- lbuf(1) = lbuf(1)
- if (.not.mrecord) then
-c
-c Starting the macro
-c
- ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
- il1mac(macnum) = ilbuf-1
- ic1mac(macnum) = iccount
- mrecord = .true.
- end if
- if (iccount .lt. 128) then
- ndxm = index(lineq(iccount+1:128),'M')
- if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
- * 128-iccount)
- if (ndxm .gt. 0) then
-c
-c This line ends the macro.
-c
- if (lineq(iccount+ndxm+1:iccount+ndxm+1) .ne. ' ') then
- call errmsg(lineq,iccount+ndxm+1,ibarcnt-ibaroff+nbars+1,
- * 'Improper macro termination!')
- call stop1()
- end if
- ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
- il2mac(macnum) = ilbuf-1
- mrecord = .false.
- end if
- end if
- return
- end
- subroutine make1bar(ibmrep,tglp1,tstart,cwrest,squez,
- * istop,numbms,istart)
- parameter (nm=24,mv=24576)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
- character*10 figq
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig,bar1syst
- common /comeskz2/ eskz2(nm,200)
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- common /combeam/ ibmtyp
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comas2/ nasksys,wasksys(800),elasksys(800)
- common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- common /comsln/ is1n1,is2n1,irzbnd,isnx
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg,autofbon
- character*128 litq
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm),
- * numbms(nm),mapfb(16)
- real*4 xit(nm),t1xtup(20),tstart(80),squez(80)
- character*1 ulfbq
- character*79 inameq
- character*20 voltxtq
- common /comoct/ noctup
- character*80 headrq,lowerq
- logical cwrferm
- common /comcwrf/ cwrferm(nm)
- common /comnsp/ space(80),nb,prevtn(nm),
- * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
- logical lower,cwrest(nm),vxtup,flgndb,btest,upslur,
- * infbmx(nm),lowdot,inxtup(nm),drawbm
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /comstart/ facmtr
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
-c
-c Above are factors for grace note, clef spacing. (fraction of wheadpt)
-c In 1.04, moved to block data subprogram
-c
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /comtol/ tol
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur,
- * WrotePsslurDefaults
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /comntot/ ntot
- if (ismidi) then
-c
-c Initialize for this bar the accidental counter for the midi file.
-c naccim(icm) = # of accidentals from earlier in the bar
-c
- do 45 iv = 1 , nv
- do 45 kv = 1 , nvmx(iv)
- naccim(midchan(iv,kv)) = 0
-45 continue
- end if
-c
-c Time from start of gulp to end of bar, used with forced beams
-c
- tglp2 = lenb0+ibar*lenb1
- if (lenb0 .gt. 0) tglp2 = tglp2-lenb1
- tglp1 = tglp2-lenbar
-c
-c infbmx will only be true if in xtup that is NOT in explicit forced beam.
-c
- do 1 iv = 1 , nv
- do 1 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- cwrest(ivx) = .false.
- infbmx(ivx) = .false.
- inxtup(ivx) = .false.
- if (ibar .gt. 1) then
- nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
- else
- nn(ivx) = nib(ivx,ibar)
- end if
-1 continue
-c
-c initialize list note counter, time(iv), curr. note(iv). The loop to 4
-c ONLY initializes each voice.
-c
- in = 1
- nxtup = 0
- narp = 0
- do 4 iv = 1 , nv
- do 4 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- cwrferm(ivx) = .false.
- cnn(ivx) = 1
- ivxo(in) = ivx
- ipo(in) = cnn(ivx)
- tnote(in) = fnote(nodur,ivx,1,nacc)
- to(in) = 0.
- xit(ivx) = tnote(in)
-c
-c Note that xit(ivx) is to END of note in voice, but it1xtup is start time.
-c
- if (nodur(ivx,ipo(in)) .eq. 0) then
-c
-c First note of xtuplet at start of bar in voice ivx.
-c
- nxtup = nxtup+1
- nxtnow(ivx) = nxtup
- inxtup(ivx) = .true.
- t1xtup(nxtup) = 0.
-c
-c Xtup at start of bar. If no explicit forced beam, start one, set
-c signal infbmx, and save number ifbnow for use at termination.
-c
- if (nfb(ivx) .gt. 0) then
- do 60 ifb = 1 , nfb(ivx)
- if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c No explicit fb here; so exit loop and insert one.
-c
- go to 61
- else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
- * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c IS explicit fb here; must NOT insert one
-c
- go to 62
- end if
-60 continue
- end if
-61 continue
-c
-c If here, xtup isn't in explicit fb, so must insert one
-c
- infbmx(ivx) = .true.
- call addfb(nfb,ivx,t1xtup(nxtup)+
- * tglp1,t1fb,t2fb,ulfbq,ifbadd)
- ifbnow(ivx) = ifbadd
- end if
-62 continue
- if (abs(xit(ivx)-lenbar) .lt. tol) xit(ivx) = 1000.
- in = in+1
-4 continue
-c
-c Build the list: This is a manual loop starting at 5
-c
-5 continue
-c
-c Determine which voice comes next from end of notes done so far.
-c tmin is the earliest ending time of notes done so far
-c
- tmin = 1000.
- do 6 iiv = 1 , nv
- do 6 kv = 1 , nvmx(iiv)
- iivx = ivmx(iiv,kv)
- tminn = min(tmin,xit(iivx))
- if(tminn .lt. tmin-tol) then
- tmin = tminn
- ivx = iivx
- end if
-6 continue
- if (abs(tmin-1000.) .lt. tol) go to 7
- ivxo(in) = ivx
- cnn(ivx) = cnn(ivx)+1
- ipo(in) = cnn(ivx)
- to(in) = tmin
-c
-c Check if this voice is done
-c
- tnote(in) = fnote(nodur,ivx,cnn(ivx),nacc)
- if (cnn(ivx) .eq. nn(ivx)) then
- xit(ivx) = 1000.
- else
- xit(ivx) = xit(ivx)+tnote(in)
- end if
-c
-c Flag xtups
-c
- if (nodur(ivx,cnn(ivx)) .eq. 0) then
- if (.not.inxtup(ivx)) then
-c
-c First note of xtup, not at start of bar.
-c
- nxtup = nxtup+1
- nxtnow(ivx) = nxtup
- inxtup(ivx) = .true.
- t1xtup(nxtup) = xit(ivx)-tnote(in)
-c
-c (Note: can't be on last note in voice, so xit(ivx) <> 1000)
-c Put xtuplet in a forced beam if not already in forced beam
-c
- if (nfb(ivx) .gt. 0) then
- do 70 ifb = 1 , nfb(ivx)
- if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c NO explicit bm; put one in
-c
- go to 71
- else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
- * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
-c
-c IS explicit bm. Don't put one
-c
- go to 72
- end if
-70 continue
- end if
-71 continue
-c
-c If here, no explicit bm, so put one in
-c
- infbmx(ivx) = .true.
- call addfb(nfb,ivx,t1xtup(nxtup)+tglp1,
- * t1fb,t2fb,ulfbq,ifbadd)
- ifbnow(ivx) = ifbadd
- end if
-72 continue
- else if (inxtup(ivx)) then
-c
-c This test is sufficient because already know nodur>0
-c
- inxtup(ivx) = .false.
- if (infbmx(ivx)) then
-c
-c Xtup is in auto-forced beam, so end it
-c
- t2fb(ivx,ifbnow(ivx)) =
- * t1xtup(nxtnow(ivx))+nodur(ivx,cnn(ivx))+tglp1
- infbmx(ivx) = .false.
- end if
- end if
- if (btest(irest(ivxo(in),ipo(in)),24) .or.
- * btest(irest(ivxo(in),ipo(in)),30)) then
-c
-c For staff jumped beam, flag the first note (lowest voice) at same time.
-c Later will start new notes group here.
-c
- inj = in
- if (ivxo(in) .gt. 1) then
- do 40 iin = in-1 , 1 , -1
- if (to(iin)+tol .lt. to(in)) go to 41
- if (abs(to(iin)-to(in)) .lt. tol) then
- inj = iin
- go to 40
- end if
-40 continue
- end if
-41 continue
- irest(ivxo(inj),ipo(inj)) = ibset(irest(ivxo(inj),ipo(inj)),29)
- end if
- in = in+1
- go to 5
-7 continue
- ntot = in-1
- do 8 in = 1 , ntot-1
- tno(in) = to(in+1)-to(in)
-8 continue
- tno(ntot) = tnote(ntot)
-c
-c Debug writes
-c
-c write(*,'()')
-c write(*,'(a)')' Greetings from PMXB'
-c write(*,'(16i5)')(ivxo(in),in=1,ntot)
-c write(*,'(16i5)')(ipo(in),in=1,ntot)
-c write(*,'(16f5.1)')(to(in),in=1,ntot)
-c write(*,'(16f5.1)')(tno(in),in=1,ntot)
-c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
-c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
-c
-c Done w/ list. Loop for parsing into note blocks:
-c
- ib = 1
- istart(1) = 1
- space(1) = 0.
- in = 1
-c
-c A manual loop to set space(ib) and istop(ib)
-c
-9 continue
-
- ivx = ivxo(min(in+1,ntot))
- ip = ipo(min(in+1,ntot))
- isl = islur(ivx,ip)
- if (in.eq.ntot .or. ((ivx.eq.1 .and.
- * (iand(isl,67109216).gt.0 .or. btest(ipl(1,ip),28)
-c * .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then
-c Bits 1-13: stmgx+Tupf._)
-c 14: Down fermata, was F
-c 15: Trill w/o "tr", was U
- * .or. btest(iornq(1,ip),4))) .or. btest(isl,15) )
-c
-c Checking for start of 2nd part of jumped beam
-c
- * .or. btest(irest(ivx,ip),29) ) then
-c
-c Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam;
-c flow out of if-loop and into block-wrapup
-c
-c 10/18/97: Problem with clef alignment. Got isl{15} set on lowest-numbered
-c voice, but it wasn't first in the list at the same time. So check if
-c prior notes in list have same time
-c 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef
-c changes on last note in the list?
-c
- if (btest(isl,15) .and. in.lt.ntot) then
- do 50 iin = in , 1 , -1
- if (tno(iin) .gt. tol) then
- in = iin
- islur(ivx,ip) = ibclr(islur(ivx,ip),15)
- islur(ivxo(in+1),ipo(in+1)) =
- * ibset(islur(ivxo(in+1),ipo(in+1)),15)
- go to 51
- end if
-50 continue
-51 continue
- end if
- if (space(ib) .lt. tol) then
- space(ib) = tno(in)
- squez(ib) = 1.
- end if
- istop(ib) = in
- else if (space(ib) .lt. tol) then
-c
-c space hasn't been set yet, so tentatively set:
-c
- space(ib) = tno(in)
- if (space(ib) .lt. tol) then
- in=in+1
- else
- squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
- istop(ib) = in
- end if
- go to 9
- else if (tno(in+1) .lt. tol) then
-c
-c This is not the last note in the group, so
-c
- in = in+1
- go to 9
- else if (abs(tno(in+1)-space(ib)) .lt. tol) then
- xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
- if (abs(xsquez-squez(ib)) .lt. tol) then
-c
-c Keep spacing the same, update tentative stop point
-c
- in = in+1
- istop(ib) = in
- go to 9
- end if
- end if
-c
-c At this point istart and istop are good, so finalize block
-c
- tstart(ib) = to(istart(ib))
- if (istop(ib) .eq. ntot) go to 15
- ib = ib+1
- istart(ib) = istop(ib-1)+1
- in = istart(ib)
-c
-c Set tentative block space and squeeze-factor for upcoming block
-c
- space(ib) = tno(in)
- if (space(ib).gt.tol)
- * squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
- istop(ib) = in
- go to 9
-15 continue
- nb = ib
-c
-c Invert the list of places into ipl(0-7), making it easier to analyze a voice
-c
- do 13 in = 1 , ntot
-c
-c ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes.
-c
-c ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in)
- ipl2(ivxo(in),ipo(in)) = in
-13 continue
-c
-c Compute elemskips from start of bar to each note in the bar, for beam slopes
-c
- eskzb = 0.
- ib = 1
- do 30 in = 1 , ntot
- if (in .eq. istart(ib)) then
- deskb = squez(ib)*feon(space(ib)/squez(ib))
- else if (tno(in-1) .gt. tol) then
- eskzb = eskzb+deskb
- end if
- eskz(ivxo(in),ipo(in)) = eskzb
- eskz2(ivxo(in),ipo(in)) = eskzb
- if (in .eq. istop(ib)) then
- eskzb = eskzb+deskb
- ib = ib+1
- end if
-30 continue
-c
-c Analyze for beams.
-c
- do 20 iv = 1 , nv
- do 20 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- numbms(ivx) = 0
- mapfb(1) = 0
- mapfb(2) = 0
- mapfb(3) = 0
- mapfb(4) = 0
-c
-c First forced beams.
-c
- if (nfb(ivx) .gt. 0) then
-c
-c tglp2 is time from start of gulp to end of current bar.
-c
- nfbbar = 0
- do 80 ifb = 1 , nfb(ivx)
- if (t1fb(ivx,ifb).gt.tglp2-tol) go to 81
- nfbbar = nfbbar+1
- numbms(ivx) = numbms(ivx)+1
- numnew = numbms(ivx)
-c
-c Times from beginning of bar
-c
- itbb1 = int(t1fb(ivx,ifb)-tglp1+tol)
- itbb2 = int(t2fb(ivx,ifb)-tglp1+tol)
- do 83 ip = 1 , nn(ivx)
- if (int(to(ipl2(ivx,ip))+tol) .eq. itbb1) then
- nip1fb = ip
- do 84 ip1 = ip , nn(ivx)
- inip1 = ipl2(ivx,ip1)
- if (abs(to(inip1)+tnote(inip1)-itbb2) .lt. tol) then
- nip2fb = ip1
- itbb3 = itbb2-2
- go to 85
- end if
-84 continue
- end if
-83 continue
- print*
- print*,'Timing problem w/ forced beams'
- write(15,'(/a)')'Timing problem w/ forced beams'
-85 continue
- call logbeam(numnew,nip1fb,nip2fb)
-c
-c Set up mapfb for forced beam just logged:
-c
- ib1 = itbb1/2
- ib2 = itbb3/2
- ibrep = lenbar/ibmrep/2
- do 86 irep = 1 , ibmrep
- ib1now = max(0,ib1-(irep-1)*ibrep)
- ib2now = min(irep*ibrep-1,ib2-(irep-1)*ibrep)
- mapnow = 0
- do 87 ib = ib1now , ib2now
- mapnow = ibset(mapnow,ib)
-87 continue
- mapfb(irep) = ior(mapfb(irep),mapnow)
-86 continue
-c
-c Since we are cycling thru forced beams, for those that start with a rest and
-c have height & slope adjustments, move adjustments to next note.
-c 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at
-c start of beam
-c
- if (btest(irest(ivx,nip1fb),0)) then
- do 88 kp = nip1fb+1 , nip2fb
- call setbits(ipl(ivx,kp),6,11,
- * igetbits(ipl(ivx,nip1fb),6,11))
- call setbits(ipl(ivx,kp),6,17,
- * igetbits(ipl(ivx,nip1fb),6,17))
- call setbits(islur(ivx,kp),2,27,
- * igetbits(islur(ivx,nip1fb),2,27))
-88 continue
- end if
-80 continue
-81 continue
-c
-c Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar.
-c Remember, makeabar is called 1/bar, and it calls findbeam once per voice.
-c
- if (nfbbar .gt. 0) then
- nfb(ivx) = nfb(ivx)-nfbbar
- do 82 ifb = 1 , nfb(ivx)
- t1fb(ivx,ifb) = t1fb(ivx,ifb+nfbbar)
- t2fb(ivx,ifb) = t2fb(ivx,ifb+nfbbar)
- ulfbq(ivx,ifb) = ulfbq(ivx,ifb+nfbbar)
-82 continue
- end if
- end if
- ifb = 0
-c
-c Done with forced beam masks for this bar and voice. Now get normal beams.
-c
- call findbeam(ibmrep,numbms,mapfb)
-20 continue
- return
- end
- subroutine make2bar(ninow,tglp1,tstart,cwrest,squez,
- * istop,numbms,istart,clefq)
- parameter (nm=24,mv=24576)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
- character*10 figq
- character*1 ulq,sepsymq,sq,chax
- logical beamon,firstgulp,figbass,figchk,isfig,bar1syst,isbjmp,
- * isbj2
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- common /combeam/ ibmtyp
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comas2/ nasksys,wasksys(800),elasksys(800)
- common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- common /comsln/ is1n1,is2n1,irzbnd,isnx
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg,issig,rpndot,autofbon
- character*128 litq
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- integer istart(80),istop(80),iaskb(nm),numbms(nm),
- * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2)
- character*1 ulfbq,udqq,clefq(nm),slurudq,udq
- character*8 noteq
- character*79 cwrq(nm),notexq,inameq
- character*20 voltxtq
- common /comoct/ noctup
- character*80 soutq,headrq,lowerq
- common /comnsp/ space(80),nb,prevtn(nm),
- * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
- logical bspend,lower,cwrest(nm),vxtup,
- * isgrace,isclef,nofirst,iscln,isdot,isflag,
- * isacc,isfirst,flgndb,btest,stemup,upslur,
- * isgaft,isarp,isrshft,isaccs,iscacc,
- * lowdot,flipend,iscwr,isdotted,beamon1(nm)
- real*4 ptgr(37),ptclef(nm),ptsndg(nm),eskndg(nm),tstart(80),
- * squez(80)
- logical cwrferm,drawbm
- common /comcwrf/ cwrferm(nm)
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xelsk(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /comstart/ facmtr
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
-c
-c Factors for grace note, clef spacing. (fraction of wheadpt)
-c In 1.04, moved to block data subprogram
-c
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
- common /comtol/ tol
- common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
- logical ignorenats,newmbrhgt
- integer*2 mmidi,iinsiv
- logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur
- * ,WrotePsslurDefaults
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- logical slmon,dbltie
- common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
- * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
- * slmon(0:nm),dbltie
- common /comevent/ miditime,lasttime
- logical kbdrests
- common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
- logical secondgrace
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /commidisig/ midisig
-c 130316
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
- common /comclefrests/ centrests
- logical centrests
- common /xjbeambrests/ nbrests
- common /comc8flag/ c8flag(nm)
- logical c8flag
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- character*4 ivxq
- logical rename
- common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
- * poefa
- real*4 poefa(125)
- logical nocodabn
- nbrests = 0
-c
-c Set up main ib loop within which a block (notes group) is written
-c
- do 25 iv = 1 , nv
- do 25 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- ibmcnt(ivx) = 1
- ibmcnt1(ivx) = 1
- beamon(ivx) = .false.
- beamon1(ivx) = .false.
- nornb(ivx) = 0
- iaskb(ivx) = 1
- vxtup(ivx) = .false.
- drawbm(ivx) = .true.
-25 continue
- naskb = 0
- ifig(1) = 1
- ifig(2) = 1
- ixtup = 0
- bspend = .false.
- iscwr = .false.
- rpndot = .false.
- do 16 ib = 1 , nb
-c
-c Check for segno
-c
- if (btest(iornq(1,ipo(istart(ib))),4) .and.
- * ivxo(istart(ib)).eq.1) then
- if (noffseg.le.-10) then
- write(noteq(1:5),'(1H{,i3,1H})')noffseg
- lnoten = 5
- else if (noffseg.lt.0 .or. noffseg.ge.10) then
- write(noteq(1:4),'(1H{,i2,1H})')noffseg
- lnoten = 4
- else
- write(noteq(1:1),'(i1)')noffseg
- lnoten = 1
- end if
- notexq = sq//'znotes'//sq//'segnoo'//noteq(1:lnoten)//'9'
- lnote = 15+lnoten
- do 130 iv = 2 , nv
- if (lnote .gt. 60) then
- if (islast) write(11,'(a)')notexq(1:lnote)//'%'
- notexq = sepsymq(iv-1)//sq//'segnoo'
- * //noteq(1:lnoten)//'9'
- lnote = lnoten+9
- else
- notexq = notexq(1:lnote)//sepsymq(iv-1)//sq//'segnoo'
- * //noteq(1:lnoten)//'9'
- lnote = lnote+lnoten+9
- end if
-130 continue
- if (islast) write(11,'(a)')notexq(1:lnote)//sq//'en'
- lnote = 0
- end if
-c
-c Check for new clefs
-c
- isclef = .false.
- if (btest(islur(ivxo(istart(ib)),ipo(istart(ib))),15))
- * then
-c
-c In preceding line, fl32 gave wrong result for ... .gt.0 !!!
-c
- do 140 in = istart(ib) , istop(ib)
- if (btest(islur(ivxo(in),ipo(in)),11)) then
- call wsclef(ivxo(in),ninow,
- * iand(ishft(islur(ivxo(in),ipo(in)),-12),7))
-c
-c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
-c
-c if (clefq(ivxo(in)) .eq. '8') then
- if (btest(ipl(ivxo(in),ipo(in)),2)) then
-c
-c Find instrument number for voice ivso(in)
-c
- iv1 = 1
- do 1111 iinst = 1 , ninow
- if (ivxo(in) .lt. iv1+nspern(iinst)) go to 2222
- iv1 = iv1+nspern(iinst)
-1111 continue
- print*
- print*,'Should not be here in make2bar!'
- call stop1()
-2222 continue
- if (iinst .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',
- * iinst,sq//'treblelowoct%'
- else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',
- * iinst,sq//'treblelowoct%'
- end if
- c8flag(ivxo(in)) = .true.
- end if
- end if
-140 continue
- if (islast) write(11,'(a)')sq//'pmxnewclefs'
- isclef = .true.
- end if
-c
-c Start a notes group. We're just gonna define every one using pnotes{n},
-c where \def\pnotes#1{\vnotes#1\elemskip}
-c
- soutq = sq//'pnotes{'
- eonsqz = squez(ib)*feon(space(ib)/squez(ib))
- if (eonsqz .gt. 9.995) then
- write(soutq(9:12),'(f4.1)')eonsqz
- else if (eonsqz .gt. 0.995) then
- write(soutq(9:12),'(f4.2)')eonsqz
- else if (eonsqz .gt. 0.095) then
- soutq = soutq(1:8)//'0.'
- write(soutq(11:12),'(i2)')nint(100*eonsqz)
- else
- soutq = soutq(1:8)//'0.0'
- write(soutq(12:12),'(i1)')nint(100*eonsqz)
- end if
- soutq = soutq(1:12)//'}'
- lsout = 13
-c
-c Check whole block, flag accidentals etc that are too close, one per *time*.
-c Note about bar starts and after rpt's/boublebars: There is an afterruleskip
-c (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so
-c (dotsfac*wheadpt) is presumed to be filled up.
-c
- in = istart(ib)-1
- itrpt = -1
- itsig = -1
-c
-c Begin big manual loop over notes in this block; ends at 112
-c
-111 in = in+1
- if (in .gt. istop(ib)) go to 112
- ip = ipo(in)
- ivx = ivxo(in)
- if (ivx .le. nv) then
- iv = ivx
- else
- do 128 iv = 1 , nv
- if (nvmx(iv) .eq. 2 .and. ivmx(iv,2).eq. ivx) go to 129
-128 continue
- print*,'Trouble finding iv!, ivx,nvmx,ivmx:',ivx,nvmx(1),nvmx(2)
- print*,ivmx(1,1),ivmx(1,2),ivmx(2,1),ivmx(2,2)
- stop
- end if
-129 continue
-c
-c Call precrd here so we know how much space to add for accid's in chords
-c After calling precrd, icashft>0 means there is a shifted chordal accid (incl.
-c main note.
-c
-c To call precrd, need up-downness, so must track if in beam.
-c
-c Deal w/ staff-jumping beams later
-c if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
-c * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or.
-c * btest(nacc(ivx,ip),21)) then
-c if (.not.btest(irest(ivx,ip),24)) then
- if ((numbms(ivx).gt.0 .and. ibmcnt1(ivx).le.numbms(ivx)
- * .and. ibm1(ivx,ibmcnt1(ivx)) .eq. ip)) then
- beamon1(ivx)=.true.
- end if
- icashft = 0
- if (btest(ipl(ivx,ip),10)) then
-c
-c There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds.
-c
- if (beamon1(ivx)) then
- call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
- * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt1(ivx)),
- * .false.,icashft)
- else
- call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
- * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
- * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
- * .false.,icashft)
- end if
- end if
-c
-c Turn beam off?
-c
- if (beamon1(ivx) .and. ibm2(ivx,ibmcnt1(ivx)).eq.ip) then
- beamon1(ivx) = .false.
- ibmcnt1(ivx) = ibmcnt1(ivx)+1
- end if
-c
-c Remember, rpts & internal sigs can only come at start of (internal) block
-c
- isacc = iand(nacc(ivx,ip),3).gt.0
- * .and. .not.btest(nacc(ivx,ip),17)
- * .and. .not.btest(ipl(ivx,ip),10)
-c
-c i.e., do not set for chord. Now check for "(" as ornament on main note,
-c
-c!!! Need to do this for chord notes too. Maybe in chkarp?
-c
- isaccs = isacc .or. btest(iornq(ivx,ip),0)
-c
-c 5/15/02 Add check for ) ornament of prior note.
-c 5/16 Nope...fails when grace intervenes.
-c if (ip .gt. 1) then
-c isaccs = isaccs .or. btest(iornq(ivx,ip-1),13)
-c end if
- isarp = btest(iornq(ivx,ip),27)
- iscacc = .false.
- if (btest(ipl(ivx,ip),10)) then
-c
-c There is a chord here; check for arpeggios and accidentals. Note accid shifts are
-c not of concern here, only whether there's an accid, whick causes iscacc=.true.
-c
- iscacc = igetbits(nacc(ivx,ip),3,0).gt.0 .and.
- * .not.btest(nacc(ivx,ip),17)
- call chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
- end if
-c
-c When we get motivated, will do spacing for arpeggios here.
-c
- if (ivx.eq.1 .and. iand(islur(ivx,ip),96).gt.0)
- * itrpt = nint(to(in))
- issig = btest(ipl(ivx,ip),28)
- if (ivx.eq.1 .and. issig) itsig = nint(to(in))
- isgrace = btest(islur(ivx,ip),4) .and.
- * .not.btest(ipl(ivx,ip),29) .and. .not.btest(ipl(ivx,ip),31)
- isgaft = .false.
- if (ip .gt. 1) then
- xnd = tnote(ipl2(ivx,ip-1))
- isgaft = btest(ipl(ivx,ip-1),29) .or. btest(ipl(ivx,ip-1),31)
- isgrace = isgrace .or. isgaft
- end if
- iscln = isclef .and. btest(islur(ivx,ip),11)
-c
-c Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd
-c
- isflag = ip.gt.1 .and. xnd.gt.tol .and. xnd.lt.16.-tol
- if (isflag)
- * isflag = .not.btest(irest(ivx,ip-1),0)
- * .and. udqq(nolev(ivx,ip-1),
- * ncmid(iv,ip-1),islur(ivx,ip-1),nvmx(iv),ivx,nv).eq.'u'
- if (isflag) then
- do 116 ibmchk = 1 , numbms(ivx)
- if (ip-1 .lt. ibm1(ivx,ibmchk)) then
- go to 117
-c
-c Add check for non-beamed xtuplets. May be problem with stem direction.
-c
- else if (ip-1.le.ibm2(ivx,ibmchk) .and.
- * .not.btest(islur(ivx,ibm1(ivx,ibmchk)),18)) then
- isflag = .false.
- go to 117
- end if
-116 continue
- end if
-117 continue
-c
-c If isflag, then won't need to check for dot on prev. note.
-c
-c 5/16/02 ??? Try using this for ) ornament.
-c
- isflag = isflag .or. btest(iornq(ivx,ip-1),13)
- isdot = ip.gt.1
- if (isdot) isdot = isdotted(nodur,ivx,ip-1)
- isrshft = ip .gt. 1
- if (isrshft) isrshft = btest(irest(ivx,ip-1),20)
- if (.not.(isaccs.or.isgrace.or.iscln.or.isflag.or.isrshft.or.
- * isdot.or.btest(iornq(ivx,ip),26).or.
- * btest(irest(ivx,ip),21).or.isarp.or.
- * btest(irest(ivx,ip),27).or.iscacc)) go to 111
-c
-c Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift.
-c Compute pts, the total occupied space including prior notehead.
-c
-c 130324
-c wheadpt1 = wheadpt*fullsize(iv)
- wheadpt1 = wheadpt*fullsize(instno(iv))
- pts = wheadpt1
-c
-c Set up for possible cautionary accidental here
-c
- if (isaccs .or. iscacc) then
- if (.not.btest(iornq(ivx,ip),31)) then
- taccfac = accfac
- else
- taccfac = 1.4*accfac ! cautionary accidental
- end if
- end if
- if (isgrace) then
- secondgrace = .false.
- do 122 ig = 1 , ngrace
- if (.not. isgaft) then
- if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 123
- else if (ip .gt. 1) then
- if (ipg(ig).eq.ip-1 .and. ivg(ig).eq.ivx) go to 123
- end if
-122 continue
- print*,'Problem finding grace index in makeabar'
- stop
-123 continue
-c
-c wgr = distance to backspace (in headwidths), less main acc.
-c ptgr = same in pts,+ main acc. Not used for after-grace. Distance to backspace.
-c spgr = total space needed (w/o main acc).
-c Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place.
-c
- if (nng(ig) .eq. 1) then
- wgr = grafac
- if (multg(ig) .eq. 0) wgr = wgr-.4
- else
- wgr = nng(ig)*emgfac
- do 126 ing = 2 , nng(ig)
- if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
-126 continue
- end if
- if (graspace(ig) .gt. 0.) then
-c
-c User-defined space before grace
-c
- wgr = wgr+graspace(ig)
- end if
- ptgr(ig) = wgr*wheadpt1
- spgr = ptgr(ig)+xb4fac*wheadpt1
-c
-c!!! May need to mod for chord accid's
-c
- if (isaccs .or. iscacc) ptgr(ig) = ptgr(ig) + taccfac*wheadpt1
- if (naccg(ngstrt(ig)) .gt. 0) spgr = spgr+wheadpt1*agc1fac
- pts = pts+spgr
-c
-c Special check for after-grace on ip-1 and normal on ip. Must go back thru
-c loop again for the normal grace.
-c
- if (isgaft .and. ig.lt.ngrace .and. .not.secondgrace) then
- if (ipg(ig+1).eq.ip) then
- secondgrace = .true.
- ig = ig+1
- go to 123
- end if
- end if
- end if
- if (iscln) then
- pts = pts+clefac*wheadpt1
-c
-c How far to backspace when printing the clef
-c
- ptclef(ivx) = 0.
-c
-c!!! May need to mod for chord accid's
-c
- if (isaccs .or. iscacc)
- * ptclef(ivx) = ptclef(ivx)+taccfac*wheadpt1
- if (isgrace) ptclef(ivx) = ptclef(ivx)+spgr
- end if
- if (isrshft) then
- pts = pts+rtshfac*wheadpt1
- else if (isflag) then
- pts = pts+flagfac*wheadpt1
- else if (isdot) then
- pts = pts+dotfac*wheadpt1
- end if
- if (abs(to(in)-itrpt) .lt. tol) then
-c
-c Repeat, need a little extra space
-c
- pts = pts+dotsfac*wheadpt1
- end if
- if (isarp) then
- pts = pts+arpfac*wheadpt1
- end if
-c
-c Add in padding space
-c
- pts = pts+xspfac*wheadpt1
-c
-c Now done with all items needing space except accidentals,
-c accidental shifts, and left-notehead-shifts, and will later
-c subtract a notehead if at start of bar.
-c
-c Get available space in elemskips (esk)
-c
- isfirst = ip.eq.1 .or. abs(to(in)-itrpt).lt.tol .or.
- * abs(to(in)-itsig).lt.tol
- if (isfirst) then
-c
-c At start of bar or after repeat sign or new signature
-c
- if (abs(to(in)-itsig).lt.tol) then
- esk = 0.
- else
- esk = fbar
- end if
- else
-c
-c Not 1st note of bar
-c
- esk = eskz(ivx,ip)-eskz(ivx,ip-1)
- end if
- if (isgrace) then
-c
-c Since graces can be very long, cannot assume no interference if prior
-c note uses >1 noteskip. So must get elsk's back to prior note, whether or
-c not it used only one noteskip.
-c <<But if it was xtup. don't need to call eskb4.>>????
-c
-c 10/8/05 Kluge to not zero out esk if in xtup
-c
- esksav = esk
- if ((ip.le.2 .or. nodur(ivx,max(1,ip-2)).gt.0) .and.
-c * to(in).ne.itsig)
- * abs(to(in)-itsig).gt.tol)
- * call eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
- if (abs(esk) .lt. tol) esk = esksav
- end if
-c
-c Done getting available elemskips. Remove headwidth if first. Must do here
-c rather than earlier since check uses isfirst
-c
- if (isfirst) pts = pts-wheadpt1
-c
-c Deal with accidental shifts and left-notehead shifts
-c
- if (btest(ipl(ivx,ip),10)) then
-c
-c In a chord
-c
- ptsl = 0.
- if (btest(irest(ivx,ip),27)) ptsl = wheadpt1
- ptsadd = max(ptsl,icashft*.05*wheadpt1)
-c
-c Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK
-c
- else
-c
-c Not in a chord
-c
- ihshft = 0
- if (isaccs) then
- ihshft = igetbits(nacc(ivx,ip),7,10)
-c if (ihshft .ne. 0) ihshft = max(0,64-ihshft)
- if (ihshft .ne. 0) ihshft = max(0,107-ihshft)
- end if
-c
-c Check for left-shifted main note
-c
- if (btest(ipl(ivx,ip),8)) ihshft = max(20,ihshft)
- ptsadd = ihshft*.05*wheadpt1
- end if
- pts = pts+ptsadd
- if (isgrace) ptgr(ig) = ptgr(ig)+ptsadd
- if (iscln) ptclef(ivx) = ptclef(ivx)+ptsadd
-c
-c Left-shifted, non-chord note before?
-c
- if (ip .gt. 1) then
- if (.not.btest(ipl(ivx,ip-1),10) .and.
- * btest(irest(ivx,ip-1),27)) pts = pts-wheadpt1
- end if
-c
-c Try big accidentals first
-c
- ptbneed = pts
- if (isaccs .or. iscacc) then
- ptbneed = ptbneed+wheadpt1*bacfac
- end if
- if (poefa(iline)*poenom*esk .gt. ptbneed) then
-c
-c Set flag for big accidental
-c
- if (isacc) nacc(ivx,ip) = ibset(nacc(ivx,ip),3)
- go to 99
- end if
-c
-c Cannot use big, so try small
-c
- ptsneed = pts
- if (isaccs .or. iscacc) then
- ptsneed = ptsneed+taccfac*wheadpt1
- end if
- if (poefa(iline)*poenom*esk .lt. ptsneed) then
- call addask(to(in),ptsneed,poefa(iline)*esk,
- * fixednew,scaldold,0.,poefa(iline),.false.)
- end if
-99 continue
- if (btest(iornq(ivx,ip),26)) then
-c
-c User-defined space. Warning, "zero" may change value in addask!
-c
- zero = 0.
- call addask(to(in),ptsneed,zero,
- * fixednew,scaldold,tglp1,1.,.true.)
- end if
-c
-c End of big manual loop over "in" for accidental checking
-c
- go to 111
-112 continue
-c
-c End of ask analysis for this block.
-c
-c Adjust eskz if there are added spaces. Corrects length of xtup brackets.
-c
- if (naskb.gt.0) call adjusteskz(ib,istart,poenom)
-c
-c Check for internal repeat or sig change.
-c
- if (ib.gt.1 .and. ivxo(istart(ib)).eq.1) then
- iirpt = iand(islur(1,ipo(istart(ib))),67109216)
- if (iirpt .gt. 0) then
-c
-c Internal repeat
-c
- if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
- if (iirpt .eq. 96) then
- if (islast) write(11,'(a)')sq//'leftrightrepeat'
- fixednew = fixednew+lrrptfac*wheadpt
- else if (btest(iirpt,5)) then
- if (islast) write(11,'(a)')sq//'leftrepeat'
- fixednew = fixednew+rptfac*wheadpt
- else if (btest(iirpt,6)) then
- if (islast) write(11,'(a)')sq//'rightrepeat'
- fixednew = fixednew+rptfac*wheadpt
- else if (btest(iirpt,8)) then
- if (islast) write(11,'(a)')sq//'doublebar'
- else
- print*,'Unexpected mid-bar repeat command R*'
- call stop1()
- end if
- scaldold = scaldold-fbar
- end if
- if (btest(ipl(1,ipo(istart(ib))),28)) then
-c
-c Internal signature change.
-c
- notexq = sq//'generalsignature{'
- lnote = 18
- if (isig .lt. 0) then
- notexq = notexq(1:lnote)//'-'
- lnote = lnote+1
- end if
- if (islast) write(11,'(a)')notexq(1:lnote)
- * //chax(48+abs(isig))//'}%'
- if (islast .and. ignorenats)
- * write(11,'(a)')sq//'ignorenats%'
- if (islast) write(11,'(a)')sq//'zchangecontext'//sq
- * //'addspace{-.5'//sq//'afterruleskip}%'
- lnote = 0
- end if
- end if
- flgndb = .false.
-c
-c Done with start-of-block stuff. Begin main loop over voices.
-c
- do 11 iv = 1 , nv
- do 11 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- icm = midchan(iv,kv)
-c
-c A rather klugey way to set flag for figure in this voice
-c Must always check figbass before figchk.
-c
- if (figbass) then
- ivf = 0
- if (ivx .eq. 1) then
- ivf = 1
- else if (ivx .eq. ivxfig2) then
- ivf = 2
- end if
- if (ivf.gt.0) figchk(ivf) = nfigs(ivf).gt.0
- end if
- if (ivx .gt. 1) then
- if (ivx .le. nv) then
- call addstr(sepsymq(iv-1),1,soutq,lsout)
- else
- call addstr(sq//'nextvoice',10,soutq,lsout)
- end if
- end if
- if (ihdht.gt.0 .and. ivx.eq.nv) then
-c
-c Write header. First adjust height if needed to miss barno.
-c
- if (bar1syst .and. iline.ne.1) then
- ihdht = 15+irzbnd+isnx
- end if
-c
-c Add user-defined vertical shift
-c
- ihdht = ihdht+ihdvrt
- lchead = lenstr(headrq,80)
- notexq = sq//'zcharnote{'
- write(notexq(12:13),'(i2)')ihdht
- notexq = notexq(1:13)//'}{'//sq//'bigfont'//sq//'kern-30pt '
- call addstr(notexq,34,soutq,lsout)
- call addstr(headrq(1:lchead)//'}',1+lchead,soutq,lsout)
- ihdht = 0
- end if
- if (lower .and. ivx.eq.nv) then
- lclow = lenstr(lowerq,80)
- call addstr(sq//'zcharnote{-6}{'//
- * sq//'tempo'//sq//'kern-10pt '//
- * lowerq(1:lclow)//'}',33+lclow,soutq,lsout)
- lower=.false.
- end if
- tnow = tstart(ib)
- nofirst = .true.
-c
-c Done setting up voice ivx for start of block ib. Loop over notes in voice.
-c
- do 10 jn = istart(ib), istop(ib)
- if (ivxo(jn) .ne. ivx) go to 10
- ip = ipo(jn)
-c
-c May have problem with not initializing islhgt, so do it here
-c
- islhgt = 0
-c
- if (nofirst) then
- noctup = 0
- if (ncmid(iv,ip) .eq. 23) noctup = -2
- nofirst = .false.
- end if
-c
-c Check for internal floating figure (before last note of group).
-c
-12 if (figbass) then
- if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
- ivf = 1
- if (ivx .gt. 1) ivf = 2
- if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.tnow-tol)
- * then
-c
-c Bypassed figure location. Backup, place fig, return.
-c
- offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
- call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,
- * lsout)
- go to 12
- end if
- end if
- end if
-c
-c Put in \sk if needed
-c
- if (to(jn) .gt. tnow+tol) then
- call addstr(sq//'sk',3,soutq,lsout)
- tnow = tnow+space(ib)
- go to 12
- end if
-c
-c Check for user-defined shifts
-c
- if (btest(irest(ivx,ip),15).or.btest(irest(ivx,ip),16))
- * call putshft(ivx,.true.,soutq,lsout)
-21 if (iaskb(ivx).le.naskb .and.
- * tnow.gt.task(iaskb(ivx))-tol) then
- if (task(iaskb(ivx)) .gt. tstart(ib)-tol) then
-c
-c Insert placeholder for accidental skip
-c
- call addstr(sq//'ask ',9,soutq,lsout)
- nasksys = nasksys+1
- wasksys(nasksys) = wask(iaskb(ivx))
- if (wask(iaskb(ivx)) .gt. 0.) then
- elasksys(nasksys) = elask(iaskb(ivx))
- else
-c
-c This is a signal to permit negative ask's. Should really have elask>=0.
-c
- elasksys(nasksys) = -elask(iaskb(ivx))
- end if
- end if
-c
-c May have skipped some task's in earlier blocks (due to void voice)
-c
- iaskb(ivx) = iaskb(ivx)+1
- go to 21
- end if
- if (figbass) then
- if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
- ivf = 1
- if (ivx .gt. 1) ivf = 2
- if (figchk(ivf) .and.
- * abs(itfig(ivf,ifig(ivf))-tnow).lt.tol) then
-c
-c Figure on a note. NB: later special check for late figs.
-c
- call putfig(ivf,ifig(ivf),0.,figchk(ivf),soutq,lsout)
- end if
- end if
- end if
-c
-c Check for new clef here.
-c
- if (isclef .and. btest(islur(ivx,ip),11)) then
- if (ptclef(iv) .gt. 0.) then
- notexq = sq//'off{-'
- if (ptclef(iv) .lt. 9.95) then
- write(notexq(7:9),'(f3.1)')ptclef(iv)
- lnote = 9
- else
- write(notexq(7:10),'(f4.1)')ptclef(iv)
- lnote = 10
- end if
- notexq = notexq(1:lnote)//'pt}'
- lnote = lnote+3
- call addstr(notexq,lnote,soutq,lsout)
- end if
- call clefsym(islur(iv,ip),notexq,lnote,nclef)
-c
-c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8'
-c
- if (btest(ipl(ivx,ip),2)) notexq =
- * notexq(1:8)//'8'//notexq(10:10)
- call addstr(notexq,lnote,soutq,lsout)
- if (ptclef(iv) .gt. 0.) then
- notexq = sq//'off{'
- if (ptclef(iv) .lt. 9.95) then
- write(notexq(6:8),'(f3.1)')ptclef(iv)
- lnote = 8
- else
- write(notexq(6:9),'(f4.1)')ptclef(iv)
- lnote = 9
- end if
- notexq = notexq(1:lnote)//'pt}'
- lnote = lnote+3
- call addstr(notexq,lnote,soutq,lsout)
- end if
- end if
-c
-c Checking for literal TeX string BEFORE starting beams!!
-c
- if (btest(islur(ivx,ip),16)) then
- do 124 il = 1 , nlit
- if (iplit(il).eq.ip .and. ivlit(il).eq.ivx) go to 125
-124 continue
- print*,'Problem finding index for literal string'
- call stop1()
-125 continue
-c
-c Write a type 1 tex string.
-c
- if (lenlit(il) .lt. 71) then
-c
-c Add normally
-c
- call addstr(litq(il),lenlit(il),soutq,lsout)
- else
-c
-c Longer than 71. Write souq, Write string, start new soutq.
-c
- if (islast) write(11,'(a)')soutq(1:lsout)//'%'
- if (islast) write(11,'(a)')litq(il)(1:lenlit(il))//'%'
- lsout = 0
- end if
- end if
-c
-c Arpeggio on a main (non-chordal) note?
-c
- if (btest(iornq(ivx,ip),27)) then
-c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip),
- call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip),
- * soutq,lsout)
- end if
-c
-c See if a beam starts here
-c
- if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
- * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or.
- * btest(nacc(ivx,ip),21)) then
- if (.not.btest(irest(ivx,ip),24)) then
-c
-c Not a jump start
-c
- if (kbdrests .and. btest(irest(ivx,ip),0) .and.
- * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
- * nolev(ivx,ip).le.50)
- * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
- * mult,ipl)
- call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
-c
-c Shift beam start if notehead was shifted
-c
- if (btest(ipl(ivx,ip),8)) then
- call addstr(sq//'loff{',6,soutq,lsout)
- else if (btest(ipl(ivx,ip),9)) then
- call addstr(sq//'roff{',6,soutq,lsout)
- end if
- if (lnote .gt. 0) call addstr(notexq,lnote,soutq,lsout)
- if (btest(ipl(ivx,ip),8) .or.
- * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
- else
-c
-c Jump start. Set marker for second part of a jump beam. Note ivbj2 was set
-c to 0 at end of first part of jump beam
-c
- ivbj2 = ivx
-c
-c Check for xtup since we bypassed beamstrt wherein vxtup is normally set
-c
- if (btest(irest(ivx,ip),28) .and. ixrest(ivx).ne.2)
- * vxtup(ivx) = .true.
-c
-c Since beamstrt is not called, and drawbm is normally set there, need to set
-c it here. This could cause problems if someone tries a staff-jumping,
-c unbarred beam, which I'll deal with when it comes up.
-c
- drawbm(ivx) = .true.
- end if
- if (ixrest(ivx) .eq. 0) then
- beamon(ivx) = .true.
- bspend = .true.
- if (.not.btest(irest(ivx,ip),24))bspend = .true.
- end if
- end if
-c
-c Setup for chords and possible slurs in chords
-c
- if (btest(ipl(ivx,ip),10)) then
-c
-c There is a chord on this note. Just rerun precrd. Klunky, but saves
-c me from tracking down errors instroduced when I moved 1st call
-c forward for accidental spacing analysis.
-c
- if (beamon(ivx)) then
- call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
- * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt(ivx)),
- * .true.,icashft)
- else
- call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
- * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
- * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
- * .true.,icashft)
- end if
- end if
-c
-c Is there slur or grace activity?
-c
- isgrace = btest(islur(ivx,ip),4)
- if (ip .gt. 1) isgrace = isgrace.or.btest(ipl(ivx,ip-1),31)
-c
-c isgrace if not 1st note in bar and previous note has Way-after grace.
-c
- if (btest(islur(ivx,ip),0) .or. isgrace) then
- if (btest(islur(ivx,ip),0)) then
- if (fontslur) then
-c
-c Call routine for non-postscript slurs
-c
- call doslur(nolev(ivx,ip),isdat1,isdat2,isdat3,nsdat,
- * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
- * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
- * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
- * nacc(ivx,ip))
- else
-c
-c Postscript slurs
-c
- call dopsslur(nolev(ivx,ip),isdat1,isdat2,isdat3,
- * isdat4,nsdat,
- * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
- * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
- * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
- * nacc(ivx,ip))
- end if
- end if
- if (isgrace) then
-c
-c Grace note.
-c
- iphold = ip
- isgrace = .false.
- if (ip .gt. 1) isgrace = btest(ipl(ivx,ip-1),31)
- if (isgrace) iphold = iphold-1
- isgrace = isgrace .or. (.not.btest(ipl(ivx,ip),31)
- * .and..not.btest(ipl(ivx,ip),29))
-c
-c Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace
-c on current note. Do A-grace on current note, and W-grace at barend, later.
-c
- if (isgrace) then
- call dograce(ivx,iphold,ptgr,soutq,lsout,ncmid(iv,ip),
- * nacc(ivx,ip),ig,ipl(ivx,iphold),.false.,
- * beamon(ivx),nolev(ivx,ip),ncmid(iv,ip),
- * islur(ivx,ip),nvmx(iv),nv,ibmcnt(ivx),
-c 130324
-c * tnote(ipl2(ivx,ip)),ulq)
- * tnote(ipl2(ivx,ip)),ulq,instno(iv))
- if (slurg(ig)) then
-c
-c Terminate slur started in dograce. Get direction of main note stem
-c
- if (.not.beamon(ivx)) then
-c
-c Separate note. Get stem direction.
-c
- stemup = udqq(nolev(ivx,ip),ncmid(iv,ip),
- * islur(ivx,ip),nvmx(iv),ivx,nv) .eq. 'u'
- else
-c
-c In a beam
-c
- stemup = ulq(ivx,ibmcnt(ivx)) .eq. 'u'
- end if
-c
-c Stop the shift if whole note
-c
- stemup = stemup .or.
- * tnote(ipl2(ivx,ip)).gt.63
- call endslur(stemup,.not.upg(ig),nolev(ivx,ip),0,
- * ndxslur,0,ncmid(iv,ip),soutq,lsout,fontslur)
- end if
- end if
- end if
- if (btest(iornq(ivx,ip),24)) then
-c
-c Start slur on main note for After- or Way-after-grace.
-c
-c???? ndxslur = log2(33554431-listslur)
- ndxslur = log2(16777215-listslur)
-c
-c Get note name
-c
- call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
-c
-c Get slur direction
-c
- slurudq = 'u'
- if (.not.beamon(ivx)) then
- if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
- * nvmx(iv),ivx,nv) .eq. 'u') slurudq = 'd'
- else
- if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') slurudq = 'd'
- end if
-c
-cc Replace ndxslur by 11-ndxslur when printing only.
-c Replace ndxslur by 23-ndxslur when printing only.
-c
-c if (11-ndxslur .lt. 10) then
- if (23-ndxslur .lt. 10) then
-c notexq = sq//'islur'//slurudq//chax(59-ndxslur)
- notexq = sq//'islur'//slurudq//chax(71-ndxslur)
- * //noteq(1:lnoten)
- call addstr(notexq,8+lnoten,soutq,lsout)
- else if (23-ndxslur .lt. 20) then
- notexq = sq//'islur'//slurudq//'{1'//chax(61-ndxslur)
- * //'}'//noteq(1:lnoten)
- call addstr(notexq,11+lnoten,soutq,lsout)
- else
- notexq = sq//'islur'//slurudq//'{2'//chax(51-ndxslur)
- * //'}'//noteq(1:lnoten)
- call addstr(notexq,11+lnoten,soutq,lsout)
- end if
-c call setbits(ipl(ivx,ip),4,23,ndxslur)
- call setbits(ipl(ivx,ip),5,23,ndxslur)
- if (btest(ipl(ivx,ip),31))
-c
-c Starting slur on W-grace on THIS note. Record ndxslur.
-c
- * listslur = ibset(listslur,ndxslur)
- end if
- end if
-c
-c Process dynamic marks
-c
- if (btest(irest(ivx,ip),26)) then
- call dodyn(ivx,ip,
- * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip),
- * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq,
- * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout)
- end if
-c
-c Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st.
-c
- if (btest(ipl(ivx,ip),10)) then
-c
-c Need a duration to set type of note head
-c
-c Clumsy test, but vxtup is not set until main note is processed.
-c
- if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then
- nodu = nodur(ivx,ip)
- else if (btest(irest(ivx,ip),2) .or.
- * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then
-c
-c In a 2-note tremolo
-c
- if (btest(irest(ivx,ip),2)) then
-c
-c First note of tremolo, duration is on next note
-c
- nodu = nodur(ivx,ip+1)
- else
- nodu = nodur(ivx,ip)
- end if
- else if (iand(mult(ivx,ip),15)-8 .lt. 0) then
- nodu = 32
- else
- nodu = 16
- end if
- call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout,
- * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv,
- * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen,
- * btest(nacc(ivx,ip),27),nacc(ivx,ip),
- * irest)
- end if
-c
-c Now that chords are done, add stuff to midi file
-c
- if (ismidi) call addmidi(icm,
-c 130316
- * nolev(ivx,ip)+miditran(instno(iv)),
- * iand(nacc(ivx,ip),7),midisig,
- * tnote(ipl2(ivx,ip)),
- * btest(irest(ivx,ip),0),.false.)
-c
-c Check for breath or caesura
-c
- if (btest(iornq(ivx,ip),28)) then
- call putcb(ivx,ip,notexq,lnote)
- call addstr(notexq,lnote,soutq,lsout)
- end if
-c
-c Check for main-note ornaments. ')' on dotted notes go in with note, not here.
-c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F
-c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD
-c
-c isacc = iand(iornq(ivx,ip),4194287) .gt. 0
-c isacc = iand(iornq(ivx,ip),541065199) .gt. 0
- isacc = iand(iornq(ivx,ip),1614807023) .gt. 0
-c
-c isacc=.true. if any ornament except segno
-c
- if (btest(iornq(ivx,ip),13) .and. nodur(ivx,ip).gt.0) then
-c
-c If ). is only ornament, bypass. If with others, temporarirly zero the bit.
-c
- if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
- if (iand(iornq(ivx,ip),516079) .eq. 0) then
-c
-c ). is the only non-segno ornament
-c
- isacc = .false.
- else
-c
-c There are other ornaments in addition
-c
- rpndot = .true.
- iornq(ivx,ip) = ibclr(iornq(ivx,ip),13)
- end if
- end if
- end if
- if (isacc .and. .not.cwrferm(ivx)) then
-c
-c Check for centered whole-bar rest with fermata (bits 10 or 14).
-c
- if (iand(iornq(ivx,ip),17408).gt.0
- * .and. btest(irest(ivx,ip),0) .and.
- * nodur(ivx,ip).eq.lenbar .and.
- * .not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)) then
- cwrferm(ivx) = .true.
- go to 30
- end if
- call putorn(iornq(ivx,ip),nolev(ivx,ip),nolev(ivx,ip),
- * nodur(ivx,ip),nornb,ulq,ibmcnt(ivx),ivx,ncmid(iv,ip),
- * islur(ivx,ip),nvmx(iv),nv,ihornb,stemlen,
- * notexq,lnote,ip,islhgt,beamon(ivx),
- * btest(ipl(ivx,ip),10))
- call addstr(notexq,lnote,soutq,lsout)
- end if
- if (rpndot) then
- iornq(ivx,ip) = ibset(iornq(ivx,ip),13)
- rpndot = .false.
- end if
-30 continue
-c
-c Check for main note accidental
-c
- if (iand(nacc(ivx,ip),3).gt.0 .and.
- * .not.btest(nacc(ivx,ip),17)) then
- ihshft = igetbits(nacc(ivx,ip),7,10)
- if (ihshft .ne. 0) ihshft=ihshft-107
- if (.not.btest(ipl(ivx,ip),10) .and. btest(ipl(ivx,ip),8))
-c
-c Not a chord, and left-shifted main note, so left-shift accid
-c
- * ihshft = ihshft-20
- call doacc(ihshft,igetbits(nacc(ivx,ip),6,4),
- * notexq,lnote,nacc(ivx,ip),nolev(ivx,ip),ncmid(iv,ip),
- * btest(irest(ivx,ip),31))
- call addstr(notexq,lnote,soutq,lsout)
- end if
-c
-c Lower dot for lower-voice notes. Conditions are:
-c 1. Dotted time value
-c 2. Lower voice of two
-c 3. Note is on a line
-c 4. Not a rest
-c. 5. Flag (lowdot) is set to true
-c 6. Not in an xtuplet
-c
- if (lowdot .and. nvmx(iv).eq.2 .and. ivx.le.nv
- * .and. nodur(ivx,ip).ne.0) then
- if (.not.btest(irest(ivx,ip),0) .and.
- * 2**log2(nodur(ivx,ip)).ne.nodur(ivx,ip) .and.
- * mod(nolev(ivx,ip)-ncmid(ivx,ip),2).eq.0) then
- if (btest(irest(ivx,ip),19)) then
-c
-c Note already in movdot list. Drop by 2.
-c
- updot(ivx,ndotmv(ivx)+1) =
- * updot(ivx,ndotmv(ivx)+1)-2.
- else
-c
-c Not in list so just move it right now
-c
- call dotmov(-2.,0.,soutq,lsout,
- * igetbits(islur(ivx,ip),1,3))
- end if
- end if
- end if
-c
-c Check for dotted main notes with moved dots. Chord notes done elsewhere.
-c Added check rules out special chordal 2nds, but later must check
-c substituted chord note for dot shift that now applies to main note.
-c
- if (btest(irest(ivx,ip),19)) then
- ndotmv(ivx) = ndotmv(ivx)+1
- call dotmov(updot(ivx,ndotmv(ivx)),rtdot(ivx,ndotmv(ivx)),
- * soutq,lsout,igetbits(islur(ivx,ip),1,3))
- end if
-c
-c Stemlength changes
-c
- if (btest(mult(ivx,ip),27)) then
- dstemlen = igetbits(mult(ivx,ip),6,10)*.5-4.
- call addstr(sq//'stdstemfalse',13,soutq,lsout)
- stemshort = 4.66+.667*dstemlen
- call addstr(sq//'stemlength{',12,soutq,lsout)
- write(notexq,'(f4.1)')stemshort
- call addstr(notexq(1:4)//'}',5,soutq,lsout)
- else if (ip .gt. 1) then
- if (btest(mult(ivx,ip-1),27))
-c
-c Cancel shortening. Looks like it gets automatically restored if new inst. or
-c new line, so no need to worry about affecting other lines
-c
- * call addstr(sq//'stemlength{4.66}',17,soutq,lsout)
- end if
-c
-c Zero out slur-height marker for raising ornaments
-c
- islhgt = 0
-c
-c Now start with spacing notes. Is a beam start pending?
-c
- if (bspend .and.
- * ibm2(ivx,ibmcnt(ivx)).gt.ibm1(ivx,ibmcnt(ivx))) then
- if (ixrest(ivx) .eq. 4) then
-c
-c Special path for single note at end of otherwise beamed xtup
-c
- ixrest(ivx) = 0
- else
- if (kbdrests .and. btest(irest(ivx,ip),0) .and.
- * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
- * nolev(ivx,ip).le.50)
- * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
- * mult,ipl)
- if (btest(islur(ivx,ip),29)
- * .and.btest(irest(ivx,ip),24)) then
- notexq = chax(92)//'sk'
- lnote = 3
- else
- call beamn1(notexq,lnote)
-c if (isbjmp .and.
- if (isbjmp .and. ivbj2.ne.0 .and.
- * iand(mult(ivx,ip),15)-8 .gt. multbj1) then
-c
-c Need to increase multiplicity at the beam jump
-c
-c ibmcnt was increased by 1 at the end of first seg of jump beam!?
-c Try adding e.g. \nbbu1 if needed to increase multiplicity. Add
-c character in reverse order to start of notexq.
-c
- if (ivbj1 .lt. 9) then
- notexq = char(48+ivbj1)//notexq(1:lnote)
- lnote = lnote+1
- else
- notexq = '{1'//char(38+ivbj1)//'}'
- * //notexq(1:lnote)
- lnote = lnote+4
- end if
- notexq = 'bb'//ulq(ivbj1,ibmcnt(ivbj1)-1)
- * //notexq(1:lnote)
- lnote = lnote+3
- if (iand(15,mult(ivx,ip))-8 .eq. 3) then
- notexq = 'b'//notexq(1:lnote)
- lnote = lnote+1
- end if
- notexq = sq//'n'//notexq(1:lnote)
- lnote = lnote+2
- end if
- end if
- end if
- bspend = .false.
-c
-c Is a beam ending?
-c
- else if (numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
- * .and. (ibm2(ivx,ibmcnt(ivx)).eq.ip .or.
- * btest(nacc(ivx,ip),20))) then
- if (bspend) then
-c
-c Must be a single-note ending of a jump-beam
-c
- bspend = .false.
- end if
- call beamend(notexq,lnote)
- if (isbjmp .and. ivx.eq.ivbj1) then
-c
-c Jump beam segment is ending, check if multiplicity DECREASES
-c
- if (space(ib+1) .gt. space(ib)) then
-c
-c Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8.
-c
- if (ivx .lt. 10) then
- ivxq = char(ivx+48)
- livx = 1
- else
- ivxq = '{1'//char(ivx-10)//'}'
- livx = 4
- end if
-c Changes to get staffcrossall.pmx to work. Not clear how.
-c if (nint(space(ib+1)-space(ib)) .eq. 6) then
- if (space(ib+1).eq.8..and.space(ib).eq.2.) then
- notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))//
- * ivxq(1:livx)//sq//'tbb'//
- * ulq(ivx,ibmcnt(ivx))//ivxq(1:livx)//notexq(1:lnote)
- lnote = lnote+11+2*livx
-c else if (nint(space(ib+1)-space(ib)) .eq. 4) then
- else if (space(ib+1).eq.8..and.space(ib).eq.4.) then
- notexq = sq//'tbb'//ulq(ivx,ibmcnt(ivx))//
- * ivxq(1:livx)//notexq(1:lnote)
- lnote = lnote+5+livx
-c else
- else if (space(ib+1).eq.4..and.space(ib).eq.2.) then
- notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))//
- * ivxq(1:livx)//notexq(1:lnote)
- lnote = lnote+6+livx
- end if
- end if
- end if
- if (.not.btest(nacc(ivx,ip),20)) then
- vxtup(ivx) = .false.
- nornb(ivx) = 0
- ibmcnt(ivx) = ibmcnt(ivx)+1
- beamon(ivx) = .false.
- end if
-c
-c Or if we're in the middle of a beam
-c
- else if (numbms(ivx).gt.0 .and. beamon(ivx)) then
-c
-c Added 130127
-c
- if (kbdrests .and. btest(irest(ivx,ip),0) .and.
- * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
- * nolev(ivx,ip).le.50)
- * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
- * mult,ipl)
- call beamid(notexq,lnote)
-c
-c Or whole-bar rest
-c
- else if (btest(irest(ivx,ip),0)
- * .and. nodur(ivx,ip).eq.lenbar
- * .and..not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)
- * .and..not.btest(irest(ivx,ip),25)
- * .and..not.btest(islur(ivx,ip),29)) then
-c
-c Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp
-c
- cwrest(ivx) = .true.
- iscwr = .true.
- call notex(cwrq(ivx),lcwr(ivx))
- tnow = tnow+lenbar
- go to 10
- else if (ixrest(ivx) .eq. 0) then
-c
-c Before writing note or rest, check for keyboard rest height adjustment.
-c Conditions are 0. This is a non-blank rest
-c 1. kbdrests = .true.
-c 2. There are two voices on the staff
-c 3. No user-def height adjustments have been applied (nolev<50)
-c
- if (kbdrests .and. btest(irest(ivx,ip),0) .and.
- * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
- * nolev(ivx,ip).le.50) then
- call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
- * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr,
- * mult,ipl)
- end if
- if (btest(ipl(ivx,ip),4)) then
-c
-c Deal with single stem tremolo
-c Get up-downness, borrowed from notex
-c
- if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
- * nvmx(iv),ivx,nv).eq.'u') then
- udq = 'u'
- else
- udq = 'l'
- end if
- multtrem = igetbits(ipl(ivx,ip),2,5)+1
- if (nodur(ivx,ip) .lt. 64) then
- notexq = sq//'tr'
- else
- notexq = sq//'Tr'
- end if
- lnote = 3
- if (multtrem .eq. 2) then
- notexq = notexq(1:3)//'r'
- lnote = 4
- else if (multtrem .eq.3) then
- notexq = notexq(1:3)//'rr'
- lnote = 5
- end if
-c
-c Get a numerical pitch argument
-c
- lineno = nolev(ivx,ip)-ncmid(iv,ip)+4
- if (lineno .lt.0 .or. lineno .gt.9) then
- write(noteq,'(a1,i2,a1)')'{',lineno,'}'
- lnoten = 4
- else
- noteq = char(lineno+48)
- lnoten = 1
- end if
- notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten)
- lnote = lnote+2+lnoten
- call addstr(notexq,lnote,soutq,lsout)
- end if
-c
-c Get code for a separate note or rest
-c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note),
-c pitch will be shifted +/-1 inside notex.
-c
- call notex(notexq,lnote)
- end if
-c
-c Right offset? This may cause trouble
-c
- if (btest(ipl(ivx,ip),8)) then
- call addstr(sq//'loff{',6,soutq,lsout)
- else if (btest(ipl(ivx,ip),9)) then
- call addstr(sq//'roff{',6,soutq,lsout)
- end if
- if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then
- call addstr(notexq,lnote,soutq,lsout)
- end if
- if (btest(ipl(ivx,ip),8) .or.
- * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
-c
-c Terminate user-defined offsets. Fix format
-c
- if (btest(irest(ivx,ip),15) .or. btest(irest(ivx,ip),17))
- * call putshft(ivx,.false.,soutq,lsout)
-c
-c Deal with After- and Way-after-graces. First, if end of bar, compute space
-c needed since it wasn't done during general ask-checks. If extra space is
-c rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp.
-c But will still need to add extra space as hardspace.
-c
- if (ip.eq.nn(ivx) .and. (btest(ipl(ivx,ip),31).or.
- * btest(ipl(ivx,ip),29))) then
- do 77 ig = 1 , ngrace
- if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 78
-77 continue
- print*,'Problem finding grace index at "do 77"'
- call stop1()
-78 continue
-c
-c Get elemskip to end of bar. WON'T WORK IF XTUPS !!
-c
- esk = 0.
- do 40 iib = ib , nb
- if (iib .eq. ib) then
- itleft = nint(to(ipl2(ivx,ip)))
- else
- itleft = nint(tstart(ib))
- end if
- if (iib .lt. nb) then
- itright = nint(tstart(iib+1))
- else
- itright = lenbar
- end if
- esk = esk+feon(space(ib))*
- * (itright-itleft)/space(ib)
-40 continue
- ptsavail = poenom*esk-wheadpt
- if (nng(ig) .eq. 1) then
- wgr = grafac
- else
- wgr = nng(ig)*emgfac
- do 41 ing = 1 , nng(ig)
- if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
-41 continue
- end if
- ptgr(ig) = wgr*wheadpt
- ptsneed = (wgr+0.5)*wheadpt
- ptsndg(ivx) = 0.
- if (ptsavail .lt. ptsneed) then
- ptsndg(ivx) = ptsneed
- eskndg(ivx) = esk
- if (btest(ipl(ivx,ip),31)) then
-c
-c Convert GW to GA
-c
- ipl(ivx,ip) = ibset(ibclr(ipl(ivx,ip),31),29)
- end if
- end if
- end if
-c
-c Check for GA
-c
- if (btest(ipl(ivx,ip),29))
- * call dograce(ivx,ip,ptgr,soutq,lsout,ncmid(iv,ip),
- * nacc(ivx,ip),ig,ipl(ivx,ip),.false.,
-c 130324
-c * .false.,0,0,0,0,0,0,0.,ulq)
- * .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
-c
-c Update running time
-c
- tnow = tnow+space(ib)
-10 continue
-c
-c Have finished last note in this voice and block
-c
- itendb = nint(to(istop(ib))+space(ib))
- if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
- ivf = 1
- if (ivx .gt. 1) ivf = 2
-17 if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.itendb) then
-c
-c There's at least one figure left. offnsk could be <0
-c
- offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
- call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,lsout)
- go to 17
- end if
- end if
-c
-c Check for flag, dot, or upstem on last note of bar.
-c
- if (ib .eq. nb) then
- ip = ipo(ipl2(ivx,nn(ivx)))
- flgndv(ivx) = 0.
- if (abs(tnote(ipl2(ivx,ip))-space(ib)).lt.tol) then
- if (space(ib) .lt. 16.-tol) then
-c
-c Note in last space, smaller than a quarter note.
-c
- if ((.not.btest(irest(ivx,ip),0) .and.
- * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
- * nvmx(iv),ivx,nv).eq.'u')
- * .or. isdotted(nodur,ivx,ip)) then
-c
-c Upstem non-rest, or dotted
-c
- if (numbms(ivx).gt.0
- * .and. ip.eq.ibm2(ivx,max(1,numbms(ivx)))
- * .and. .not.isdotted(nodur,ivx,ip))
- * then
-c
-c In beam and not dotted, so use smaller space
-c
- flgndv(ivx) = upstmfac
- else
- flgndv(ivx) = flagfac
- end if
- end if
- else
-c
-c Last space, nonflagged (no beam) only worry dot or up
-c
- if (isdotted(nodur,ivx,ip)) then
- flgndv(ivx) = flagfac
- else if (tnote(ipl2(ivx,ip)).lt.64 .and.
- * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
- * nvmx(iv),ivx,nv).eq.'u') then
-c
-c Upstem on last note , non-flagged
-c
- flgndv(ivx) = upstmfac
- end if
- end if
- end if
-c
-c Check for right-shifted chordal note
-c
- if (btest(irest(ivx,ip),20)) flgndv(ivx) = rtshfac
- flgndb = flgndb .or. flgndv(ivx).gt.0.
- if (ismidi) then
-c
-c For midi, set flags for accidentals on last note of bar. Assume they affect
-c first note of next bar whether or not tied.
-c Note has already been done, so next entry into addmidi is 1st in new bar.
-c First do main note, then chord notes
-c
-c Gyrations needed to account for multi-bar tied full-bar notes?
-cc Old old lbacc(icm) = iand(nacc(ivx,ip),7)
-c New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7)
-c
- if (iand(nacc(ivx,ip),7) .gt. 0) then
-c
-c Explicit accidental on last main note in bar
-c
- do 55 kacc = 1 , naccbl(icm)
- if (laccbl(icm,kacc) .eq. nolev(ivx,ip)) go to 56
-55 continue
- naccbl(icm) = naccbl(icm)+1
- laccbl(icm,naccbl(icm)) = nolev(ivx,ip)
- jaccbl(icm,naccbl(icm)) = iashft(iand(nacc(ivx,ip),7))
- end if
-56 continue
- if (btest(ipl(ivx,ip),10) .and. crdacc) then
- do 57 icrd = icrd1 , icrd2
- iacc = igetbits(icrdat(icrd),3,20)
- if (iacc .gt. 0) then
-c
-c Explicit accidental on chord note at end of bar
-c
- nolevc = igetbits(icrdat(icrd),7,12)
- do 58 kacc = 1 , naccbl(icm)
- if (laccbl(icm,kacc) .eq. nolevc) go to 59
-58 continue
- naccbl(icm) = naccbl(icm)+1
- laccbl(icm,naccbl(icm)) = nolevc
- jaccbl(icm,naccbl(icm)) = iashft(iacc)
- end if
-59 continue
-57 continue
- end if
-c if (lbacc(icm).eq.0 .and. accb4(icm)) then
- do 65 kacc = 1 , naccim(icm)
-c
-c If naccim(icm)>0,
-c possible implicit accidental from earlier in the bar. Check for prior accid
-c in this bar at relevant note levels, main and chord notes. Only act if no
-c explicit action from just above. Assuming any accid on last note in bar,
-c either explicit or implicit, has same effect on 1st note of next bar.
-c
- if (nolev(ivx,ip) .eq. laccim(icm,kacc)) go to 66
- if (btest(ipl(ivx,ip),10)) then
- do 67 icrd = icrd1 , icrd2
- if (iand(ishft(icrdat(icrd),-12),127) .eq.
- * laccim(icm,kacc)) go to 66
-67 continue
- end if
- go to 65
-66 continue
-c
-c So far we know there is a main or chord note at level laccim(icm,kacc). So
-c it will get a bl-accid if it didn't just already get one.
-c
- do 68 macc = 1 , naccbl(icm)
- if (laccbl(icm,macc) .eq. laccim(icm,kacc)) go to 65
-68 continue
- naccbl(icm) = naccbl(icm)+1
- laccbl(icm,naccbl(icm)) = laccim(icm,kacc)
- jaccbl(icm,naccbl(icm)) = jaccim(icm,kacc)
-65 continue
- end if
- end if
-11 continue
-c
-c Close out the notes group
-c
- call addstr(sq//'en',3,soutq,lsout)
- if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%'
-16 continue
-c
-c Check for way-after graces at end of bar. We could not link these to notes
-c as in midbar since there is no note following grace! Also, set flag if
-c hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop.
-c
- isgrace = .false.
- do 75 iv = 1 , nv
- nvmxsav(iv) = nvmx(iv)
- do 75 kv = 1 , nvmx(iv)
- ivmxsav(iv,kv) = ivmx(iv,kv)
- ivx = ivmx(iv,kv)
- ptsgnd = 0.
- if ((btest(ipl(ivx,nn(ivx)),29).or.btest(ipl(ivx,nn(ivx)),31))
- * .and. ptsndg(ivx).gt.0.) then
- flgndb = .true.
- if (ptsndg(ivx) .gt. ptsgnd) then
- ptsgnd = ptsndg(ivx)
- eskgnd = eskndg(ivx)
- end if
- end if
- if (btest(ipl(ivx,nn(ivx)),31)) then
-c
-c This voice has a way-after grace here at end of bar
-c
- if (.not.isgrace) then
-c
-c This is the first one, so set up the string
-c
- isgrace = .true.
- ivlast = 1
- soutq = sq//'znotes'
- lsout = 7
- end if
- do 76 iiv = ivlast , iv-1
- call addstr(sepsymq(iiv),1,soutq,lsout)
-76 continue
- ivlast = iv
-c
-c No need to put in 'nextvoice', even if 2 lines/staff
-c
- call dograce(ivx,nn(ivx),ptgr,soutq,lsout,ncmid(iv,nn(ivx)),
- * nacc(ivx,nn(ivx)),ig,ipl(ivx,nn(ivx)),.true.,
-c 130324
-c * .false.,0,0,0,0,0,0,0.,ulq)
- * .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
- end if
-75 continue
- if (isgrace) then
- call addstr(sq//'en%',4,soutq,lsout)
- if (islast .and. lsout .gt. 0) write(11,'(a)')soutq(1:lsout)
- end if
- lsout = 0
-c
-c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest
-c This has to be the only use of atnextbar
-c
- if (ibar.eq.ibarmbr .and. islast) then
- if (newmbrhgt) then
- soutq = sq//'def'//sq//'mbrhgt{'
- if (mbrhgt .le. -10) then
- write(soutq(13:15),'(i3)')mbrhgt
- lsout = 15
- else if (mbrhgt.ge.10.or.mbrhgt.le.-1) then
- write(soutq(13:14),'(i2)')mbrhgt
- lsout = 14
- else
- soutq = soutq(1:12)//char(48+mbrhgt)
- lsout = 13
- end if
- soutq = soutq(1:lsout)//'}%'
- write(11,'(a)')soutq(1:lsout+2)
- newmbrhgt = .false.
- end if
- soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes'
- lsout = 22
- notexq = sq//'mbrest'
- lnote = 7
- call istring(mbrest,noteq,len)
- notexq = notexq(1:lnote)//noteq(1:len)
- lnote = lnote+len
- mtrspc = nint(xb4mbr)
- xb4mbr = 0.
- call istring(mtrspc,noteq,len)
- notexq = notexq(1:lnote)//noteq(1:len)//'0'
- lnote = lnote+len+1
- do 62 iv = 1 , nv
- call addstr(notexq,lnote,soutq,lsout)
- if (iv .lt. nv) call addstr(sepsymq(iv),1,soutq,lsout)
-62 continue
- call addstr(sq//'en}%',5,soutq,lsout)
- write(11,'(a)')soutq(1:lsout)
- lsout = 0
- if (ishort .gt. 0) then
- mbrsum = mbrsum+mbrest
- nmbr = nmbr+1
- end if
- if (mbrest .gt. 1) then
- ndig = int(alog10(mbrest-1+.01))+1
- write(11,'(a14,i'//chax(48+ndig)//',a1)')
- * sq//'advance'//sq//'barno',mbrest-1,'%'
- end if
- else if (iscwr) then
-c
-c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar
-c to check for new clef and add space by redefining \CenterBar
-c
- centrests = .true.
- call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout)
- call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22,
- * soutq,lsout)
- do 60 iv = 1 , nv
-c added
- lnote = 0
-c
- do 61 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- if (cwrest(ivx)) then
- call addstr(sq//'CenterBar{',11,soutq,lsout)
- if (.not.cwrferm(ivx)) then
- if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then
-c
-c Kluge to use new definitions for centered, stacked rests
-c
- if (cwrq(ivx)(2:10).eq.'liftpause' .or.
- * cwrq(ivx)(2:10).eq.'liftPAuse')
- * cwrq(ivx)(10:10) = 'c'
- end if
- call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq,
- * lsout)
- call addstr('}{-2}{'//sq//'value}',13,soutq,lsout)
- else
-c
-c Fermata on centered rest. Will need to fix up level.
-c 12/6/07 shift it left so it's centered over rest
-c
- notexq = notexq(1:lnote)//sq//'loffset{.33}{'
- * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx))
- * //'}{-2}{'//sq//'value}'
- lnote = lnote+26+lcwr(ivx)+13
- call addstr(notexq,lnote,soutq,lsout)
- cwrferm(ivx) = .false.
- end if
- end if
-61 continue
- if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout)
-60 continue
- if (islast) then
- call addstr(sq//'en}%',5,soutq,lsout)
- if (lsout.gt.0)write(11,'(a)')soutq(1:lsout)
- end if
- end if
-c
-c End of block for centered whole-bar rests and multi-bar rests
-c
-c If at end of block, save durations of last notes in bar, for possible use
-c if clef changes at start of next bar
-c
- if (ibar .eq. nbars) then
- do 63 iv = 1 , nv
- do 63 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- prevtn(ivx) = tnote(ipl2(ivx,nn(ivx)))
-63 continue
- end if
-c
-c Update time for midi. This is only used for the event track
-c
- if (ismidi) then
- miditime = miditime+15*lenbar
-c
-c If pickup, write the real time signature to the event track. Cannot use
-c mtrnuml since it was reset to 0, have to recompute it
-c
- if (lenb0 .eq. lenbar)
- * call midievent('m',mtrdenl*lenb1/64,mtrdenl)
- end if
- return
- end
- subroutine makeabar()
-c
-c On input, have pseudo-durations in nodur(ivx,ip). Not real durations for
-c xtups, since only last note of xtup gets non-zero nodur, which
-c corresponds to single note of full length of xtup.
-c In this subroutine we make an ordered list of all notes in all voices.
-c ilnc = list note counter
-c ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note.
-c to(ilnc) = real start time of note in PMX-units (64=whole note)
-c tno(ilnc) = time to next event in the bar.
-c tnote(ilnc) = actual duration of note
-c Then run thru list, grouping consecutive notes into \notes groups ib.
-c space(ib) = real time unit for the \notes group
-c squez(ib) = factor on space to get effective space. This will be 1 if
-c there is a note exactly spanning each interval of space, and
-c <1 if not.
-c Details: let eon = elemskips per noteskip (like length). Basic formula is
-c eon = sqrt(space/2.)
-c If tgovern >= space, then
-c eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern).
-c Time needed to give this eon using basic formula is
-c teq = space**2/tgovern
-c Factor on space to get teq is
-c squez(ib) = space/tgovern
-c The eon for each ib can then be computed based on time of space*squez.
-c Iff squez = 1, there is a note spanning every increment in the \notes group.
-c
-c tnminb = minimum time span in the bar for increments spanned by notes,
-c i.e., with squez=1. Use after parsing into line to decide if
-c spacing needs to be "flattened" among notes groups.
-c
- common /comtol/ tol
- parameter (nm=24,nkb=3999,maxblks=9600)
- common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
- * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
- * nbars,itsofar(nm),nib(nm,15),nn(nm),
- * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
- common /linecom/ elskb,tnminb(nkb)
- common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
- * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
- * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
- common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
-c logical rest,firstline,newmeter,gotclef
- logical rest,firstline,newmeter
- integer cnn(nm),istart(80),istop(80)
- real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600)
- elskb = 0.
- tnminb(ibarcnt) = 1000.
- do 1 iv = 1 , nv
- do 1 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- if (ibar .gt. 1) then
- nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
- else
- nn(ivx) = nib(ivx,ibar)
- end if
-1 continue
-c
-c initialize list note counter, time(iv), curr. note(iv)
-c
- ilnc = 1
- do 4 iv = 1 , nv
- do 4 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- cnn(ivx) = 1
- ivxo(ilnc) = ivx
- ipo(ilnc) = 1
- to(ilnc) = 0.
- tnote(ilnc) = fnote(nodur,ivx,1,nacc)
- xit(ivx) = tnote(ilnc)
- if (abs(xit(ivx)-lenbar).lt.tol) xit(ivx) = 1000.
- ilnc = ilnc+1
-4 continue
-c
-c Build the list
-c
-5 continue
-c
-c Determine which voice comes next from end of notes done so far.
-c tmin is the earliest ending time of notes done so far
-c
- tmin = 1000.
- do 6 iv = 1 , nv
- do 6 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- tminn = min(tmin,xit(ivx))
- if(tminn .lt. tmin) then
- tmin = tminn
- ivnext = ivx
- end if
-6 continue
- if (tmin .gt. 999.) go to 7
- ivxo(ilnc) = ivnext
- cnn(ivnext) = cnn(ivnext)+1
- ipo(ilnc) = cnn(ivnext)
- to(ilnc) = tmin
-c
-c Check if this voice is done
-c
- tnote(ilnc) = fnote(nodur,ivnext,cnn(ivnext),nacc)
- if (cnn(ivnext) .eq. nn(ivnext)) then
- xit(ivnext) = 1000.
- else
- xit(ivnext) = xit(ivnext)+tnote(ilnc)
- end if
- ilnc = ilnc+1
- go to 5
-7 continue
- ntot = ilnc-1
- if (ntot .gt. 600) then
- call printl(' ')
- call printl('Cannot have more than 600 notes per bar, stopping')
- call stop1()
- end if
- do 8 in = 1 , ntot-1
- tno(in) = to(in+1)-to(in)
-8 continue
- tno(ntot) = fnote(nodur,ivxo(ntot),ipo(ntot),nacc)
- tnote(ntot) = tno(ntot)
-c
-c Debug writes
-c
-c write(*,'()')
-c write(*,'(16i5)')(ivxo(in),in=1,ntot)
-c write(*,'(16i5)')(ipo(in),in=1,ntot)
-c write(*,'(16f5.1)')(to(in),in=1,ntot)
-c write(*,'(16f5.1)')(tno(in),in=1,ntot)
-c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
-c write(*,'(16f5.1)')(tnote(in),in=1,ntot)
-c
-c Done w/ list. Initialize loop for building note blocks:
-c
- ib = 1
- istart(1) = 1
- space(1) = 0.
- in = 1
-c
-c Start the loop
-c
-9 continue
- if (in .eq. ntot) then
- if (space(ib) .lt. tol) then
- space(ib) = tno(in)
-c
-c Last gap in bar is spanned by a note, so cannot need a squeeze.
-c
- squez(ib) = 1.
- end if
- istop(ib) = ntot
-c
-c From here flow out of this if block and into block-setup
-c
- else if (space(ib) .lt. tol) then
-c
-c space hasn't been set yet, so tentatively set:
-c
- space(ib) = tno(in)
- if (space(ib) .lt. tol) then
- in=in+1
- else
-c
-c Tentative space tno(in) is non-zero. Set squez, which will be kept (since
-c it is a unique property of the particular increment starting here) :
-c
- squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
- istop(ib) = in
- end if
- go to 9
- else if (tno(in+1) .lt. tol) then
-c
-c This is not the last note in the space, so
-c
- in = in+1
- go to 9
- else if (abs(tno(in+1)-space(ib)) .lt. tol) then
-c
-c Next increment has same space. Does it have same squez?
-c
- xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
-c
-c If it does have the same squez, loop, otherwise flow out
-c
- if (abs(xsquez-squez(ib)) .lt. tol) then
-c
-c Keep spacing the same, update tentative stop point
-c
- in = in+1
- istop(ib) = in
- go to 9
- end if
- end if
-c
-c At this point istart, istop, space, and squez are good, so close out block
-c
- tstart(ib) = to(istart(ib))
-c
-c Compute elemskips assuming no flattening to increase min space. The formula
-c is only correct if f1eon(t) = sqrt(t/2); more generally (after possible
-c flattening in pmxb), elsperns = squez*feon(space/squez)
-c
- elsperns = f1eon(space(ib)*squez(ib))
- if (istop(ib) .eq. ntot) then
- nnsk = nint((lenbar-tstart(ib))/space(ib))
- else
- nnsk = nint((to(istop(ib)+1)-tstart(ib))/space(ib))
- end if
- elskb = elskb+elsperns*nnsk
- if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then
- call catspace(space(ib),squez(ib),nnsk)
- else
-c
-c This is the first entry for this bar
-c
- nnpd(nptr(ibarcnt)) = nnsk
- durb(nptr(ibarcnt)) = space(ib)
- sqzb(nptr(ibarcnt)) = squez(ib)
- nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
- end if
-c
-c Update minimum space spanned by a note
-c
- if (abs(squez(ib)-1) .lt. tol)
- * tnminb(ibarcnt) = min(tnminb(ibarcnt),space(ib))
- if (istop(ib) .eq. ntot) go to 15
-c
-c End of spatial accounting for now
-c
- ib = ib+1
- istart(ib) = istop(ib-1)+1
- in = istart(ib)
-c
-c Set tentative block space for new block
-c
- space(ib) = tno(in)
- if (space(ib).gt.tol)
- * squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
- istop(ib) = in
- go to 9
-15 continue
-c nb = ib
-c
-c Debug writes
-c
-c write(*,'(16i5)')(istart(ib),ib=1,nb)
-c write(*,'(16i5)')(istop(ib),ib=1,nb)
-c write(*,'(16f5.1)')(space(ib),ib=1,nb)
-c write(*,'(16f5.1)')(squez(ib),ib=1,nb)
-c
- return
- end
- subroutine midievent(typeq,in1,in2)
-c
-c We now store "conductor" events in mmidi(numchan,.), and count bytes
-c with imidi(numchan)
-c
- parameter (nm=24,mv=24576)
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /comevent/ miditime,lasttime
- character*1 typeq
- idur = isetvarlen(miditime-lasttime,nbytes)
- imidi(numchan) = imidi(numchan)+nbytes+1
- do 1 i = 1 , nbytes
- mmidi(numchan,imidi(numchan)-i) = mod(idur,256)
- idur = ishft(idur,-8)
-1 continue
- mmidi(numchan,imidi(numchan)) = 255
- if (typeq .eq. 't') then
-c
-c Tempo event. in1 = quarters per minute (integer)
-c
- mmidi(numchan,imidi(numchan)+1) = 5*16+1
- mmidi(numchan,imidi(numchan)+2) = 3
- misperq = nint(60000000./in1)
- do 2 i = 1 , 3
- mmidi(numchan,imidi(numchan)+6-i) = mod(misperq,256)
- misperq = ishft(misperq,-8)
-2 continue
- imidi(numchan) = imidi(numchan)+5
- else if (typeq .eq. 'm') then
-c
-c Meter event. in1=numerator, in2=denom (power of 2)
-c
- mmidi(numchan,imidi(numchan)+1) = 5*16+8
- mmidi(numchan,imidi(numchan)+2) = 4
- mmidi(numchan,imidi(numchan)+3) = in1
- if (in2 .gt. 0) then
- mmidi(numchan,imidi(numchan)+4) = log2(in2)
- else
- mmidi(numchan,imidi(numchan)+4) = 0
- end if
- mmidi(numchan,imidi(numchan)+5) = 24
- mmidi(numchan,imidi(numchan)+6) = 8
- imidi(numchan) = imidi(numchan)+6
- else if (typeq .eq. 'k') then
-c
-c Keychange event. in1 = isig
-c
- mmidi(numchan,imidi(numchan)+1) = 5*16+9
- mmidi(numchan,imidi(numchan)+2) = 2
- mmidi(numchan,imidi(numchan)+3) = mod(256+in1,256)
- mmidi(numchan,imidi(numchan)+4) = 0
- imidi(numchan) = imidi(numchan)+4
- else
- print*,'Program flameout in midievent'
- call stop1()
- end if
- lasttime = miditime
- return
- end
- subroutine moveln(iuin,iuout,done)
- logical done
- character*129 outq
- done = .false.
- read(iuin,'(a)',end=1) outq
- lenout = llen(outq,129)
- write(iuout,'(a)') outq(1:lenout)
- return
-1 done = .true.
- return
- end
- subroutine mrec1(lineq,iccount,ndxm)
-c
-c This is called when (a) macro recording is just starting and
-c (b) at the start of a new line, if recording is on
-c
- parameter (maxblks=9600)
- character*128 lineq,lnholdq
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- logical mrecord,mplay,endmac
- common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
- * ic1mac(20),ilmac,iplmac
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- if (.not.mrecord) then
-c
-c Starting the macro
-c
- ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
- il1mac(macnum) = ilbuf-1
- ic1mac(macnum) = iccount
- mrecord = .true.
- end if
- if (iccount .lt. 128) then
- ndxm = index(lineq(iccount+1:128),'M')
- if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
- * 128-iccount)
- if (ndxm .gt. 0) then
-c
-c This line ends the macro.
-c
- ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
- il2mac(macnum) = ilbuf-1
- mrecord = .false.
- end if
- end if
- return
- end
- function ncmid(iv,ip)
- parameter (nm=24)
- common /all/ mult(nm,200),jv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtol/ tol
- if (ncc(iv) .eq. 1) then
- ncmid = ncmidcc(iv,1)
- else
- xtime = to(ipl2(ivx,ip))
- do 1 icc = ncc(iv) , 1 , -1
- if (xtime .gt. tcc(iv,icc)-tol) then
- ncmid = ncmidcc(iv,icc)
- return
- end if
-1 continue
- print*,'Problem in ncmid()'
- stop
- end if
- end
- function ncmidf(clefq)
-c
-c Return middle line of a clef
-c
- character*1 clefq
- if (clefq .eq. '8') then
-c
-c treblelowoct; will treat as treble for this purpose
-c
- ncmidf = 35
- else
- ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2
- end if
- return
- end
- subroutine newvoice(jv,clefq,change)
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- character*1 ulfbq,clefq
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- logical change,autofbon
- nvmx(jv) = 1
- ivmx(jv,1) = jv
- itsofar(jv) = 0
- nnl(jv) = 0
- nfb(jv) = 0
- if (firstgulp .or. change) then
- ncmidcc(jv,1) = ncmidf(clefq)
- else
- ncmidcc(jv,1) = ncmidcc(jv,ncc(jv))
- end if
- tcc(jv,1) = 0.
- ncc(jv) = 1
- nudoff(jv) = 0
- ndotmv(jv) = 0
- do 5 j = 1 , 200
- irest(jv,j) = 0
- islur(jv,j) = 0
- ipl(jv,j) = 0
- nacc(jv,j) = 0
- iornq(jv,j) = 0
- mult(jv,j) = 0
- if (jv.le.2) isfig(jv,j) = .false.
-5 continue
- return
- end
- subroutine notefq(noteq,lnote,nolev,ncmid)
-c
-c Returns name of note level with octave transpositions, updates noctup.
-c
- common /comoct/ noctup
- character*8 noteq
- character*1 upcaseq,noteqt,chax
- nupfroma = mod(nolev+1,7)
- iname = 97+nupfroma
- ioctup = (nolev+1)/7-4
- noteqt = chax(iname)
- if (ncmid .eq. 23) noteqt = upcaseq(noteqt)
- if (ioctup .eq. noctup) then
- noteq = noteqt
- lnote = 1
-c
-c Must ALWAYS check if lnote=1 for use with functions requiring a blank
-c
- else if (ioctup .gt. noctup) then
-c
-c Raise octave. Encase in {}
-c
- write(noteq,'(8a1)')'{',(chax(39),i=noctup,ioctup-1),
- * noteqt,'}'
- lnote = 3+ioctup-noctup
- noctup = ioctup
- else
-c
-c Lower octave
-c
- write(noteq,'(8a1)')'{',(chax(96),i=ioctup,noctup-1),
- * noteqt,'}'
- lnote = 3+noctup-ioctup
- noctup = ioctup
- end if
- return
- end
- subroutine notex(notexq,lnote)
-c
-c Returns non-beamed full note name
-c
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,
- * isfig,ispoi,btest,even
- character*1 udq,udqq,chax
- character*4 dotq
- character*2 numq
- character*79 notexq
- character*8 noteq
- character*40 restq
- common /compoi/ ispoi
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- character*10 figq
- ip = ipo(jn)
- nole = nolev(ivx,ip)
-c
-c Check for special situations with 2nds (see precrd)
-c
- if (btest(nacc(ivx,ip),30)) then
- nole = nole - 1
- else if (btest(nacc(ivx,ip),31)) then
- nole = nole + 1
- end if
- nodu = nodur(ivx,ip)
- if (.not.btest(irest(ivx,ip),0)) then
- udq = udqq(nole,ncmid(iv,ip),
- * islur(ivx,ip),nvmx(iv),ivx,nv)
- end if
-c
-c Check figure level
-c
-c if (figbass .and. isfig(ivx,ip)
-c * .and. .not.btest(irest(ivx,ip),0)) then
- if (figbass .and. .not.btest(irest(ivx,ip),0) .and.
- * ((ivx.eq.1.and.isfig(1,ip))
- * .or.(ivx.eq.ivxfig2.and.isfig(2,ip)))) then
- if (udq .eq. 'u' .or. nodu.ge.64) then
-c
-c Upper or no stem, fnole (in noleunits) set by notehead
-c
- fnole = nole
- else
-c
-c Lower stem, fnole set by bottom of stem
-c
- fnole = nole-stemlen
- end if
- zmin = fnole-ncmid(ivx,ip)+4
- if (ivx .eq. 1) then
- ifigdr(1,iline) = max(ifigdr(1,iline),nint(4-zmin))
- else
- ifigdr(2,iline) = max(ifigdr(2,iline),nint(4-zmin))
- end if
- end if
- if (.not.btest(irest(ivx,ip),0)) then
- call notefq(noteq,lnoten,nole,ncmid(iv,ip))
- if (lnoten .eq. 1) call addblank(noteq,lnoten)
- if (nodu .eq. 1) then
- notexq =sq//'cccc'//udq//noteq(1:lnoten)
- lnote = lnoten+6
- else if (nodu .eq. 2) then
- notexq =sq//'ccc'//udq//noteq(1:lnoten)
- lnote = lnoten+5
- else if (nodu .eq. 4) then
- notexq =sq//'cc'//udq//noteq(1:lnoten)
- lnote = lnoten+4
- else if (nodu .eq. 8) then
- notexq =sq//'c'//udq//noteq(1:lnoten)
- lnote = lnoten+3
- else if (nodu .eq. 16) then
- notexq =sq//'q'//udq//noteq(1:lnoten)
- lnote = lnoten+3
- else if (nodu .eq. 32) then
- notexq =sq//'h'//udq//noteq(1:lnoten)
- lnote = lnoten+3
- else if (nodu .eq. 64) then
- notexq =sq//'wh'//noteq(1:lnoten)
- lnote = lnoten+3
- else if (nodu .eq. 128) then
-c notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk'
-c lnote = lnoten+10
- notexq =sq//'breve'//noteq(1:lnoten)
- lnote = lnoten+6
- else
- dotq = 'p'
- ldot = 1
- if (btest(iornq(ivx,ip),13)) then
-c
-c Dotted note with ')' ornament
-c
- dotq='m'
- else if (btest(islur(ivx,ip),3)) then
-c
-c Double dot
-c
- dotq = 'pp'
- ldot = 2
- end if
- if (nodu .ge. 192) then
- notexq =sq//'breve'//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+6+ldot
- else if (nodu .ge. 96) then
- notexq =sq//'wh'//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+3+ldot
- else if (nodu .ge. 48) then
- notexq =sq//'h'//udq//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+3+ldot
- else if (nodu .ge. 24) then
- notexq =sq//'q'//udq//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+3+ldot
- else if (nodu .ge. 12) then
- notexq =sq//'c'//udq//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+3+ldot
- else if (nodu .ge. 6) then
- notexq =sq//'cc'//udq//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+4+ldot
- ispoi = .true.
- else
- notexq =sq//'ccc'//udq//dotq(1:ldot)//noteq(1:lnoten)
- lnote = lnoten+5+ldot
- ispoi = .true.
- end if
- if (dotq(1:1) .eq. 'm') then
-c
-c Need another call to the note, in case the first one has octave shifts
-c
- if (lnoten .eq. 2) then
- notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
- lnote = lnote+3
- else
- notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
- lnote = lnote+1
- end if
- end if
- end if
- else if (btest(islur(ivx,ip),29)) then
-c
-c Blank rest
-c
- notexq = sq//'sk'
- lnote = 3
- else
-c
-c Non-blank rest
-c
- lnote = 0
- nole = mod(nole+20,100)-20
-c
-c Kluge to get pause symbol for rp:
-c
- if (btest(islur(ivx,ip),19)) nodu = 64
- if (nodu .le. 28) then
-c
-c Normal rest < or = double-dotted quarter
-c
- lrest = 3
- if (nodu .gt. 14) then
- restq =sq//'qp'
- else if (nodu .gt. 7) then
- restq =sq//'ds'
- else if (nodu .gt. 3) then
- restq =sq//'qs'
- else if (nodu .gt. 1) then
- restq =sq//'hs'
- else
- restq =sq//'qqs'
- lrest = 4
- end if
-c
-c Special case for rest at start of F-tuplet inside a forced beam
-c
- if (btest(nacc(ivx,ip),18) .and.
- * btest(nacc(ivx,ip),19)) then
- restq = sq//'pt4'//restq(1:lrest)
- lrest = lrest+4
- end if
- notexq = restq
- lnote = lrest
-c
-c At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc.
-c
- if (nole .ne. 0) then
- if (abs(nole) .lt. 10) then
- noteq = chax(48+abs(nole))
- lnoten = 1
- else
- write(noteq(1:2),'(i2)')abs(nole)
- lnoten = 2
- end if
- if (nole .gt. 0) then
- notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
- else
- notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
- end if
- lnote = 16+lnoten
- notexq = notexq(1:lnote)//restq(1:lrest)
- lnote = lnote+lrest
- end if
- if (2**log2(nodu) .ne. nodu) then
-c
-c Deal with dots (on rests shorter than half rest)
-c
- restq = sq//'pt'
- lrest = 3
- if (2*nodu .gt. 3*2**log2(nodu)) then
- restq = sq//'ppt'
- lrest = 4
- end if
- nole = nole+4
- raisedot = 0
-c
-c Tweak dot positions for special cases
-c
- even = (mod(100+nole,2).eq.0)
-c if (.not.even.and.nodu.gt.8.and.
-c * (nole.lt.0.or.nole.gt.8)) then
- if (.not.even .and. (nole.lt.0.or.nole.gt.8)) then
- raisedot = 1
- end if
- if (nole.ge.10 .or. nole.le.-1) then
- write(numq,'(i2)')nole
- restq = restq(1:lrest)//'{'//numq//'}'
- lrest = lrest+4
- else
- restq = restq(1:lrest)//chax(nole+48)
- lrest = lrest+1
- end if
- if (raisedot.gt.0) then
- restq = sq//'raise'//sq//'internote'//
- * sq//'hbox{'//restq(1:lrest)//'}'
- lrest = lrest+23
- end if
- notexq = restq(1:lrest)//notexq(1:lnote)
- lnote = lnote+lrest
- end if
- else
-c
-c Half rest or longer
-c
- if (nole .eq. 0) then
-c
-c Half or longer rest is not raised or lowered
-c
- if (nodu .le. 56) then
- notexq =sq//'hpause'
- lnote = 7
- else if (nodu .le. 112) then
- if (.not.btest(islur(ivx,ip),19) .or.
- * btest(irest(ivx,ip),25)) then
- notexq = sq//'pause'
- else
- notexq = sq//'pausc'
- end if
- lnote = 6
- else
- notexq =sq//'PAuse'
- lnote = 6
- end if
- if (2**log2(nodu) .ne. nodu) then
-c
-c Dotted rest, hpause or longer
-c
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- if (2*nodu .gt. 3*2**log2(nodu)) then
-c
-c Double dotted long rest
-c
- notexq = notexq(1:lnote)//'p'
- lnote = lnote+1
- end if
- end if
- else
-c
-c Raised or lowered half or whole rest
-c
- if (nodu .eq. 32) then
- notexq = sq//'lifthpause'
- lnote = 11
- else if (nodu .eq. 48) then
- notexq = sq//'lifthpausep'
- lnote = 12
- else if (nodu .eq. 56) then
- notexq = sq//'lifthpausepp'
- lnote = 13
- else if (nodu .eq. 64) then
- notexq = sq//'liftpause'
- lnote = 10
- else if (nodu .eq. 96) then
- notexq = sq//'liftpausep'
- lnote = 11
- else if (nodu .eq. 112) then
- notexq = sq//'liftpausepp'
- lnote = 12
- else if (nodu .eq. 128) then
- notexq = sq//'liftPAuse'
- lnote = 10
- else
-c
-c Assume dotted double whole rest
-c
- notexq = sq//'liftPAusep'
- lnote = 11
- end if
-c
-c Set up height spec
-c
- nole = sign(abs(nole)/2,nole)
- if (nole.le.9 .and. nole.ge.0) then
- noteq = chax(48+nole)
- lnoten = 1
- else
- noteq = '{'
- if (nole .ge. -9) then
- write(noteq(2:3),'(i2)')nole
- lnoten = 3
- else
- write(noteq(2:4),'(i3)')nole
- lnoten = 4
- end if
- noteq = noteq(1:lnoten)//'}'
- lnoten = lnoten+1
- end if
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- end if
- end if
- end if
- return
- end
- function ntindex(line,s2q,lenline)
-c
-c Returns index(line,s2q) if NOT in TeX string, 0 otherwise
-c
- character*(*) s2q,line
- character*1 chax
- logical intex
- ndxs2 = index(line,s2q)
- ndxbs = index(line,chax(92))
- if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then
- ntindex = ndxs2
- else
-c
-c There are both bs and s2q, and bs is to the left of sq2. So check bs's to
-c right of first: End is '\ ', start is ' \'
-c
- len = lenstr(line,lenline)
- intex = .true.
- do 1 ic = ndxbs+1 , len
- if (ic .eq. ndxs2) then
- if (intex) then
- ntindex = 0
- ndxs2 = index(line(ic+1:len),s2q)+ic
- else
- ntindex = ndxs2
- return
- end if
- else if (intex .and. line(ic+1:ic+2).eq.chax(92)//' ') then
- intex = .false.
- else if (.not.intex .and. line(ic+1:ic+2).eq.' '//chax(92))
- * then
- intex = .true.
- end if
-1 continue
- end if
- return
- end
- subroutine ntrbbb(n,char1q,ulqq,iv,notexq,lnote)
-c
-c This appends to notexq e.g. '\ibbbu1'
-c
- common /combbm/ isbbm
- logical isbbm
- character*79 notexq
- character*1 char1q,ulqq,chax
- character*4 tempq
- if (n .ge. 5) isbbm = .true.
- if (lnote .gt. 0) then
- notexq = notexq(1:lnote)//chax(92)//char1q
- else
- notexq = chax(92)//char1q
- end if
- lnote = lnote+2
- do 3 im = 1 , n
- notexq = notexq(1:lnote)//'b'
- lnote = lnote+1
-3 continue
-c
-c add the number, 0 if 12
-c
-c 5/25/08 Allow >12
-c
-c call istring(mod(iv,12),tempq,len)
- if (iv .lt. 24) then
- call istring(iv,tempq,len)
- else if (iv .eq. 24) then
- tempq(1:1) = '0'
- len = 1
- else
- call printl('Sorry, too man open beams')
- call stop1()
- end if
- notexq = notexq(1:lnote)//ulqq//tempq(1:len)
- lnote = lnote+1+len
- return
- end
- function numclef(clefq)
-c
-c Returns the number to be used as argument of \setclef for MusiXTeX
-c For input 0-6 or tsmanrb return 0-7
-c 7 f 9
-c 8 0
-c
- character*1 clefq
- if (ichar(clefq) .lt. 55) then
-c if (ichar(clefq) .le. 55) then
- numclef = ichar(clefq)-48
-c if (numclef .eq. 7) numclef = 9
- else if (clefq .eq. '7') then
- numclef = 9
- else if (clefq .eq. '8') then
- numclef = 0
- else
- numclef = index('tsmanrbxxf',clefq)-1
- end if
- return
- end
- subroutine outbar(i,jlast)
- character*1 chax
- nfmt = log10(i+.5)+2
- if (jlast+5+nfmt .lt. 80) then
- write(*,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i
- write(15,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i
- jlast = jlast+5+nfmt
- else
- write(*,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i
- write(15,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i
- jlast = 5+nfmt
- end if
- return
- end
- subroutine pmxa(basenameq,lbase,isfirst,nsyout,nbarss,optimize)
-cccccccccccccccccccccccccccccccccccccccccccccccc
-cc cc
-cc Subroutine, combine with pmxb.for
-cc
-cccccccccccccccccccccccccccccccccccccccccccccccc
-cc
-cc Need to consider X spaces in xtuplets when getting poenom, and
-cc maybe fbar?
-cc mx06a
-cc ID numbers for voices when number of voices is reduced.
-cc
-cc mx03a
-cc account for new fracindent for new movements.
-cc
-cc Known changes since pmxa. Version 1.1b (see pmxb for longer list)
-cc
-cc Check ID codes for slurs.
-cc Version 1.24 still does not have details for spacing/positioning
-cc arpeggios if there are accidentals or shifted notes or crowded scores.
-cc Fix problem in 1.22 with arpeggios across multi-line staves
-cc Fix problem in 1.22 with flat key signatures
-cc Read setup data as strings
-cc Warning for octave designation plus +/-
-cc Don't pause for volta warning,
-cc Macros
-cc Correct fsyst to account for transposition and key changes.
-cc Check for nbars > nsyst
-cc
-ccccccccccccccccccccccccccccccccccc
- parameter (nm=24,nkb=3999,nks=125,maxblks=9600)
- logical loop,usefig,isfirst,optimize
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- integer nn(nm),nodur(nm,200),ivxo(600),ipo(600),
- * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks)
- common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
- * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
-c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks)
- * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
- common /compage/ widthpt,ptheight,hoffpt,voffpt,
- * nsyst,nflb,ibarflb(0:40),
- * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
- * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
- * nistaff(0:40)
- common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
- * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
- real*4 elsk(nkb),celsk(0:nkb),elss(nks),to(600),tno(600)
- character*128 lnholdq
- character*44 basenameq
- logical rest(nm,200),firstline,fbon,isvolt,iskchb,kchmid,ornrpt,
- * stickyS
- common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
- * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
- logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr,
- * shifton,barend
- common /a1ll/ iv,ivxo,ipo,to,tno,nnl,nv,ibar,mtrnuml,
- * nodur,lenbar,iccount,nbars,itsofar,nib,nn,
- * rest,lenbr0,lenbr1,firstline,newmeter
- common /linecom/ elskb,tnminb(nkb)
- common /cblock/
- * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
- * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
- common /cominbot/ inbothd
- common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- common /commus/ musize,whead20
- common /comeon/ eonk,ewmxk
-c logical mrecord,mplay,endmac,gotclef,cstuplet
- logical mrecord,mplay,endmac,cstuplet
- logical novshrinktop,upslur,fontslur,WrotePsslurDefaults
- common /comnvst/ novshrinktop,cstuplte
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /comligfont/ isligfont
- logical isligfont
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- logical fulltrans
- common /comis4bignv/ is4bignv,AIset
- logical is4bignv,AIset
- common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
- * poefa
- real*4 poefa(125)
- logical nocodabn
- data wtimesig,wclef,wkeysig
- * / 0.72 , 0.8 , 0.28 /
-c data poefa /125*1./
-c This corrected a problem in Bob Tennent's compilation of pmx2.94
-c
- do 97 i = 1 , 125
- poefa(i) = 1.
-97 continue
- is4bignv = .false.
- AIset = .false.
- whead20 = 0.3
- ishort = 0
- if (.not.optimize) then
- print*
- print*,'Starting first PMX pass'
- write(15,'(a)') ' Starting first PMX pass'
- end if
- if (isfirst) then
- open(19,file='pmxaerr.dat')
- write(19,'(i6)') 0
- close(19)
- end if
- if (.not.optimize) jprntb = 81
- macuse = 0
- ornrpt = .false.
- stickyS = .false.
- mrecord = .false.
- mplay = .false.
- lastchar = .false.
- novshrinktop = .false.
- cstuplet = .false.
- fontslur = .true.
- isligfont = .false.
- fulltrans = .false.
- do 42 ibarcnt = 1 , nkb
- udsp(ibarcnt) = 0.
- wminnh(ibarcnt) = -1.
-42 continue
-c
-c Initialize input buffer
-c
- lenbuf0 = ipbuf
- ipbuf = 0
- ilbuf = 1
- call g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
- * xmtrnum0,newkey(1),npages,nsyst,musize,bottreb)
-c
-c Set up list of instrument numbers (iv)
-c
- ivnow = 0
- do 13 instnow = 1 , noinst
- do 14 iscount = 1 , nsperi(instnow)
- ivnow = ivnow+1
- instno(ivnow) = instnow
-14 continue
-13 continue
-c
-c Save initial meter for midi
-c
- if (.not.isfirst .and. npages.eq.0) then
- print*,'Sorry, must have npages>0 for optimization.'
- call stop1()
- end if
- nsyout = nsyst
-c
-c isig1 will be changed in getnote if there is a transposition
-c
- isig1 = newkey(1)
- if (npages .gt. nsyst) then
- call printl('npages > nsyst in input. Please fix the input.')
- call stop1()
- end if
-c
-c fbar = afterruleskip/elemskip
-c apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt
-c
- fbar = 1.
- wheadpt = whead20*musize
- ifig = 0
- usefig = .true.
- lenbeat = i1fnodur(mtrdenl,'x')
- lenmult = 1
- if (mtrdenl .eq. 2) then
- lenbeat = 16
- lenmult = 2
- end if
- lenbr1 = lenmult*mtrnuml*lenbeat
- lenbr0 = nint(lenmult*xmtrnum0*lenbeat)
- mtrnuml = 0
- if (lenbr0 .ne. 0) then
- ibaroff = 1
- lenbar = lenbr0
- else
- ibaroff = 0
- lenbar = lenbr1
- end if
- ibarcnt = 0
- nptr(1) = 1
- iccount = 128
- nmovbrk = 0
- nflb = 0
- nfpb = 0
- ipagfpb(0) = 1
- isysfpb(0) = 1
- ibarflb(0) = 1
- isysflb(0) = 1
- nistaff(0) = nv-1
-c
-c Check for pmx.mod
-c
- linesinpmxmod = 0
-c line1pmxmod = ilbuf
- call getpmxmod(.true.,' ')
- if (.not.isfirst .and. linesinpmxmod .gt. 0) then
- print*,'Sorry, cannot optimize if there is a pmx.mod file'
- call stop1()
- end if
-c
-c Initialize for loop over lines
-c
- nkeys = 1
- ibrkch(1) = 1
- mbrestsav = 0
- shifton = .false.
- firstline = .true.
- newmeter = .false.
- ihead = 0
- isheadr = .false.
-c gotclef = .false.
- idsig = 0
- iddot = 0
- fintstf = -1.
- gintstf = 1.0
- listcresc = 0
- listdecresc = 0
-30 loop = .true.
- iskchb = .false.
- issegno = .false.
- nbars = 0
- ibarmbr = 0
- do 4 iv = 1 , nv
- nvmx(iv) = 1
- ivmx(iv,1) = iv
- itsofar(iv) = 0
- nnl(iv) = 0
- do 5 j = 1 , 200
- rest(iv,j) = .false.
- nacc(iv,j) = 0.
-5 continue
-4 continue
- iv = 1
- ivx = 1
- fbon = .false.
- barend = .false.
- isvolt = .false.
-2 if (loop) then
-c
-c Within this short loop, nv voices are filled up for the duration of a block.
-c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
-c nodur(..),rest(..). nnl will later be
-c increased and things slid around as accidental skips are added.
-c
- call g1etnote(loop,ifig,optimize,fulltrans)
- if (lastchar) go to 20
- go to 2
- end if
- if (mbrestsav .gt. 0) then
- call printl(' ')
- call printl(
- * 'You must enter the same multibar rest in ALL parts')
- call stop1()
- end if
- do 10 ibar = 1 , nbars
- ibarcnt = ibarcnt+1
-c
-c The following is just a signal to start a new bar when cataloging spaces
-c for catspace(...)
-c
- nptr(ibarcnt+1) = nptr(ibarcnt)
- newmb(ibarcnt) = .false.
- if (newmeter.and.ibar.eq.1) newmb(ibarcnt) = .true.
-c
-c Above is only for spacing calcs later on. Remember new meter can only occur
-c at START of a new input line (ibar = 1)
-c
- if (ibar .ne. ibarmbr) then
- if (.not.optimize) call outbar(ibarcnt-ibaroff,jprntb)
- else
- if (.not.optimize) then
- write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
- * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
- write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
- * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
- jprntb = 0
- end if
- ibaroff = ibaroff-mbrest+1
- end if
- if (firstline .and. lenbr0.ne.0) then
- if (ibar .eq. 1) then
- lenbar = lenbr0
- else
- lenbar = lenbr1
- end if
- end if
- if (ibar .gt. 1) then
-c
-c For bars after first, slide all stuff down to beginning of arrays
-c
- do 11 iv = 1 , nv
- do 11 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- ioff = nib(ivx,ibar-1)
- do 12 ip = 1 , nib(ivx,ibar)-ioff
- nodur(ivx,ip) = nodur(ivx,ip+ioff)
- rest(ivx,ip) = rest(ivx,ip+ioff)
- nacc(ivx,ip) = nacc(ivx,ip+ioff)
-12 continue
-11 continue
- end if
- do 67 iv = 1 , nv
- do 67 kv = 1 , nvmx(iv)
- ioff= 0
- if(ibar.gt.1)ioff = nib(ivmx(iv,kv),ibar-1)
-67 continue
- call makeabar()
- elsk(ibarcnt) = elskb+fbar
-10 continue
- newmeter = .false.
- firstline = .false.
- go to 30
-20 continue
-c
-c Vertical analysis.
-c
- if (npages .eq. 0) then
- if (nsyst .eq. 0) then
- print*,'When npages=0, must set nsyst=bars/syst, not 0'
- call stop1()
- end if
- nsyst = (ibarcnt-1)/nsyst+1
- if (nv .eq. 1) then
- nsystpp = 12
- else if (nv .eq. 2) then
- nsystpp = 7
- else if (nv .eq. 3) then
- nsystpp = 5
- else if (nv .eq. 4) then
- nsystpp = 3
- else if (nv .le. 7) then
- nsystpp = 2
- else
- nsystpp = 1
- end if
- npages = (nsyst-1)/nsystpp+1
- end if
-c
-c Check nsyst vs ibarcnt
-c
- if (nsyst .gt. ibarcnt) then
- print*
- print*,'nsyst,ibarcnt:',nsyst,ibarcnt
- print*,'There are more systems than bars.'
- write(15,'(a,2i5)')' nsyst,ibarcnt:',nsyst,ibarcnt
- write(15,'(a)')' There are more systems than bars.'
- call stop1()
- end if
-c
-c Set up dummy forced line & page breaks after last real one
-c
- nflb = nflb+1
- ibarflb(nflb) = ibarcnt+1
- isysflb(nflb) = nsyst+1
- nfpb = nfpb+1
- ipagfpb(nfpb) = npages+1
- isysfpb(nfpb) = nsyst+1
- heightil = ptheight*4./musize
- open(12,status='SCRATCH')
- write(12,'(a)')basenameq(1:lbase)
- write(12,*)lbase
-c
-c Pass to pmxb the initial signature, including effect of transposition.
-c
- write(12,'(6f10.5/f10.5,3i5)')fbar,wheadpt,etait,
- * etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1
- write(12,*)npages,widthpt,ptheight,hoffpt,voffpt,nsyst
- iflbnow = -1
- isysb4 = 0
- do 8 ifpb = 1 , nfpb
-c
-c Each time thru this loop is like a single score with several pages
-c
- npages = ipagfpb(ifpb)-ipagfpb(ifpb-1)
- nsyst = isysfpb(ifpb)-isysfpb(ifpb-1)
- nomnsystp = (nsyst-1)/npages+1
- nshort = nomnsystp*npages-nsyst
- do 7 ipage = 1 , npages
- nsystp = nomnsystp
- if (ipage .le. nshort) nsystp = nsystp-1
-c
-c Last system number on this page:
- isysendpg = isysb4+nsystp
- nintpg = 0
- do 15 isy = isysb4+1, isysendpg
- if (isysflb(iflbnow+1) .eq. isy) iflbnow = iflbnow+1
- nintpg = nintpg+nistaff(iflbnow)
-15 continue
- xilfrac = 0.
- xiltxt = 0.
- if (ipage.eq.1 .and. ihead.gt.0) then
-c
-c Needn't zero out ihead after printing titles if we only allow titles at top?
-c
- if (iand(ihead,1) .eq. 1) then
- xiltxt = xiltxt+hgtin*4/musize
- xilfrac = xilfrac+etait
- end if
- if (iand(ihead,2) .eq. 2) then
- xiltxt = xiltxt+hgtti*4/musize
- xilfrac = xilfrac+etatc
- end if
- if (iand(ihead,4) .eq. 4) then
- xiltxt = xiltxt+hgtco*4/musize
- xilfrac = xilfrac+etacs1
- else
-c
-c Use double the title-composer space if there is no composer
-c
- xilfrac = xilfrac+etatc
- end if
- end if
- D = xilfrac+nsystp-1+etatop+etabot
-c C = nsystp*(nv-1)
- C = nintpg
-c xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn
- xN = heightil - xiltxt - 4*(nintpg+nsystp) - (nsystp-1)*xilbn
- if (bottreb) xN = xN-(nsystp-1)*xilbtc
- if (ihead.eq.0 .and. isheadr) xN = xN - xilhdr
- if (ifig .eq. 1) then
- xN = xN - nsystp*xilfig
- end if
- glueil = (xN-b*C)/(D+a*C)
- omegaG = (b*D+a*xN)/(D+a*C)
-c
-c G = \interlines between systems
-c omega*G = \interlines between staves of the same system
-c \interstaff = 4+omega*G
-c C = total number of interstaff spaces in the page
-c D = omega-indep factors for scalable height = nsy-1 (intersystem glue)
-c + etatop + etabot + etatxt +
-c N = scaleable height (\interlignes) = height - htext - staff heights - xil
-c xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles
-c + (nsy-1)*xiltcb for treble clef bottoms
-c + nsy*xilfig for figures
-c G = N/(D + omega * C) = glueil, (1)
-c But (empirically) omega*G = a*G + b (2)
-c with a=1.071 and b=2.714
-c Solving (1) and (2) gives
-c G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C)
-c Pass to pmxb omega*G (=\interstaff-4)
-c (etatop,bot,it,tc,cx)*G as inputs to \titles
-c
-c glueil = (heightil-xiltxt-nsystp*(xil+4*nv))
-c * /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac)
-c xnsttop = glueil*etatop
-c xintstaff = 4+gfact*glueil
-c
-c Only the first page will get local adjustment now if needed, others in pmxb
-c
- if (ifpb.eq.1 .and. ipage.eq.1 .and. fintstf.gt.0.) then
- facins = fintstf
- fintstf = -1.
- else
-c
-c gintstf = 1.0 by default, but may be changed with AI<x>
-c
- facins = gintstf
- end if
- write(12,*)nsystp,max(0.,etatop*glueil),facins*(omegaG+4)
- ihead = 0
- isheadr = .false.
- isysb4 = isysendpg
-7 continue
-8 continue
-c
-c Done with vertical, now do horizontals
-c
- celsk(1) = elsk(1)
- do 21 ibar = 2 , ibarcnt
- celsk(ibar) = celsk(ibar-1)+elsk(ibar)
-21 continue
- lastbar(0) = 0
- ibar1 = 1
- wmins = -1.
- iflb = 1
- imovbrk = 0
- ikey = 1
-c
-c Return nsyst to its *total* value
-c
- nsyst = isysfpb(nfpb)-1
- do 22 isyst = 1 , nsyst
- if (isyst .eq. isysflb(iflb)) iflb = iflb+1
- if (nmovbrk.gt.0 .and. imovbrk.lt.nmovbrk) then
- if (isyst .eq. isysmb(imovbrk+1)) imovbrk = imovbrk+1
- end if
- ibarb4 = lastbar(isyst-1)
- if (isyst .eq. 1) then
- if (isfirst) elsstarg = celsk(ibarflb(1)-1)/
- * (isysflb(1)-1-fracindent)*(1-fracindent)
- celskb4 = 0.
- else
- celskb4 = celsk(ibarb4)
-c
-c Must dimension isysmb(0:*) just so I can execute this test!
-c
- if (isfirst) then
- if (nmovbrk.gt.0 .and. isyst.eq.isysmb(imovbrk)) then
-c
-c First syst after forced line break. There may be indentation.
-c
- elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
- * /(isysflb(iflb)-isyst-fracsys(imovbrk))
- * *(1-fracsys(imovbrk))
- else
-c
-c There is no indentation to deal with
-c
- elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
- * /(isysflb(iflb)-isyst)
- end if
- end if
- end if
- if (isfirst) then
- diff1 = abs(elsstarg-elsk(ibarb4+1))
- do 23 ibar = ibarb4+2 , ibarcnt
- diff = elsstarg-(celsk(ibar)-celskb4)
- if (abs(diff) .ge. diff1) go to 24
- diff1 = abs(diff)
-23 continue
-24 ibar = ibar-1
- lastbar(isyst) = ibar
- nbarss(isyst) = ibar-ibarb4
- else
-c
-c nbarss is given as an input, must compute lastbar and ibar
-c
- lastbar(isyst) = nbarss(isyst)+ibarb4
- ibar = lastbar(isyst)
- end if
-c
-c elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's.
-c
- elss(isyst) = celsk(ibar)-celskb4
- write(12,'(i5)')lastbar(isyst-1)+1
-c
-c Transposed sigs are isig1, newkey(2,3,...).
-c
- if (ikey .eq. 1) then
- key1 = isig1
- else
- key1 = newkey(ikey)
- end if
- fsyst = wclef+abs(key1)*wkeysig+2./musize
- xelsk = 0.
-1 if (ikey.lt.nkeys) then
- if (ibrkch(ikey+1).le.lastbar(isyst)) then
-c
-c Add space for all key changes
-c
- ikey = ikey+1
- key2 = newkey(ikey)
- naccs = max(abs(key2-key1),max(abs(key1),abs(key2)))
- fsyst = fsyst+naccs*wkeysig
-c
-c Account for afterruleskips (fbar)
-c
- xelsk = xelsk+fbar/2
- if (ibrkch(ikey).lt.lastbar(isyst) .and. .not.kchmid(ikey))
- * xelsk = xelsk-1.
- key1 = key2
- go to 1
- end if
- end if
-c
-c Add extra fixed space for double bar
-c
- if (isyst .eq. nsyst) then
- fsyst = fsyst+4.5/musize
- end if
-c
-c Add extra fixed space for initial time signature
-c
- if (isyst .eq. 1) then
- fsyst = fsyst+wtimesig
- end if
-c
-c Add extra fixed space for time signature changes & user-defined spaces
-c
- do 26 ibars = ibarb4+1 , lastbar(isyst)
- if (newmb(ibars)) fsyst = fsyst+wtimesig
- fsyst = fsyst+udsp(ibars)/musize
-26 continue
- if (isyst .eq. 1) then
- wdpt = widthpt*(1-fracindent)
- else
- if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
- * isyst.eq.isysmb(imovbrk)) then
- wdpt = widthpt*(1-fracsys(imovbrk))
- else
- wdpt = widthpt
- end if
- end if
- wsyspt = wdpt-fsyst*musize-0.4*nbarss(isyst)
-c
-c Checks for min spacing
-c Get min allowable space
-c
- dtmin = 1000.
- do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1
- dtmin = min(dtmin,tnminb(ibar))
- if (wminnh(ibar).ge.0.) wmins = wminnh(ibar)
-45 continue
- if (wmins .lt. 0) wmins = 0.3
- wminpt = (1+wmins)*0.3*musize
-c
-c Find max duration & # of notes for this system
-c
- dtmax = 0.
- nns = 0
- do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
- dtmax = max(dtmax,durb(iptr))
- nns = nns + nnpd(iptr)
-43 continue
- elmin0 = wsyspt*f1eon(dtmin)/(elss(isyst)+xelsk)
- if (elmin0 .ge. wminpt) then
-c
-c Subtract out fbar stuff to keep old way of passing sumelsk to pmxb;
-c there is no need to "flatten"
-c
- sumelsk = elss(isyst)-fbar*nbarss(isyst)
- eonk = 0.
- ewmxk = 1.
- else
- elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/f1eon(dtmax)+nns)
- if (elmin1 .le. wminpt) then
-c print*
-c print*,'In system #',isyst,' cannot meet min. space rqmt'
-c write(15,'(/a,i5,a)')
-c * 'In system #',isyst,' cannot meet min. space rqmt'
- eonk = 0.9
- else
-c
-c Find eonk by Newton method
-c
- call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1,
- * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax,
- * (wminpt-elmin0)/(elmin1-elmin0))
- eonk = min(.9,eonk)
- end if
- ewmxk = f1eon(dtmax)**eonk
-c
-c Recompute poenom!
-c
- sumelsk = 0
- do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
- sumelsk = sumelsk
- * + nnpd(iptr)*sqzb(iptr)*feon(durb(iptr)/sqzb(iptr))
-44 continue
- end if
- poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk)
-c
-c Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0
-c
- if (isyst .gt. 0) then
- if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
- * isyst.eq.isysmb(imovbrk)) then
- fracindent = fracsys(imovbrk)
- else
- fracindent = 0.
- end if
- end if
- write(12,'(1pe12.5/i5,5e12.3)') poenom,nbarss(isyst),
- * sumelsk,fsyst,fracindent,eonk,ewmxk
- ibar1 = ibar1+nbarss(isyst)
-22 continue
- rewind(12)
- open(13,status='SCRATCH')
- write(13,'(i5)')ifig
- rewind(13)
- ilbuf = 1
- ipbuf = 0
- if (.not.optimize) then
- write(*,'(/,a)')' Done with first pass'
- print*
- write(15,'(/,a)')' Done with first pass'
- write(15,'()')
- end if
-c
-c Following syntax is needed since pmxa is called with literal argument .false.
-c
- if (isfirst) isfirst = .false.
- return
- end
- subroutine pmxb(inlast,poevec,ncalls,optimize)
-cccccccccccccccccccccccccc
-cc
-cc To Do
-cc
-cc Resolve disagreement in final poe for 1st system, compared with *.mx2
-cc Shift slurs on right- or left-shifted main notes (2/7/99)
-cc Various end-of-input-block repeat problems (ick142.pmx).
-cc Force multiplicity for un-beamed xtups.
-cc Clef change at end of piece
-cc Global "A" option to maximize "X" at a given time tick.
-cc Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted
-cc note. See trubl18.pmx
-cc Tab character as space.
-cc Clef interference with second line of music.
-cc Add space for interferences between *different* lines of music?
-cc Shift arpeggios, both automatic and manual.
-cc Different musicsize for different instruments.
-cc Spacing checks for accid's on left-shifted chord notes
-cc Spacing checks for double dots
-cc Allow forced line breaks w/o setting nsyst.
-cc Cresc-Decresc. (Enhance MusiXTeX first?)
-cc Dynamic Marks.
-cc Bug with Voltas at line end (MusiXTeX problem?).
-cc Subtle bug w/ slur hgt over line brk, see trubl15.pmx
-cc Stem-end slurs.
-cc Allow units in indentation.
-cc Make inline TeX more context sensitive.
-cc Werner's 4/2/98 problem with "o?"
-cc Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong.
-cc converts e.g. "r2db" into "r2d", which might be wrong.
-cc Werner's generalsignature problem with Key change and new transposition.
-cc (wibug8.pmx)
-cc Unequal xtuplets
-cc Print both sets of bar #'s in tex file.
-cc Make barlines invisible \def\xbar{\empty} , fix fbar.
-cc Auto-tie slurs 'At'
-cc Forced line break anywhere (e.g. at a mid-bar repeat).
-cc Clef change at very start of file.
-cc Tighten test for M as macro terminator.
-cc Fix title so not separate limit on author length + composer length.
-cc Arpeggios in xtups.
-cc
-cc mx10b
-cc Option for instrument name at top center. Last item in P command:
-cc P[n]c text is instrument name (use in parts)
-cc P[n]cstuff text is stuff (up to 1st blank)
-cc P[n]c"stuff with spaces" text is stuff with spaces
-cc
-cc Post version 1.43
-cc Reduced space rqmt for multiplicity-0 graces (no flag)
-cc Removed last sepsym in centered whole-bar rests, fixes volta height bug.
-cc
-cc Version 1.43
-cc Fix spacing for end-of-line signature change.
-cc Adjust left-shift of grace group for shifted accidentals.
-cc Put in extra space for left-shifted accidentals.
-cc Fix bug with dot-shift before accid-shift on chord note.
-cc Space-check for right-shifted main notes.
-cc Enable forcing stem direction of single notes in non-beamed xtups.
-cc Disallow clef change after last note before end of input block (pmxa)
-cc Print meter change before page break
-cc increase length of strings for \titles macro
-cc version 1.42
-cc Loosen up input syntax for "X" commands. Subroutine getx()
-cc "B" and "P" in "X" commands
-cc mx09b
-cc Allow multiple rests at start of xtup
-cc Add 64th rest
-cc Fix xtup numbers over rests. (subroutine levrn)
-cc Initialize notcrd=.false. every gulp. Avoids undefined state with e.g.
-cc c za / ( c a ...
-cc Allow double dots to be shifted.
-cc Fix spacing with double dotted notes; permit splitting small note.
-cc Fix \dotted printout so it works with old compiler
-cc mx08b
-cc Automatic spaces if needed for shifted accidentals.
-cc Some Dynamics
-cc Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc)
-cc version 1.41
-cc Allow ":" as last char of path name
-cc Dotted slurs "sb"
-cc Continue bar numbering at movement break "L[integer]Mc"
-cc mx07b
-cc Whole-bar rests with double lines of music. Fixed all options ?
-cc Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number].
-cc Option to suppress centering full-bar rests. "o"
-cc mx06b
-cc Shift accid on left-shifted chord note.
-cc Rest as first note of xtup.
-cc Wrong slopes with small widths. Scale slfac1 by widthpt_default/widthpt
-cc Allow Rb for single bar at movemnet break or end of piece. (islur(25))
-cc Change # of inst at a movement break. noinst is total # and must be used
-cc in 1st movement. ninow is current. nspern(1,...,ninow) is current
-cc staves/inst, nsperi(1,...,noinst) is original. rename tells whether to
-cc reprint names in parindent at a movement break. Default is .false.
-cc unless ninow changes, then .true. But can force either with r+/- as
-cc option in 'M'
-cc mx04b
-cc Double-dotted notes, separate+beamed, main+chord, still no extra space.
-cc ??? Don't shift slur ends on whole notes.
-cc (pmxa) Write line number of error in pmxaerr.dat
-cc mx02b
-cc Admit "RD" before "/" (search for "rptfq2:" )
-cc In doslur, for multi-line staves, single notes, check forced stem dir'n
-cc before setting stemup (used to set horiz offset).
-ccccccccccccccccccccccccccccccc
- parameter (nm=24,nks=125,mv=24576,maxblks=9600)
-c
-c FYI /all/ differs in appearance in function ncmid
-c
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
-ccccccccccccc
-cc islur cc
-ccccccccccccc
-c bit meaning
-c 0 slur activity on this note
-c 1 t-slur here.
-c 2 force 0-slope beam starting on this note
-c 3 Double dotted note!
-c 4 grace before main note
-c 5 left repeat
-c 6 right repeat
-c 7 start Volta
-c 8 doublebar
-c 9 end Volta
-c 10 on=>endvoltabox
-c 11 on=>clefchange
-c 12-14 0=>treble, ... , 6=>bass
-c 15 on=> start new block for clef change (maybe diff. voice)
-c 16 literal TeX string
-c 17 1=up, 0=down stem for single note (override) See bit 30!
-c 18 if on, prohibit beaming
-c 19 if on, full bar rest as pause
-c 20 Beam multiplicity down-up
-c 21 Forced multiplicity for any beam including xtups
-c 22-24 Value of forced multiplicity
-c 25 single barline at movement break
-c 26 doubleBAR (see bits 5,6,8)
-c 27-28 Forced beam fine-tune height (1 to 3)
-c 29 Blank rest
-c 30 If on, get stem dir'n from bit 17
-c 31 If on, suppress printing number with xtuplet starting here
-ccccccccccccc
-cc ipl cc
-ccccccccccccc
-c 0 blank barline (must be iv=1) (would have used islur but no room)
-c 1 look left for K rests, moved here from iornq(30)
-c 2 treblelowoct
-c 3 Open notehead in forced beam xtup
-c 4 Set if single stem tremolo
-c 5-6 termulo multiplicity - 1
-c 7 unused
-c 8 left offset main note one headwidth
-c 9 right offset main note one headwidth
-c 10 chord present?
-c 11-16 Forced beam height adjustment (-30 to +30)
-c 17-22 Forced beam slope adjustment (-30 to +30)
-c 23-26 Slur index for Way-after grace. Inserted when slur is started.
-c 27 5th bit for slur index for Way-after grace (100712)
-c 28 key change: only in voice 1
-c 29 Grace after main note. (Type A)
-c 30 In forced beam. Signals need to check beam heights
-c 31 Grace way after main note. (stretch to next note, type W)
-ccccccccccccc
-cc iornq cc
-ccccccccccccc
-c 0 Ornament "(". Was user-defined horizontal slur shift on this note
-c until 9/24/97; changed that to irest(21)
-c 1-13 stmgx+Tupf._)
-c 14 Down fermata, was F
-c 15 Trill w/o "tr", was U
-c 16-18 Editorial s,f,n
-c 19-20 >^
-c 21 "?" for editorial accid, w/ or w/o s,f,n
-c 22 Set if ihornb governs ornament height. Same in icrdorn.
-c 23 Set in getorn if ANY note at time of this main note has ornament.
-c This is ONLY used in beamstrt to signal whether to do more
-c tests for whether ihornb is needed. (ihornb is only needed
-c if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note)
-c (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm.
-c 24 Slur on after or way-after grace. Use as signal to START slur.
-c 25 Tweak orn ht. Same in icrdorn for chord note
-c 26 Insert user-defined space before this note (was 22)
-c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord
-c 28 caesura or breath
-cc 29 blank barline (must be iv=1) (would have used islur but no room)
-c 29 coda
-cc 30 "Look-left" option for keyboard rest
-c 30 Part-by-part segno oG
-c 31 Set if any note (main or chord) has cautionary accid, for space checks
-ccccccccccccc
-cc irest cc
-ccccccccccccc
-c 0 rest=1, no rest = 0
-c 1 There will be a vertical shift for number of this xtup
-c 2 Set if 2-note tremolo starts here
-c 3-4 nsolid, # of solid beams in 2-note tremolo
-c 5-6 nindent, # of indented beams in 2-note tremolo
-c 7 There is a horizontal shift for xtup number
-c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5
-c 14 Flip up/down-ness of xtup number
-c 15 Single-voice, single note shift X(...)[p]S
-c 16 Start single-voice, multinote shift with this note X(...)[p]:
-c 17 End single-voice, multinote shift after this note. Enter symbol
-c after note. X:
-c 18 User-defined hardspace after last note of bar, *after* this note.
-c Value still stored in udoff(ivx,nudoff(ivx)), not with other
-c hardspaces in udsp, to avoid confusion with time checks.
-c 19 Move the dot. Data stored in ndotmv,updot,rtdot
-c 20 Set if right-shifted main or chord note here. Use for space checks.
-c 21 User-defined hardspace in xtup
-c 22 User-defined slur shift horizontal slur shift.
-c 23 Set on last note before staff-jumping a beam.
-c 24 Set on first note after staff-jumping a beam
-c 25 Suppress rest centering. "ro"
-c 26 Dynamic on this note
-c 27 Set if left-shifted main or chord note here. Use for space checks.
-c 28 Set if xtup starts on this note.
-c 29 Set on lowest-voice note at same time as 1st note after jump-beam.
-c 30 Set on note after end of jump-beam segment, to force new note group
-c 31 Flag for cautionary accidental
-ccccccccccccc
-cc nacc cc
-ccccccccccccc
-c 0-1 0=no accid, 1=fl, 2=sh, 3=na
-c 2 double
-c 3 big
-c 4-9 vertshift-32
-c 10-16 20*(horiz. shift + 5.35) (Recentered ver 2.32)
-c 17 Midi-only accidental
-c 18 2:1 xtup
-c 19 Together with nacc(18), increase multiplicity by 1 and dot 1st note.
-c 20 Set on last note of each seg except last seg of single-slope beam.
-c 21 Set on 1st note of each seg except 1st seg of single-slope beam.
-c 22-26 If .ne.0, printed xtup number for xtup starting on this note.
-c 27 Set for dotted xtup note. Mult dur by 1.5, mult next by .5 & increase
-c multiplicity by 1
-c 28 Set on main note of chord if accidentals are ordered.
-c 29 Tag for chordal accidental shift...means add to autoshifts.
-c 30-31 Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted.
-c If upstem|downstem, main is upper|lower member of 2nd
-c Action is to interchange pitches only when notes are placed.
-ccccccccccccc
-cc mult cc
-ccccccccccccc
-c 0-3 Multiplicity+8 (mult= # of flags)
-c 4 Set if slope adjustment for xtup bracket
-c 5-9 16+slope adjustment
-c 10-15 New stem length, [0-63] => (-4,0,+27.5)
-c 16-22 64+Vertical offset of xtup #
-c 27 Stemlength override
-cc 28-30 New stem length.
-ccccccccccccc
-cc isdat1 cc
-ccccccccccccc
-c 13-17 iv
-c 3-10 ip
-c 11 start/stop switch
-c 12 kv-1
-c 19-25 ichar(code$)
-c 26 force direction?
-c 27 forced dir'n = up if on, set in sslur; also
-c final direction, set in doslur when beam is started, used on term.
-c 28-31 ndxslur, set in doslur when beam is started, used on term.
-ccccccccccccc
-cc isdat2 cc
-ccccccccccccc
-c 0 Chord switch. Not set on main note.
-c 1-2 left/right notehead shift. Set only for chord note.
-c 3 tie positioning
-c 4 dotted slur
-c 6-11 voff1 1-63 => -31...+31
-c 12-18 hoff1 1-127 => -6.3...+6.3
-c 19-25 nolev
-c 26 \sluradjust (p+s)
-c 27 \nosluradjust (p-s)
-c 28 \tieadjust (p+t)
-c 29 \notieadjust (p-t)
-ccccccccccccc
-cc isdat3 cc
-ccccccccccccc
-c 0 set if midslur (at least one argument)
-c 1 set if curve (2 more args)
-c 2-7 32+first arg (height correction) (1st arg may be negative)
-c 8-10 second arg (initial slope)
-c 11-13 third arg (closing slope)
-c 14-21 tie level for use in LineBreakTies
-c 22-29 ncm for use in LineBreakTies
-ccccccccccccc
-cc isdat4 cc Set these all at turn-on using s option
-ccccccccccccc
-c 0-5 Linebreak seg 1 voff 1-63 => -31...+31
-c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3
-c 16-21 Linebreak seg 2 voff 1-63 => -31...+31
-c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3
-ccccccccccccc
-c icrdat c
-ccccccccccccc
-c 0-7 ip within voice
-c 8-11 ivx (together with 28th bit)
-c 12-18 note level
-c 19 accidental?
-c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
-c 23 shift left
-c 24 shift right
-c 25 arpeggio start or stop
-c 26 flag for moved dot (here, not icrdot, since this is always reset!)
-c 27 Midi-only accidental
-c 28 (6/27/10) 5th bit for ivx, to allow up to 24 voices
-c 29 Tag for accidental shift...means add to autoshifts.
-c 31 Flag for cautionary accidental on chord note
-ccccccccccccc
-c icrdot c:
-ccccccccccccc
-c 0-6 10*abs(vertical dot shift in \internote) + 64
-c 7-13 10*abs(horizontal dot shift in \internote) + 64
-c 14-19 vert accidental shift-32
-c 20-26 20*(horiz accidental shift+3.2)
-c 27-29 top-down level rank of chord note w/accid. Set in crdaccs.
-c
-c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
-c
-cccccccccccccccccccccccccccccccc
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- character*10 figq
- common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
- logical ignorenats,newmbrhgt
- character*1 ulq,sepsymq,sq,chax
- logical beamon,firstgulp,figbass,figchk,
- * isfig,rptnd1,rptprev
- logical loop,lastchar,slint,svolta,evolta,onvolt,
- * cwrest(nm),islast,inlast,optimize
- integer istop(80),numbms(nm),istart(80)
- real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks),
- * tstart(80),squez(80)
- character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq
- character*79 notexq,inameq
- character*40 pathnameq
- character*44 basenameq
- character*24 fmtq
- character*20 voltxtq
- character*120 instrq,titleq,compoq
- common /comlast/ islast,usevshrink
- logical usevshrink,stickyS,OptLineBreakTies,autofbon
- common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
- common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
- * inhead
- common /cominbot/ inbothd
- common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- common /comnsp/ space(80),nb,prevtn(nm),
- * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
- common /comstart/ facmtr
- common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
- * tautofb,autofbon,t1autofb
- common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
- * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
- * rptprev,equalize,rptfq1,rptfq2
- common /combeam/ ibmtyp
- common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
- * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
- * OptLineBreakTies,HeaderSpecial
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comas2/ nasksys,wasksys(800),elasksys(800)
- common /comas3/ ask(2500),iask,topmods
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- common /comsln/ is1n1,is2n1,irzbnd,isnx
- common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
- * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
- * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
- * graspace(37),
- * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
- * naccg(74),voltxtq(6),litq(83)
- logical upg,slurg,slashg,fbon,ornrpt,shifton,isbjmp,notcrd,was2,
- * isbj2,fontslur,WrotePsslurDefaults,HeaderSpecial
- common /comivxudorn/ivxudorn(63)
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- character*128 litq,lnholdq
- logical upslur,bar1syst,vshrink,lrpt,rrpt,lrptpend,
- * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb,
- * btest,sluron,setis,nobar1
- common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
- * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
- common /compoi/ ispoi
- common /combc/ bcspec
- common /comeon/ eonk,ewmxk
- common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
- * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
- * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
- * rtshfac
- common /comhsp/ hpttot(176)
- common /combmh/ bmhgt,clefend
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- common /commus/ musize,whead20
- common /comtol/ tol
- common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
- * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
- * idynda2(99),levhssav(nm),listcresc,listdecresc
- character*128 txtdynq
- logical mrecord,mplay,endmac,flipend,istype0,lowdot,rename,ispstie
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc,equalize,
- * ismbr,putmbr
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /comcb/ nbc,ibcdata(36)
- common /comclefq/ clefq
- common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
- * ArpShift(20)
- common /comligfont/ isligfont
- logical isligfont
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /combibarcnt/ ibarcnt
- character*40 nmq
- common /commidisig/ midisig
- common /comclefrests/ centrests
- logical newclef, centrests
- common /comlyr/ inputmlyr
- logical inputmlyr
- common /combottop/ botamt,topamt,bottopgap
- logical bottopgap
- common /comis4bignv/ is4bignv,AIset
- logical is4bignv,AIset
- common /comhair/ idhairuse,idhair(nm)
- common /comc8flag/ c8flag(nm)
- logical c8flag
- common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
- * poefa
- real*4 poefa(125)
- logical nocodabn
- character*3 shortfraq,rendq
- bottopgap = .false.
- inputmlyr = .false.
- idhairuse = 0
- if (.not.optimize) then
- print*
- print*,'Starting second PMX pass'
- print*
- write(15,'(a)')'Starting second PMX pass'
- end if
- newclef = .false.
- centrests = .false.
- ncalls = ncalls+1
- islast = inlast
- macuse = 0
- isyscnt = 0
- stemmax = 8.2
- stemmin = 3.9
- stemlen = 6.0
- sq = chax(92)
- ignorenats = .false.
- newmbrhgt = .false.
- bcspec = .true.
- topmods = .false.
- ismbr = .false.
- read(12,'(a)')basenameq
- read(12,*)lbase
- read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop,
- * etabot,inbothd,inhnoh,isig
- ilbuf = 1
- ipbuf = 0
- call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,xmtrnum0,
- * npages,nsyst,musicsize,fracindent,istype0,inameq,
- * clefq,sepsymq,pathnameq,lpath,isig0)
- if (ismidi) then
-c
-c Initial key signature and meter for pickup bar
-c 130313 Unless explicit miditranspose for all parts (to be dealt with later),
-c want concert sig (isig0) here. K+n+m will have changed sig to isig
-c call midievent('k',isig,0)
-c 130316
-c call midievent('k',isig0,0)
-c call midievent('k',midisig,0)
-c
-c Above is probably cosmetic
-c call midievent('k',midisig,0)
- if (xmtrnum0 .gt. tol) then
-c
-c We have a pickup. Some tricky stuff to get a meter:
-c
- xntrial = xmtrnum0
- do 5 ip2 = 0 , 5
- if (abs(mod(xntrial,1.)) .lt. tol) go to 6
- xntrial = xntrial*2
-5 continue
- print*,'Problem finding meter for pickup bar'
- xntrial = 1.
- ip2 = 0
-6 continue
- call midievent('m',nint(xntrial),2**ip2*mtrdenl)
- else
-c
-c No pickup, enter the starting meter
-c
- call midievent('m',mtrnuml,mtrdenl)
- end if
- end if
-c
-c Set musicsize from value passed in common, due to possible reset by S[n]m16
-c
- musicsize = musize
- read(12,*)npages,widthpt,height,hoffpt,voffpt,nsyst,
- * (nsystp(ipa),xnsttop(ipa),xintstaff(ipa),ipa=1,npages),iauto
-c
-c If default width ever changes, must adjust this stmt.
-c
- slfac1 = 0.00569*524./widthpt
- figbass = .false.
- read(13,*)ifig
- if (ifig .eq. 1) then
- figbass = .true.
- open(14,status='SCRATCH')
- write(14,'(a)')sq//'def'//sq//'fixdrop{'//sq//'advance'//sq//
- * 'sysno by 1'//sq//'ifcase'//sq//'sysno%'
- end if
- lastchar = .false.
- ibcoff = 0
- if (xmtrnum0 .gt. 0.) ibcoff = -1
- open(11,status='SCRATCH')
-c
-c vshrink for the first page is calculated in topfile,
-c and if true set interstaff=10. vshrink affects Titles.
-c Must also save vshrink for page ending.
-c
- call topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
- * xintstaff(1),mtrnmp,mtrdnp,vshrink,fbar,fontslur)
-c
-c ninow is working value of # of instruments. noinst is max #, and # at start.
-c
- ninow = noinst
-c
-c Save original printed meter in case movement breaks
-c
- movnmp = mtrnmp
- movdnp = mtrdnp
-c
- if (islast .and. figbass .and. musicsize.eq.16)
- * write(11,'(a)')sq//'def'//sq//'figfont{'//sq//'eightrm}%'
-c
- if (islast .and. isligfont) then
- if (musicsize .eq. 16) then
- write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 8pt%'
- else
- write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 10pt%'
- end if
- end if
- lenbeat = ifnodur(mtrdenl,'x')
- if (mtrdenl .eq. 2) lenbeat = 16
- lenb1 = mtrnuml*lenbeat
- if (mtrdenl .eq. 2) lenb1 = lenb1*2
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- lenb0 = nint(xmtrnum0*lenbeat)
- if (mtrdenl .eq. 2) lenb0 = lenb0*2
- if (lenb0 .ne. 0) then
- if (islast) write(11,'(a)')sq//'advance'//sq//'barno by -1'
- lenbar = lenb0
- else
- lenbar = lenb1
- end if
-c
-c Initialize full-program variables
-c
- fixednew = 0.
- scaldold = 0.
- fintstf = -1.
- gintstf = 1.
- nasksys = 0
- ibarcnt = 0
- iline = 0
- movbrk = 0
- isystpg = 0
- ipage = 1
- iccount = 128
- iask = 0
- nhstot = 0
- nb = 1
- if (.not.optimize) jprntb = 81
- idsig = 0
- iflagbot = 0
-c
-c Next 5 are raise-barno parameters. irzbnd is integer part of default level.
-c
- irzbnd = 3
- if (isig.eq.3 .and. clefq(nv).eq.'t') irzbnd = 4
- is1n1 = 0
- isnx = 0
- SlurCurve = 0.
- ishort = 0
- nocodabn = .false.
- mbrsum = 0
- nmbr = 0
-c
-c 111109 Made global rather than per gulp
-c
- ndyn = 0
- ispoi = .false.
- slint = .false.
- lrptpend = .false.
- rptnd1 = .false.
- rptfq2 = 'E'
- rptprev = .false.
- onvolt = .false.
- flgndb = .false.
- fbon = .false.
- shifton = .false.
- ornrpt = .false.
- setis = .false.
- lowdot = .false.
- rename = .false.
- nobar1 = .false.
- equalize = .false.
- usevshrink = .true.
- WrotePsslurDefaults = .false.
- OptLineBreakTies = .false.
- HeaderSpecial = .false.
-c
-c vshrink is initialized in topfile
-c
- stickyS = .false.
-c
-c ixrest = 1 or 2 if xtup has started with a rest
-c
- do 1 ivx = 1 , nm
- ixrest(ivx) = 0
- fullsize(ivx) = 1.
-c
-c Set legacy note level to middle c as default
-c
- ndlev(ivx,1) = 29
- ndlev(ivx,2) = 29
-1 continue
- npreslur = 0
- nhssys = 0
- listslur = 0
- do 31 i = 1 , 202
- isdat1(i) = 0
- isdat2(i) = 0
-31 continue
- nsdat = 0
-c
-c Initialize flag for figures in any other voice than 1
-c
- ivxfig2 = 0
-c
-c Initialize for loop over gulps
-c
- firstgulp = .true.
-c
-c Start a gulp
-c
-30 loop = .true.
- notcrd = .true.
- isbjmp = .false.
- isbj2 = .false.
- autofbon = .false.
- tautofb = 0.
- nbars = 0
- nfigs(1) = 0
- nfigs(2) = 0
- ngrace = 0
- ntrill = 0
- ncrd = 0
- nudorn = 0
- nlit = 0
- nvolt = 0
- ibarmbr = 0
- nudsp = 0
-c ndyn = 0 ! 111109
- ntxtdyn = 0
- nbc = 0
- NumArpShift = 0
- do 3 i = 1 , 37
- graspace(i) = 0.
-3 continue
-c
-c Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst.
-c and also if nv increases in an 'M' directive.
-c
- do 4 iv = 1 , nv
- call newvoice(iv,clefq(iv),.false.)
-4 continue
-c
-c Check if endsymbol was set earlier
-c
- if (rptnd1) then
- rptnd1 = .false.
- rptfq2 = rptfq1
- else
-c
-c Only use if movbrk>0, to signal default ('RD')
-c
- rptfq2 = 'E'
- end if
- iv = 1
- ivx = 1
-2 if (loop) then
-c
-c Within this loop, nv voices are filled up for the duration of the block.
-c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
-c nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..).
-c nbars is for this input block.
-c Only at the beginning of an input block will there be a possible mtr change,
-c signalled by a nonzero mtrnuml. (which will be re-zeroed right after change)
-c
- call getnote(loop)
- if (lastchar) go to 40
- go to 2
- end if
-c
-c Finished an input block (gulp).
-c
- if (ismidi) then
-c
-c Put rests into midi array for 2nd lines that were not used in this gulp.
-c
- do 60 iv = 1 , nv
- if (twoline(iv) .and. nvmx(iv).eq.1) then
- if (firstgulp .and. lenb0.ne.0) then
- call addmidi(midchan(iv,2),0,0,0,
- * (nbars-1.)*lenbar+lenb0,.true.,.false.)
- else
- call addmidi(midchan(iv,2),0,0,0,1.*nbars*lenbar,.true.,
- * .false.)
- end if
- end if
-60 continue
- end if
- nvolt = 0
- do 28 iv = 1 , nm
- nudoff(iv) = 0
- maxdotmv(iv) = ndotmv(iv)
- ndotmv(iv) = 0
-28 continue
-c
-c Put stuff at top of p.1. Must wait until now to have read title info.
-c
- if (ibarcnt .eq. 0) then
- call puttitle(inhnoh,xnsttop(ipage),
- * etatop,sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
- if (HeaderSpecial)
-c
-c Write special header for first page
-c
- * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
- end if
- do 10 ibar = 1 , nbars
- ibarcnt = ibarcnt+1
- bar1syst = ibarcnt .eq. iauto
- ndig = max(0,int(log10(.001+ibarcnt+ibcoff)))
- if (islast)
- * write(11,'(a11,i'//chax(50+ndig)//')')
- * '% Bar count',ibarcnt+ibcoff
- if (ibar .ne. ibarmbr) then
- if (.not.optimize) call outbar(ibarcnt+ibcoff,jprntb)
- else
- if (.not.optimize) then
- write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
- * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
- write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
- * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
- jprntb = 0
- end if
- ibcoff = ibcoff+mbrest-1
-c if (ibar.eq.1 .and. firstgulp .and.
-c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize
- if (ibar.eq.1 .and. firstgulp .and.
- * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize
- end if
-c
-c Move the read to after end-of-bar hardspace checks, so we get right poenom
-c at end of a line.
-c if (bar1syst) read(12,*) poenom
-c
-c Check for clef at start of bar. No slide yet. Also flags at end of prev.
-c bar. This block is run at the start of every bar. May fail for flag at
-c end of last bar. To account for necc. hardspaces, compute and store
-c nhssys = # of hard spaces for this system
-c hesk(nhssys) = elemskips avialable
-c hpts(nhssys) = hard points needed, including notehead
-c Here, merely insert placeholder into output. Later, when poe is computed,
-c compute additional pts and store them in hpttot(1...nhstot). Finally in
-c subroutine askfig, write true pts where placeholders are.
-c
- ioff = 0
- if (ibar .gt. 1) ioff = nib(1,ibar-1)
- clchb = btest(islur(1,ioff+1),15)
- putmbr = .false.
- if (ismbr) then
- if (clchb) then
-ccc
-ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest.
-ccc
- write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest'
- * //sq//'def'//sq//'mbrest#1#2#3{%'
- write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55,
- * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%'
-cc
-cc RDT suggestion is inset blank barline - 160103 Abandoned
-cc
-c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace'
-c * //sq//'advance'//sq//'barno-1'
- end if
- ismbr = .false.
- putmbr = .true.
- end if
- if (ibar .eq. ibarmbr) ismbr = .true.
-c
-c Set flag here so at start of next bar, if there's a clef change, can add space
-c after the mbr with the above kluge
-c
- if (.not.(clchb .or. flgndb)) go to 23
-c
-c Must check available space
-c
- ptsndb = 0.
-c
-c Zero out block signal
-c
- if (clchb) islur(1,ioff+1) = ibclr(islur(1,ioff+1),15)
-c
-c In this loop, we determine how much hardspace is needed (if any)
-c 9/7/97 Note that for last bar in input block, if number of lines of
-c music decreases in new block, highest numbered ones won't be checked
-c since the loop below covers the new nvmx(iv), not necessarily the old
-c one.
-c 4/18/98 Apparently nmxsav was a solution to the above problem
-c
- do 16 iv = 1 , nv
- do 16 kv = 1 , nvmxsav(iv)
- ivx = ivmxsav(iv,kv)
- ptsndv = flgndv(ivx)*wheadpt
- ioff = 0
- if (ibar .gt. 1) then
- ioff = nib(ivx,ibar-1)
- ip = ioff
- if (ibar.gt.2) ip = ioff-nib(ivx,ibar-2)
-c prevtn(ivx) = tnote(iand(ipl(ivx,ip),255))
- prevtn(ivx) = tnote(ipl2(ivx,ip))
-c
-c If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar.
-c
- end if
-c
-c Only allow clef changes when ivx <= nv
-c
- if (ivx .le. nv) then
- clchv(iv) = clchb .and. btest(islur(iv,ioff+1),11)
- if (clchv(iv)) then
-c
-c Clef change in this voice. Turn off signal. Get space avail.
-c
- islur(iv,ioff+1) = ibclr(islur(iv,ioff+1),11)
- if (abs(prevtn(iv)-space(nb)).lt.tol) ptsndv =
- * ptsndv+clefend*wheadpt
- end if
- end if
- ptsndb = max(ptsndb,ptsndv+wheadpt*xspfac)
-16 continue
-c
-c ???? where is nb set??? nb probably in left over from makeabar
-c
- esk = feon(space(nb)*squez(nb))
- ptsdflt = esk*poenom-wheadpt
-c if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then
- if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0
- * .and. .not.putmbr) then
-c
-c Must ADD hardspace! So put in a placeholder, and store params for later.
-c
- if (islast) write(11,'(a)')sq//'xardspace{ pt}%'
- nhssys = nhssys+1
- if (ptsndb-ptsdflt .gt. ptsgnd-poenom*eskgnd) then
- hesk(nhssys) = esk
- hpts(nhssys) = ptsndb+wheadpt
- else
- hesk(nhssys) = eskgnd
- hpts(nhssys) = ptsgnd+wheadpt
- end if
- fixednew = fixednew+hpts(nhssys)
- scaldold = scaldold+hesk(nhssys)
- end if
- if (clchb) then
- do 17 iv = 1 , nv
- if (clchv(iv)) then
- notexq = sq//'znotes'
- lnote = 7
- do 24 iiv = 2 , iv
- notexq = notexq(1:lnote)//sepsymq(iiv-1)
- lnote = lnote+1
-24 continue
-c
-c Recompute ioff since it will vary from voice to voice
-c
- if (ibar .eq. 1) then
- ioff = 0
- else
- ioff = nib(iv,ibar-1)
- end if
-c
-c Must call clefsym to get nclef, even if there is a movement break
-c
- call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef)
-c
-c If clefq = '8', must change '0' in pos'n 9 to '8'
-c
- if (btest(ipl(iv,ioff+1),2)) fmtq =
- * fmtq(1:8)//'8'//fmtq(10:10)
- if (movbrk.eq.0 .and.
- * islast)
- * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%'
- call wsclef(iv,ninow,nclef)
-c
-c Set new flag to be used just outside this loop, to kluge
-c any calls to \CenterBar for full-bar rests, to make room for clef.
-c
- newclef = .true.
-c
-c 151220
-c wrong test:
-c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
-c Replaced with right one. But also, clefq(iv) seems to stay at 8 here,
-c and if we change from TLO to normal clef, need to resetclefsymbols
-c
-c if (clefq(iv) .eq. '8') then
- if (btest(ipl(iv,ioff+1),2)) then
-c
-c Find instrument number for voice iv
-c
- iv1 = 1
- do 1111 iinst = 1 , ninow
- if (iv .lt. iv1+nspern(iinst)) go to 2222
- iv1 = iv1+nspern(iinst)
-1111 continue
- print*
- print*,'Should not be here in pmxb!'
- call stop1()
-2222 continue
- if (iinst .le. 9) then
- write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iinst,
- * sq//'treblelowoct%'
- else
- write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iinst,
- * sq//'treblelowoct%'
- end if
- c8flag(iv) = .true.
- else
- if (clefq(iv) .eq. '8') then
- write(11,'(a20)')sq//'resetclefsymbols'
- end if
- end if
- end if
-17 continue
- if (islast) write(11,'(a)')sq//'pmxnewclefs'
- end if
-23 continue
-c
-c Kluge \CenterBar for whole bar rests if necessary
-c
- if (newclef .and. centrests) then
-c write(11,'(a)')sq//'def'//sq//'value{11}%'
- nvalue = nint(.55*musicsize)
- if (nvalue .gt. 10) then
- write(11,'(a11,i2,a2)')
- * sq//'def'//sq//'value{',nvalue,'}%'
- else
- write(11,'(a11,i1,a2)')
- * sq//'def'//sq//'value{',nvalue,'}%'
- end if
- end if
- newclef = .false.
- centrests = .false.
-c
-c End of loop for end-of-bar hardspaces and non-movbrk clef symbol.
-c
- if (bar1syst) then
- read(12,*) poenom
- end if
-c
-c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1)
-c
- if (ibar .eq. 1) then
- islnow = islur(1,1)
-c iornqnow = iornq(1,1)
- iplnow = ipl(1,1)
- else
- islnow = islur(1,nib(1,ibar-1)+1)
-c iornqnow = iornq(1,nib(1,ibar-1)+1)
- iplnow = ipl(1,nib(1,ibar-1)+1)
- end if
-c
-c Check for R-symbols set at end of prior input block
-c
- if (movbrk.eq.0 .and. rptfq2.ne.'E') then
- if (rptfq2 .eq. 'D') then
- islnow = ibset(islnow,26)
- else if (rptfq2 .eq. 'r') then
- islnow = ibset(islnow,6)
- else if (rptfq2 .eq. 'd') then
- islnow = ibset(islnow,8)
- else if (rptfq2 .eq. 'b') then
- islnow = ibset(islnow,25)
- else
- print*
- print*,'Illegal symbol with "R" at end of input block:',
- * rptfq2
- call stop1()
- end if
- rptfq2 = 'E'
- end if
- if (iand(islnow,352) .ne. 0) then
-c
-c Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set
-c
- lrpt = btest(islnow,5)
- rrpt = btest(islnow,6)
- lrptpend = lrpt.and.bar1syst
- if (lrpt .and. .not.lrptpend) then
- if (rrpt) then
- if (islast) write(11,'(a)')sq//'setleftrightrepeat'
- fixednew = fixednew+wheadpt*lrrptfac-0.4
- else
- if (islast) write(11,'(a)')sq//'setleftrepeat'
- fixednew = fixednew+wheadpt*rptfac-0.4
- end if
- else if (rrpt) then
- if (islast) write(11,'(a)')sq//'setrightrepeat'
- fixednew = fixednew+wheadpt*rptfac-0.4
- else if (btest(islnow,8)) then
- if (islast) write(11,'(a)')sq//'setdoublebar'
- fixednew = fixednew+wheadpt*dbarfac-0.4
- end if
- else if (btest(islnow,26)) then
-c
-c doubleBAR
-c
- if (islast) write(11,'(a)')sq//'setdoubleBAR'
- fixednew = fixednew+wheadpt*ddbarfac-0.4
-c else if (btest(iornqnow,29)) then
- else if (btest(iplnow,0)) then
-c
-c no bar line
-c
-c-- if (islast) write(11,'(a)')sq//'setzalaligne'
-c++
- if (islast) then
- if (movbrk .eq. 0) then
- write(11,'(a)')sq//'setzalaligne'
- else
-c
-c Encountered "Rz" at start of input block at start of new movement, Must
-c use newmovement macro with arg 4 rather than setzalaligne, since former
-c already redefines stoppiece.
-c
- rptfq2 = 'z'
- end if
- end if
-c++
- fixednew = fixednew-0.4
- end if
-c
-c 1st and 2nd endings
-c
- svolta = btest(islnow,7)
- evolta = btest(islnow,9)
- if (evolta) then
- if (btest(islnow,10)) then
- if (islast) write(11,'(a)')sq//'endvoltabox'
- else
- if (islast) write(11,'(a)')sq//'endvolta'
- end if
- onvolt = .false.
- end if
- if (svolta) then
- nvolt = nvolt+1
- lvoltxt = index(voltxtq(nvolt),' ')-1
- if (lvoltxt .eq. 1) then
- if (islast) write(11,'(a)')sq//'Setvolta'
- * //voltxtq(nvolt)(1:1)//'%'
- else
- if (islast) write(11,'(a)')sq//'Setvolta'//'{'//
- * voltxtq(nvolt)(1:lvoltxt)//'}%'
- end if
- onvolt = .true.
- end if
- if (ibar .gt. 1) then
- ipnow = nib(1,ibar-1)+1
- else
- ipnow = 1
- end if
- iplnow = ipl(1,ipnow)
- if (bar1syst) then
-c
-c If listslur>0, then there is at least one slur or tie carried over the break
-c
- ispstie = .false.
- if (OptLineBreakTies .and. .not.fontslur .and. listslur.ne.0
- * .and. islast)
- * call LineBreakTies(isdat1,isdat2,isdat3,isdat4, nsdat,
- * ispstie,sepsymq)
- iline = iline+1
-c
-c End an old system, Start a new system
-c
-c Reduce space before mbrest at start of system
-c Need this even if no accidentals in key signature
-c
- if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize
-c
- if (iline .ne. 1) then
-c
-c Not first line.
-c Get corrected poe = points/elemskip for *previous* system
-c
- wdpt = widthpt*(1-fracindent)
- poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
- * (elsktot+fbar*nbarss-scaldold)
- isyscnt = isyscnt+1
- poevec(isyscnt) = poe
-c
-c Transfer data for system into global arrays to hold until very end
-c
- do 9 ia = 1 , nasksys
- iask = iask+1
- ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))
- * /poefa(iline-1)
-c
-c Only admit negative ask if it was user-defined space, signalled by elask<=0.
-c
- if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
-9 continue
- do 25 ia = 1 , nhssys
- nhstot = nhstot+1
- hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
-25 continue
-c
-c Reset counters for new system
-c
- scaldold = 0.
- fixednew = 0.
- nasksys = 0
- nhssys = 0
- end if
-c
-c End of if block for first bar of non-first system. Still 1st bar, any system
-c
- if (islast.and.figbass) write(11,'(a)')sq//'fixdrop%'
- isystpg = isystpg+1
-c
-c Try moving the next stmt way down, to fix a bug and get \eject printed at
-c end of single-system page.
-c if (isystpg .eq. nsystp(ipage)) isystpg = 0
- read(12,*)nbarss,elsktot,fsyst,frac,eonk,ewmxk
- if (iline .gt. 1) fracindent=frac
- if (figbass) then
- ifigdr(1,iline) = 4
- ifigdr(2,iline) = 4
- end if
- slfac = slfac1*musicsize*elsktot
- if (iline .ne. 1) then
-c
-c For the line just _finished_, put figdrop in separate file.
-c
- if (figbass) write(14,'(a9,i2,a10,i2,1x,a4)')
- * sq//'figdrop=',ifigdr(1,iline-1),
- * ' '//sq//'figdtwo=',ifigdr(2,iline-1),sq//'or%'
-c
-c Check slurs in top staff for interference w/ barno. Only check when
-c # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS
-c keep track of ons and offs when |isig|<=3.
-c
- ndigbn = int(alog10(ibarcnt+ibcoff+.01))+1
- isnx = 0
- if (ndigbn.ge.iabs(isig) .and. is1n1.gt.0) then
-c
-c There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1
-c Look for termination in remainder of this input block. If not found,
-c just use is1n1. Remember, haven't slid down yet.
-c
- ioff = 0
- if (ibar .gt. 1) ioff = nib(ivmx(nv,nvmx(nv)),ibar-1)
- do 50 isdat = 1 , nsdat
- if (igetbits(isdat1(isdat),5,13).eq.ivmx(nv,nvmx(nv))
- * .and. .not.btest(isdat1(isdat),11)
- * .and. igetbits(isdat1(isdat),7,19).eq.is2n1) then
-c
-c Found slur ending. Just check note height, can't do fine adjustments.
-c
-c is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19))
- is1n1 = max(is1n1,igetbits(isdat2(isdat),7,19))
- go to 51
- end if
-50 continue
-c
-c If exiting loop normally, did not find end of slur. c'est la vie.
-c
-51 continue
- isnx = idim(is1n1,ncmid(nv,1)+1+irzbnd)
- if (isnx .gt. 0) then
-c
-c AHA! Slur likely to interfere with barno.
-c
-c Modified 090525 to use \bnrs
-c
- slint = .true.
- fmtq = '(a16,i1,a14)'
- if (irzbnd+isnx .gt. 9) fmtq = '(a16,i2,a14)'
- if (islast) write(11,fmtq)sq//'def'//sq//'raisebarno{',
- * irzbnd+isnx,'.5'//sq//'internote}%'
-c if (islast) then
-c if (isnx .le. 9) then
-c write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%'
-c else
-c write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%'
-c end if
-c end if
-c
- end if
- end if
- if (movbrk .gt. 0) then
-c
-c movbrk = 0
-c Move the reset down, so can use movbrk>0 to stop extra meter prints.
-c
-c New movement. Redefine stoppiece, contpiece. These will be called either
-c explicitly or as part of alaligne.
-c indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat.
-c This is passed to \newmovement.
-c
- if (rptfq2 .eq. 'E') rptfq2 = 'D'
- indsym = index('Ddrbz',rptfq2)-1
- rptfq2 = 'E'
-c
-c Also check for Rd or Rr set the normal way
-c
- if (btest(islnow,8)) then
- indsym = 1
- else if (btest(islnow,6)) then
- indsym = 2
- end if
- if (indsym .lt. 0) then
- print*
- print*,'Illegal end symbol before "/"'
- call stop1()
- end if
-c
-c Check for continuation (no bar number reset)
-c
- if (islast.and.nobar1) then
- write(11,'(a)')sq//'advance'//sq//'barno1'
- * //sq//'global'//sq//'startbarno'//sq//'barno%'
-c
-c Need above for shortening case mcm with Mc
-c
- end if
-c
-c Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement
-c
-c if (movgap .lt. 10) then
-c if (islast) write(11,'(a12,2i1,a1)')
-c * sq//'newmovement',movgap,indsym,'%'
-c else
-c if (islast) write(11,'(a13,i2,a1,i1,a1)')
-c * sq//'newmovement{',movgap,'}',indsym,'%'
-c end if
- if (islast) then
- nmq = sq//'newmovement'
- lnmq = 12
- if (movgap .lt. 10) then
- lnmq = 14
- write(nmq(13:14),'(2i1)')movgap,indsym
- else
- lnmq = 17
- write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym
- end if
- if (ninow .lt. 10) then
- lnmq = lnmq+1
- write(nmq(lnmq:lnmq),'(i1)')ninow
- else
- lnmq = lnmq+4
- write(nmq(lnmq-3:lnmq),'(a1,i2,a1)')'{',ninow,'}'
- end if
- lnmq = lnmq+1
- write(nmq(lnmq:lnmq),'(a1)')'%'
- if (ishort .eq. 4) then
-c
-c Ending Short-blank-coda
-c
- write(11,'(a)')sq//'Endpiece}}%'
- end if
- write(11,'(a)')nmq(1:lnmq)
- if (ishort .eq. 2) then
- write(11,'(a)')sq//'stoppiece}}%'
- ishort = 5
- else if (ishort .eq. 4) then
- write(11,'(a)')sq//'let'//sq//'stoppiece'//sq//
- * 'holdstop%'
-c
-c Since we bypass newmovement, need to set the vertical gap.
-c
- if (movgap .gt. 10) then
- write(11,'(a6,i2,a11)')
- * sq//'vskip',movgap,sq//'internote%'
- else if (movgap .gt. 0) then
- write(11,'(a6,i1,a11)')
- * sq//'vskip',movgap,sq//'internote%'
- end if
- ishort = 6
- end if
- if ((ishort.eq.5.or.ishort.eq.6).and..not.rename) then
- do 62 iinst = 1 , ninow
- if (islast) then
- if (iinst .lt. 10) then
- write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%'
- else
- write(11,'(a9,i2,a4)')sq//'setname{',iinst,
- * '}{}%'
- end if
- end if
-62 continue
- end if
- rename = .false.
- end if
-c
-c Change generalmeter if necessary
-c
- if (islast) then
- call wgmeter(mtrnmp,mtrdnp)
- end if
- mtrnuml = 0
-c
-c (Moved all name-writing to getnote, right when 'M' is detected)
-c
- if (btest(iplnow,28)) then
-c
-c Key signature at movement break
-c
- iplnow = ibclr(iplnow,28)
- if (isig .gt. 0) then
- if (islast) write(11,'(a18,i1,a2)')
- * sq//'generalsignature{',isig,'}%'
- else
- if (islast) write(11,'(a18,i2,a2)')
- * sq//'generalsignature{',isig,'}%'
- end if
- if (islast .and. LaterInstTrans) then
- call Writesetsign(nInstTrans,iInstTrans,iTransKey,
- * LaterInstTrans)
- end if
- end if
- if (parmov .ge. -.1) then
-c
-c Resent paragraph indentation
-c
- ipi = parmov*widthpt+.1
- if (ipi .lt. 10) then
- if (islast) write(11,'(a11,i1,a2)')
- * sq//'parindent ',ipi,'pt'
- else if (ipi .lt. 100) then
- if (islast)
- * write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
- else
- if (islast)
- * write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
- end if
- end if
- if (ishort .eq. 6) then
- if (iflagbot .eq. 1) then
- write(11,'(a)')sq//'vfill'//sq//'eject'
-c iflagbot = 0
-c ishort = 0
- else
- write(11,'(a)')sq//'contpiece'
- end if
-c
-c Zero ishort later trying to write alaligne
-c
- end if
- end if ! End of movement break stuff
- if (isystpg .eq. 1) then
-c
-c First line on a page (not 1st page, still first bar). Tidy up old page
-c then eject.
-c
-c Removed this 5/13/01 as it was causing double endvoltas. This probably
-c is only needed at the end in case there is no endvolta specified.
-c if (onvolt) then
-cc if (islast) write(11,'(a)')sq//'endvoltabox%'
-cc onvolt = .false.
-c end if
-c
-c
-c Check for meter change at start of a new PAGE
-c
- if (mtrnuml .gt. 0) then
-c
-c Meter change at start of a new page. Ugly repeated coding here.
-c
- mtrnms = mtrnuml
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- mtrnuml = mtrnms
- if (movbrk .eq. 0 .and. islast) then
- call wgmeter(mtrnmp,mtrdnp)
- end if
- end if
-c
-c Key signature change?
-c
- if (btest(iplnow,28) .and. movbrk.eq.0) then
- notexq = sq//'xbar'//sq//'addspace{-'//sq//
- * 'afterruleskip}'//sq//'generalsignature{'
- lnote = 49
- if (isig .lt. 0) then
- notexq = notexq(1:49)//'-'
- lnote = 50
- end if
- if (islast) write(11,'(a)')
- * notexq(1:lnote)//chax(48+abs(isig))//'}%'
- if (islast .and. LaterInstTrans) then
- call Writesetsign(nInstTrans,iInstTrans,iTransKey,
- * LaterInstTrans)
- end if
- if (islast .and. ignorenats)
- * write(11,'(a)')sq//'ignorenats%'
- if (islast) write(11,'(a)')sq//'zchangecontext'//sq
- * //'addspace{-'//sq//'afterruleskip}'
- * //sq//'zstoppiece'//sq//'PMXbarnotrue%'
- else if (mtrnuml.gt.0 .and. movbrk.eq.0) then
-c
-c Meter change but no signature change
-c
- if (islast)
- * write(11,'(a)')sq//'xchangecontext'//sq//'addspace{-'//
- * sq//'afterruleskip}'//sq//'let'//sq//'bnat'//sq//
- * 'barnoadd%'
- if (islast)
- * write(11,'(a)')sq//'def'//sq//'barnoadd{'//sq//'let'//
- * sq//'barnoadd'//sq//'bnat}'//sq//'zstoppiece%'
- else
- if (islast) then
- if ((ishort.eq.4.or.ishort.eq.2)
- * .and. iflagbot.eq.1) then
- ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
- if (ntmp .le. 9) then
- shortfraq(1:1) = char(48+ntmp)
- lntmp = 1
- else
- write(shortfraq(1:2),'(i2)')ntmp
- lntmp = 2
- end if
- write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq
- * //'barno'//shortfraq(1:lntmp)
-c
-c Move down so can insert fil@begin
-c iflagbot = 0
-c ishort = 0
-c
- else if ((ishort.ne.6.and.ishort.ne.2) .or.
- * iflagbot.ne.1) then
- write(11,'(a)')sq//'stoppiece%'
- end if
- end if
- end if
-c
-c This is the key spot when vshrink is used. Value of vshrink here comes from
-c just after the prior pagebreak, i.e., it is not affected by "Av"
-c that may have been entered at this pagebreak, since that only affects usevshrink.
-c So choose page *ending* (with or without \vfill) depending on old vshrink. Then
-c check value of usevshrink to reset vshrink if necessary for the new page, where
-c we have to set \interstaff and later call puttitle.
-c Top of first page needs special treatment. For this we use
-c novshrinktop, which was set in g1etnote on the first pass, since on
-c second pass, vshrink at top of page one is dealt with in topfile, which is called
-c *before* any reading in any "Av" at the top of the first input block.
-c
- if (.not.vshrink) then
- if (islast .and. bottopgap) then
- if (abs(botamt) .gt. 1.e-6) then
- if (botamt .gt. 9.95) then
- fmtq = '(a,f4.1,a)'
- else if (botamt .gt. 0.) then
- fmtq = '(a,f3.1,a)'
- else if (botamt .gt. -9.95) then
- fmtq = '(a,f4.1,a)'
- else
- fmtq = '(a,f5.1,a)'
- end if
- write(11,fmtq)sq//'null'//sq//'vskip',botamt,
- * sq//'Internote%'
- end if
- end if
- xnstbot = xnsttop(ipage)*etabot/etatop
- if (xnstbot .lt. 9.95) then
- fmtq = '(a,f3.1,a)'
- else
- fmtq = '(a,f4.1,a)'
- end if
- if (islast) write(11,fmtq)sq//'vskip',xnstbot,
- * sq//'Interligne'//sq//'eject%'
- if (islast .and. bottopgap) then
- if (abs(topamt) .gt. 1.e-6) then
- if (topamt .gt. 9.95) then
- fmtq = '(a,f4.1,a)'
- else if (topamt .gt. 0.) then
- fmtq = '(a,f3.1,a)'
- else if (topamt .gt. -9.95) then
- fmtq = '(a,f4.1,a)'
- else
- fmtq = '(a,f5.1,a)'
- end if
- write(11,fmtq)sq//'null'//sq//'vskip',topamt,
- * sq//'Internote%'
- end if
- bottopgap = .false.
- end if
- else
- if (islast) then
- if (iflagbot.eq.1.and.ishort.eq.6)then
-c
-c cleanup for case bcm only
-c
- iflagbot = 0
- ishort = 0
- else
- write(11,'(a)') sq//'vfill'//sq//'eject%'
- if (iflagbot.eq.1.and.ishort.eq.2) then
-c Clean up case bsl only
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- iflagbot = 0
- ishort = 0
- end if
- end if
- end if
- end if
- ipage = ipage+1
-c
-c Now that page is ejected, compute new vshrink
-c
- vshrink = xintstaff(ipage).gt.20 .and. usevshrink
- if (vshrink) then
- xinsnow = 10
- else
- xinsnow = xintstaff(ipage)
- end if
- if (fintstf.gt.0 .and. ipage.gt.1) then
- xinsnow = xinsnow*fintstf/gintstf
- fintstf = -1.
- end if
- if (xinsnow .lt. 9.95) then
- fmtq = '(a,f3.1,a)'
- else if (xinsnow .lt. 99.95) then
- fmtq = '(a,f4.1,a)'
- else
- fmtq = '(a,f5.1,a)'
- end if
-c
-c Vertical spacing parameters, then restart
-c
- if (is4bignv) xinsnow = .95*xinsnow
- if (islast) then
- write(11,fmtq)sq//'interstaff{',xinsnow,
- * '}'//sq//'contpiece'
- end if
-c
-c Check for meter change at start of a new PAGE
-c
- if (mtrnuml .gt. 0) then
-c
-c Meter change at start of a new page
-c
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- if (movbrk .eq. 0) then
- if (islast) then
- call wgmeter(mtrnmp,mtrdnp)
- end if
- if (mtrdnp .gt. 0) then
- if (islast) write(11,'(a)')sq//'newtimes2%'
- if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
- end if
- end if
- end if
-c
-c If no real titles here, which there probably will never be, make vertical
-c space at page top with \titles{...}. headlog=.false.<=>no real titles
-c
- if (ishort.eq.4 .and. iflagbot.eq.1) then
- ishort = 0
- iflagbot = 0
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'//sq//
- * 'makeatother'
- end if
- call puttitle(inhnoh,xnsttop(ipage),etatop,
- * sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
- if (HeaderSpecial)
-c
-c Write special header for first page
-c
- * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
- else
-c
-c First bar of system, not a new page, force line break
-c
- if (btest(iplnow,28)) then
-c
-c Signature change
-c
- notexq = sq//'xbar'//sq//'addspace{-'//sq//
- * 'afterruleskip}'//sq//'generalsignature{'
- lnote = 49
- if (isig .lt. 0) then
- notexq = notexq(1:49)//'-'
- lnote = 50
- end if
- if (islast) write(11,'(a)')notexq(1:lnote)
- * //chax(48+abs(isig))//'}%'
- if (islast .and. LaterInstTrans) then
- call Writesetsign(nInstTrans,iInstTrans,iTransKey,
- * LaterInstTrans)
- end if
- if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
- if (mtrnuml .ne. 0) then
-c
-c Meter+sig change, new line, may need mods if movement break here.
-c
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- if (islast) then
- call wgmeter(mtrnmp,mtrdnp)
- if (ignorenats) write(11,'(a)')sq//'ignorenats%'
- write(11,'(a)')sq//'xchangecontext'//sq//
- * 'addspace{-'//sq//'afterruleskip}'
- * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
- write(11,'(a)')sq//'addspace{-'//sq
- * //'afterruleskip}%'
- call wgmeter(mtrnmp,mtrdnp)
- if (ignorenats) write(11,'(a)')sq//'ignorenats%'
- write(11,'(a)')sq//'zchangecontext'
- end if
- else
- if (islast .and. ignorenats)
- * write(11,'(a)')sq//'ignorenats%'
- if (islast) write(11,'(a)')sq//'xchangecontext'//sq//
- * 'addspace{-'//sq//'afterruleskip}'
- * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
- end if
- else if (mtrnuml.eq.0.and.(ishort.eq.0.or.ishort.eq.6))
- * then
-c
-c No meter change
-c
- if (islast) then
- if (ishort .ne. 6) then
- write(11,'(a)')sq//'alaligne'
- else
- ishort = 0
- end if
- end if
- else if (ishort .ne. 0) then
- if (ishort .eq. 1) then ! Start short line
- write(shortfraq,'(f3.2)')shortfrac
- write(11,'(a)')sq//'stoppiece'//sq//'parindent 0pt'
- write(11,'(a)')sq//'vskip'//sq//'parskip'
- write(11,'(a)')sq//'hbox to'//sq//
- * 'hsize{'//sq//'vbox{'//
- * sq//'hsize='//shortfraq//sq//'hsize%'
- write(11,'(a)')sq//'contpiece'
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- ibarcnt0 = ibarcnt
- mbrsum = 0
- ishort = 2
- nmbr = 0
- else if (ishort .eq. 2) then ! End short line, no new mvt
- ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
- if (ntmp .le. 9) then
- shortfraq(1:1) = char(48+ntmp)
- lntmp = 1
- else
- write(shortfraq(1:2),'(i2)')ntmp
- lntmp = 2
- end if
- write(11,'(a)')sq//'stoppiece}}'//sq//'advance'//sq
- * //'barno'//shortfraq(1:lntmp)
-c
-c Not clear why we needed this
-c //sq//'startbarno'//sq//'barno%'
- write(11,'(a)')sq//'contpiece'
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- ishort = 0
- else if (ishort .eq. 5) then ! End short line, new mvt
- if (nobar1) then ! Continue bar numbering
- write(11,'(a)')sq//'advance'//sq
- * //'barno'//char(ibarcnt-ibarcnt0+48)
- * //sq//'startbarno'//sq//'barno%'
-c
-c Must leave in \startbarno to get msm with LMc to work.
-c
- end if
- write(11,'(a)')sq//'startpiece'//sq//'addspace'//sq
- * //'afterruleskip%'
- ishort = 0
- else if (ishort .eq. 3) then ! Mid line gap, start coda
-c May never come thru here. Stuff is done later at least for mcl.pmx
- write(shortfraq,'(f3.2)')codafrac
- write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq
- * //'barno'//char(ibarcnt-ibarcnt0+48)//sq//
- * 'startbarno'//sq//'barno%'
- write(11,'(a)')sq//'hfill'//sq//
- * 'vbox{'//sq//'hsize='//shortfraq//'%'
- write(11,'(a)')sq//'contpiece'
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- ishort = 4
- else if (ishort .eq. 4) then ! End coda
- ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
- if (ntmp .le. 9) then
- shortfraq(1:1) = char(48+ntmp)
- lntmp = 1
- else
- write(shortfraq(1:2),'(i2)')ntmp
- lntmp = 2
- end if
- write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq
- * //'barno'//shortfraq(1:lntmp)
- write(11,'(a)')sq//'contpiece'
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- ishort = 0
- mbrsum = 0
- nmbr = 0
- end if
- else if (mtrnuml .ne. 0) then
-
-c
-c New meter, no new sig, end of line, not new page.
-c
-c \generalmeter{\meterfrac{3}{4}}%
-c \xchangecontext\addspace{-\afterruleskip}%
-c \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}%
-c \zchangecontext
-c
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- if (movbrk .eq. 0) then
- if (islast) then
- call wgmeter(mtrnmp,mtrdnp)
- end if
- if (mtrdnp .gt. 0) then
- if (islast) then
- write(11,'(a)')
- * sq//'let'//sq//'bnat'//sq//'barnoadd'
- * //sq//'def'//sq//'barnoadd{'//sq//'empty}%'
- write(11,'(a)')sq//'xchangecontext'//sq//
- * 'addspace{-'//sq//'afterruleskip}'//sq//
- * 'zalaligne'//sq//'let'//sq//'barnoadd'//sq//'bnat'
- call wgmeter(mtrnmp,mtrdnp)
- write(11,'(a)')sq//'addspace{-'//sq//
- * 'afterruleskip}'//sq//'zchangecontext'
- end if
- if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
- else
- if (islast) write(11,'(a)')sq//'alaligne'
- end if
- else
- if (islast) write(11,'(a)')sq//'alaligne'
- end if
- end if
- end if
-c
-c Modified 090525 to use \bnrs
-c
- if (slint) then
- slint = .false.
- if (islast) write(11,'(a16,i1,a14)')sq//'def'//sq//
- * 'raisebarno{',irzbnd,'.5'//sq//'internote}%'
- end if
- movbrk = 0
- end if
-c
-c Clean up if we squelched bar number reset at movement break
-c
- if (nobar1) then
- if (islast) write(11,'(a)')sq//'startbarno1'
- nobar1 = .false.
- end if
- read(12,*,end=14)iauto
-14 continue
-c
-c We come thru here for the 1st bar of every system, so initialize is1n1
-c
- is1n1 = 0
-c
-c Brought down from above
-c
- if (isystpg .eq. nsystp(ipage)) then
- isystpg = 0
-c
-c The following is to avoid moving this reset of isystpg, but still send a signal
-c down below for last system shortening events
-c
- if (ishort.eq.2) iflagbot = 1
- end if
-c
-c Check for linebreak ties
-c
- if (ispstie)
- * call LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
- * ispstie,sepsymq)
- else
-c
-c Not first bar of system
-c
- if (btest(iplnow,28)) then
-c
-c Signature change
-c
- if (mtrnuml .ne. 0) then
-c
-c Meter+signature change mid line, assume no movement break
-c
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- if (islast) call wgmeter(mtrnmp,mtrdnp)
- notexq = sq//'generalsignature{'
- lnote = 18
- if (isig .lt. 0) then
- notexq = notexq(1:18)//'-'
- lnote = 19
- end if
- if (islast) then
- iptemp = 48+abs(isig)
- charq = chax(iptemp)
- notexq = notexq(1:lnote)//charq//'}%'
- lnote = lnote+3
- write(11,'(a)')notexq(1:lnote)
- if (islast .and. LaterInstTrans) then
- call Writesetsign(nInstTrans,iInstTrans,iTransKey,
- * LaterInstTrans)
- end if
- if (ignorenats) write(11,'(a)')sq//'ignorenats%'
- write(11,'(a)')sq//'xchangecontext%'
- end if
- if (ibar .eq. ibarmbr) then
-c
-c Compute space for multibar rest
-c
- if (lastisig*isig .ge. 0) then
- naccs = max(abs(lastisig),abs(isig))
- else
- naccs = abs(lastisig-isig)
- end if
-c xb4mbr = (facmtr+naccs*.24)*musicsize
- xb4mbr = -.2*musicsize
- end if
- else
-c
-c Signature change only
-c
- notexq = sq//'xbar'//sq//'addspace{-'//sq//
- * 'afterruleskip}'//sq//'generalsignature{'
- lnote = 49
- if (isig .lt. 0) then
- notexq = notexq(1:49)//'-'
- lnote = 50
- end if
- if (islast)
- * write(11,'(a)')notexq(1:lnote)//chax(48+abs(isig))//'}%'
- if (islast .and. LaterInstTrans) then
- call Writesetsign(nInstTrans,iInstTrans,iTransKey,
- * LaterInstTrans)
- end if
- if (islast .and. ignorenats)
- * write(11,'(a)')sq//'ignorenats%'
- if (islast) write(11,'(a)')sq//'zchangecontext'//sq
- * //'addspace{-.5'// sq//'afterruleskip}%'
- if (ibar .eq. ibarmbr) then
-c
-c Compute space for multibar rest
-c
- if (lastisig*isig .ge. 0) then
- naccs = max(abs(lastisig),abs(isig))
- else
- naccs = abs(lastisig-isig)
- end if
-c xb4mbr = naccs*.24*musicsize
- xb4mbr = -.2*musicsize
- end if
- end if
- else if (ishort .eq. 3) then
-c
-c Gap before coda, assumed no signature change!
-c
- ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
- if (ntmp .le. 9) then
- shortfraq(1:1) = char(48+ntmp)
- lntmp = 1
- else
- write(shortfraq(1:2),'(i2)')ntmp
- lntmp = 2
- end if
- write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq
- * //'barno'//shortfraq(1:lntmp)
- if (nocodabn) then
- write(11,'(a)')sq//'nobarno'
- nocodabn = .false.
- end if
- write(shortfraq,'(f3.2)')codafrac
- write(11,'(a)')sq//'hfill'//sq//
- * 'vbox{'//sq//'hsize='//shortfraq//sq//'hsize%'
- write(11,'(a)')sq//'contpiece'
- write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
- * //sq//'makeatother'
- ishort = 4
- else if (mtrnuml .eq. 0) then
-c
-c No meter change
-c
- if (islast) write(11,'(a)')sq//'xbar'
- else
-c
-c Change meter midline
-c
- call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
- if (movbrk .eq. 0) then
- if (islast) then
- call wgmeter(mtrnmp,mtrdnp)
- end if
- if (mtrdnp .gt. 0) then
- if (islast) then
- write(11,'(a,2i1,a)')sq//'newtimes0%'
- end if
-c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize
- if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
- else
- if (islast) write(11,'(a)')sq//'xbar'
- end if
- end if
- end if
- end if
-c
-c Now that xbar's are written, can put in left-repeats at line beginnings
-c
- if (lrptpend) then
- if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1'
- * //sq//'leftrepeat'
- lrptpend = .false.
- end if
- if (ibar .gt. 1) then
-c
-c For bars after first, slide all stuff down to beginning of arrays
-c
- do 11 iv = 1 , nv
- do 11 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- ioff = nib(ivx,ibar-1)
- do 12 ip = 1 , nib(ivx,ibar)-ioff
- nolev(ivx,ip) = nolev(ivx,ip+ioff)
- nodur(ivx,ip) = nodur(ivx,ip+ioff)
- nacc(ivx,ip) = nacc(ivx,ip+ioff)
- irest(ivx,ip) = irest(ivx,ip+ioff)
- islur(ivx,ip) = islur(ivx,ip+ioff)
- ipl(ivx,ip) = ipl(ivx,ip+ioff)
- iornq(ivx,ip) = iornq(ivx,ip+ioff)
- mult(ivx,ip) = mult(ivx,ip+ioff)
- if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
- if (ivx.eq.1) then
- isfig(1,ip) = isfig(1,ip+ioff)
- else
- isfig(2,ip) = isfig(2,ip+ioff)
- end if
- end if
-12 continue
- if (ivx.le.nv .and. ncc(iv).gt.1) then
- islide = 0
- do 13 icc = 1 , ncc(iv)
- if (tcc(iv,icc) .le. lenbar) then
-c
-c This time will drop <=0 when slid.
-c
- islide = icc-1
- ncmidcc(iv,1) = ncmidcc(iv,icc)
- else
- tcc(iv,icc-islide) = tcc(iv,icc)-lenbar
- ncmidcc(iv,icc-islide) = ncmidcc(iv,icc)
- end if
-13 continue
- ncc(iv) = ncc(iv)-islide
- tcc(iv,1) = 0.
- end if
-11 continue
- do 15 ig = 1 , ngrace
- ipg(ig) = ipg(ig)-nib(ivg(ig),ibar-1)
- if (ibar .gt. 2) ipg(ig) = ipg(ig)+nib(ivg(ig),ibar-2)
-15 continue
- do 21 il = 1 , nlit
- iplit(il) = iplit(il)-nib(ivlit(il),ibar-1)
- if (ibar .gt. 2) iplit(il) = iplit(il)+nib(ivlit(il),ibar-2)
-21 continue
- do 22 it = 1 , ntrill
- iptrill(it) = iptrill(it)-nib(ivtrill(it),ibar-1)
- if (ibar .gt. 2) iptrill(it) =
- * iptrill(it)+nib(ivtrill(it),ibar-2)
-22 continue
- do 27 icrd = 1 , ncrd
- ivx = iand(15,ishft(icrdat(icrd),-8))
- * +16*igetbits(icrdat(icrd),1,28)
- ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1)
- if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
- icrdat(icrd) = iand(not(255),icrdat(icrd))
- icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd))
-27 continue
- do 29 iudorn = 1 , nudorn
- ivx = ivxudorn(iudorn)
- ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1)
- if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
- kudorn(iudorn) = iand(not(255),kudorn(iudorn))
- kudorn(iudorn) = ior(max(0,ipnew),kudorn(iudorn))
-29 continue
- do 42 idyn = 1 , ndyn
- idynd = idyndat(idyn)
- ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10)
- ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
-c
-c The following construction avoids array bound errors in some compilers
-c
- if (ibar .gt. 2) then
- ipnew = ipnew+nib(ivx,ibar-2)
- end if
- ipnew = dim(ipnew,0)
- call setbits(idynd,8,4,ipnew)
- idyndat(idyn) = idynd
-42 continue
- do 43 itxtdyn = 1 , ntxtdyn
- idynd = ivxiptxt(itxtdyn)
- ivx = iand(31,idynd)
- ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1)
- if (ibar .gt. 2) then
- ipnew = ipnew+nib(ivx,ibar-2)
- end if
- ipnew = dim(ipnew,0)
-c call setbits(idynd,8,4,ipnew)
- call setbits(idynd,8,5,ipnew)
- ivxiptxt(itxtdyn) = idynd
-43 continue
- do 41 isdat = 1 , nsdat
- isdata = isdat1(isdat)
- ivx = ivmx(igetbits(isdata,5,13),igetbits(isdata,1,12)+1)
- ipnew = igetbits(isdata,8,3)-nib(ivx,ibar-1)
- if (ibar .gt. 2) then
- ipnew = ipnew+nib(ivx,ibar-2)
- end if
- ipnew = dim(ipnew,0)
- call setbits(isdata,8,3,ipnew)
- isdat1(isdat) = isdata
-41 continue
- do 44 ibc = 1 , nbc
- ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
- ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1)
- if (ibar .gt. 2) then
- ipnew = ipnew+nib(ivx,ibar-2)
- end if
- ipnew = dim(ipnew,0)
- call setbits(ibcdata(ibc),8,4,ipnew)
-44 continue
- do 45 iarps = 1 , NumArpShift
- IpArpShift(iarps) =
- * IpArpShift(iarps)-nib(IvArpShift(iarps),ibar-1)
- if (ibar .gt. 2) then
- IpArpShift(iarps) =
- * IpArpShift(iarps)+nib(IvArpShift(iarps),ibar-2)
- end if
-45 continue
-c
-c Bookkeeping for figures. This will set nfigs = 0 if there are no figs left.
-c If there are figs left, it will reset all times relative to start of
-c current bar.
-c
- do 46 ivx = 1 , 2
- if (figbass) then
- islide = 0
- do 20 jfig = 1 , nfigs(ivx)
- if (itfig(ivx,jfig) .lt. lenbar) then
-c
-c This figure was already used
-c
- islide = jfig
- else
- itfig(ivx,jfig-islide) = itfig(ivx,jfig)-lenbar
- figq(ivx,jfig-islide) = figq(ivx,jfig)
- itoff(ivx,jfig-islide) = itoff(ivx,jfig)
- ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig)
- ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig)
- end if
-20 continue
- nfigs(ivx) = nfigs(ivx)-islide
- end if
- if (nfigs(2) .eq. 0) go to 47
-46 continue
-47 continue
- end if
-c
-c End of sliding down for bars after first in gulp.
-c
-c The following may not be needed by makeabar, but just in case...
-c
- if (firstgulp .and. lenb0.ne.0) then
- if (ibar .eq. 1) then
- lenbar = lenb0
- else
- lenbar = lenb1
- end if
- end if
-c
-c Equal line spacing stuff
-c
- if (equalize .and. bar1syst) then
- if (isystpg .eq. 1) then
- write(11,'(a)')sq//'starteq%'
- else if (isystpg .eq. nsystp(ipage)-1) then
- write(11,'(a)')sq//'endeq%'
- end if
- end if
- call make1bar(ibmrep,tglp1,tstart,cwrest,squez,
- * istop,numbms,istart)
- call make2bar(ninow,tglp1,tstart,cwrest,squez,
- * istop,numbms,istart,clefq)
-c
-c Hardspace before barline?
-c
- hardb4 = 0.
- do 35 iv = 1 , nv
- do 35 kv = 1 , nvmx(iv)
- ivx = ivmx(iv,kv)
- if (btest(irest(ivx,nn(ivx)),18)) then
- nudoff(ivx) = nudoff(ivx)+1
- hardb4 = max(hardb4,udoff(ivx,nudoff(ivx)))
- end if
-35 continue
- if (hardb4 .gt. 0.) then
- if (islast) write(11,'(a11,f5.1,a4)')sq
- * //'hardspace{',hardb4,'pt}%'
-c
-c This was causing an incorrect poe in an example, which did not affect main
-c spacing, but did cause an extra accidental space to be too small
-c
- fixednew = fixednew-hardb4
- end if
-10 continue
- firstgulp = .false.
- lenb0 = 0
- go to 30
-40 close(12)
- close(13)
- ilbuf = 1
- ipbuf = 0
- wdpt = widthpt
- if (iline .eq. 1) wdpt = widthpt*(1-fracindent)
- poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
- * (elsktot+fbar*nbarss-scaldold)
- poevec(nsyst) = poe
- if (.not.islast) then
- close(11)
- close(16)
- if (figbass) close(14)
- return
- end if
- do 19 ia = 1 , nasksys
- iask = iask+1
- ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))/poefa(iline)
- if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
-19 continue
- do 26 ia = 1 , nhssys
- nhstot = nhstot+1
- hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
-26 continue
- if (islast .and.
- * onvolt) write(11,'(a)')sq//'endvoltabox'
- rendq = '% '
- if (ishort .ne. 0) rendq = '}}%'
- if (rptfq2 .ne. 'E') then
-c
-c Terminal repeat. Right or double?
-c
- if (rptfq2 .eq. 'r') then
- if (islast) write(11,'(a)')sq//'setrightrepeat'
- * //sq//'endpiece'//rendq
- else if (rptfq2 .eq. 'd') then
- if (islast) write(11,'(a)')sq//'setdoublebar'//sq//'endpiece'
- * //rendq
- else if (rptfq2 .eq. 'b') then
- if (islast) write(11,'(a)')sq//'endpiece'//rendq
- else if (rptfq2 .eq. 'z') then
- if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece'
- * //rendq
- else
- print*
- print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
- write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
- if (islast) write(11,'(a)')sq//'Endpiece'
- end if
- else
- write(11,'(a)')sq//'Endpiece'//rendq
- end if
- if (.not.vshrink) then
- if (islast .and. bottopgap) then
- if (abs(botamt) .gt. 1.e-6) then
- if (botamt .gt. 9.95) then
- fmtq = '(a,f4.1,a)'
- else if (botamt .gt. 0.) then
- fmtq = '(a,f3.1,a)'
- else if (botamt .gt. -9.95) then
- fmtq = '(a,f4.1,a)'
- else
- fmtq = '(a,f5.1,a)'
- end if
- write(11,fmtq)sq//'null'//sq//'vskip',botamt,
- * sq//'Internote%'
- end if
- end if
- xnstbot = xnsttop(ipage)*etabot/etatop
- if (xnstbot .lt. 9.95) then
- fmtq = '(a,f3.1,a)'
- else
- fmtq = '(a,f4.1,a)'
- end if
- if (islast) write(11,fmtq)sq//'vskip',xnstbot,
- * sq//'Interligne'//sq//'eject'//sq//'endmuflex'
- if (islast) write(11,'(a)')sq//'bye'
- else
- if (islast) write(11,'(a)')
- * sq//'vfill'//sq//'eject'//sq//'endmuflex'
- if (islast) write(11,'(a)')sq//'bye'
- end if
- rewind(11)
- if (figbass) then
- write(14,'(a9,i2,a10,i2,1x,a5)')
- * sq//'figdrop=',ifigdr(1,iline),
- * ' '//sq//'figdtwo=',ifigdr(2,iline),sq//'fi}%'
- rewind(14)
- end if
- call askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
- if (.not.optimize) then
- print*
- print*,'Writing '
- * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
- print*,'Done with second PMX pass.'
- write(15,'(/,a)')'Writing '
- * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
- write(15,'(a)')' Done with second PMX pass. Now run TeX'
- end if
- return
- end
- subroutine poestats(nsyst,poe,poebar,devnorm)
- parameter (nks=125)
-c
-c Compute avg. & norm. std. dev. of poe.
-c
- real*4 poe(nks)
- sumx = 0.
- sumxx = 0.
- do 1 isyst = 1 , nsyst
- sumx = sumx+poe(isyst)
- sumxx = sumxx+poe(isyst)**2
-1 continue
- devnorm = sqrt(nsyst*sumxx/sumx**2-1)
- poebar = sumx/nsyst
- return
- end
- subroutine precrd(ivx,ip,nolevm,nacc,ipl,irest,udq,
- * twooftwo,icashft)
-c
-c Analyzes chords, data to be used with slurs on chords and plain chords.
-c Check for 2nds, shift notes if neccesary.
-c ipl(10) chord present
-c irest(20) set if any note is right shifted
-c irest(27) set if any note is left shifted
-c ipl(8|9) left|right shift main note
-c icrdat(23|24) ditto chord note
-c udq is updown-ness, needed to analyze 2nds.
-c levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note.
-c icrdot(icrd)(27-29) sequence order of chord note if accid, top down
-c
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- logical btest,is2nd,twooftwo
- integer*4 kicrd(10),levtabl(88)
- character*1 udq
- do 11 i = 1 , 88
- levtabl(i) = 0
-11 continue
- do 1 icrd1 = 1 , ncrd
- ivx1 = iand(15,ishft(icrdat(icrd1),-8))
- * +16*igetbits(icrdat(icrd1),1,28)
- ip1 = iand(255,icrdat(icrd1))
- if (ip1.eq.ip .and. ivx1.eq.ivx) go to 2
-1 continue
- print*
- print*,
- * 'Cannot find first chord note in precrd. Send source to Dr. Don!'
- call stop1()
-2 continue
- maxlev = nolevm
- minlev = nolevm
- levtabl(nolevm) = -1
- is2nd = .false.
- naccid = 0
- levmaxacc = -100
- levminacc = 1000
-c
-c Check 1st 3 bits of nacc for accid on main note of chord.
-c
- if (iand(7,nacc) .gt. 0) then
- naccid = 1
-c
-c Start list of notes with accid's. There will be naccid of them. kicrd=0 if main,
-c otherwise icrd value for note with accidental.
-c
- kicrd(1) = 0
- levmaxacc = nolevm
- levminacc = nolevm
-c
-c Start the level-ranking
-c
- icrdot0 = 1
- end if
- do 3 icrd2 = icrd1 , ncrd
- nolev = igetbits(icrdat(icrd2),7,12)
- levtabl(nolev) = icrd2
- maxlev = max(maxlev,nolev)
- minlev = min(minlev,nolev)
-c
-c Check for accidental
-c
- if (btest(icrdat(icrd2),19)) then
- naccid = naccid+1
- levmaxacc = max(levmaxacc,nolev)
- levminacc = min(levminacc,nolev)
-c
-c Add this icrd to list of values for notes with accid's.
-c
- kicrd(naccid) = icrd2
- if (.not.btest(nacc,28)) then
-c
-c Order not forced, so get the level-ranking, top down
-c
- iorder = 1
- do 12 iaccid = 1 , naccid-1
- if (kicrd(iaccid) .eq. 0) then
- if (nolevm .gt. nolev) then
- iorder = iorder+1
- else
- icrdot0 = icrdot0+1
- end if
- else
- if (igetbits(icrdat(kicrd(iaccid)),7,12)
- * .gt. nolev) then
- iorder = iorder+1
- else
- iold = igetbits(icrdot(kicrd(iaccid)),3,27)
- call setbits(icrdot(kicrd(iaccid)),3,27,iold+1)
- end if
- end if
-12 continue
- call setbits(icrdot(icrd2),3,27,iorder)
- end if
- end if
-c
-c Exit loop if last note in this chord
-c
- if (icrd2 .eq. ncrd) go to 4
- if (igetbits(icrdat(icrd2+1),8,0) .ne. ip .or.
-c * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4
- * igetbits(icrdat(icrd2+1),4,8)
- * +16*igetbits(icrdat(icrd2+1),1,28) .ne. ivx) go to 4
-3 continue
- print*
- print*,'Failed to find last chord note. Send source to Dr. Don!'
- call stop1()
-4 continue
-c
-c Now icrd1, icrd2 define range of icrd for this chord.
-c
-c Bypass autos-shifting if any manual shifts are present
-c
- if (btest(irest,20) .or. btest(irest,27)) go to 10
-c
-c Check for 2nds
-c
- do 5 ilev = 1 , 87
- if (levtabl(ilev).ne.0 .and. levtabl(ilev+1).ne.0) then
-c
-c There is at least one 2nd..
-c
- if (udq .eq. 'u') then
-c
-c Upstem. Start with 2nd just found and go up, rt-shifting upper
-c member of each pair
-c
- ile = ilev
-c
-c Set main-note flag for ANY right-shift
-c
- irest = ibset(irest,20)
-7 continue
- if (levtabl(ile+1) .lt. 0) then
-c
-c Upstem, & upper member is main so must be rt-shifted. This would move
-c stem too, so we rt-shift the OTHER note, and set flag that signals
-c to interchange pitches just when these two notes are placed.
-c
- nacc = ibset(nacc,30)
- icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),24)
- else
-c
-c Upper member is chord note, must be rt-shifted
-c
- icrdat(levtabl(ile+1)) = ibset(icrdat(levtabl(ile+1)),24)
- end if
- ile = ile+1
-8 continue
- ile = ile+1
- if (ile .lt. 87) then
- if (levtabl(ile).ne.0 .and. levtabl(ile+1).ne.0) then
- go to 7
- else
- go to 8
- end if
- end if
- go to 10
- else
-c
-c Downstem. Start at top and work down, left-shifting lower member of each pair.
-c We know that lowest pair is at (ilev,ilev+1).
-c
- ile = 88
-c
-c Set main-note flag for ANY right-shift
-c
- irest = ibset(irest,27)
-9 continue
- if (levtabl(ile).ne.0 .and. levtabl(ile-1).ne.0) then
- if (levtabl(ile-1) .lt. 0) then
-c ipl = ibset(ipl,8)
-c
-c Dnstem, & lower member is main so must be left-shifted. This would move
-c stem too, so we left-shift the OTHER note, and set flag that signals
-c to interchange pitches just when these two notes are placed.
-c
- nacc = ibset(nacc,31)
- icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),23)
- else
-c
-c Lower member is chord note, must be shifted
-c
- icrdat(levtabl(ile-1)) =
- * ibset(icrdat(levtabl(ile-1)),23)
- end if
- ile = ile-1
- end if
- ile = ile-1
- if (ile .ge. ilev+1) go to 9
- go to 10
- end if
- end if
-5 continue
-10 continue
-c
-c Done with 2nds, now do accid's. Call even if just one, in case left shifts.
-c
-c if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid,
- if (naccid .ge. 1) call crdaccs(nacc,ipl,irest,naccid,
- * kicrd,nolevm,levmaxacc,levminacc,icrdot0,twooftwo,icashft)
- return
- end
- subroutine printl(string)
- character*(*) string
-c
-c Send string to console and to log file
-c
- print*,string
- write(15,'(a)')string
- return
- end
- subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout)
- parameter (nm=24)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comtol/ tol
- common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
- * ArpShift(20)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- logical lowdot,IsArpShift
- character*80 soutq
- character*79 notexq
- character*8 symq(2)
- character*1 chax
- data symq /'raisearp','arpeggio'/
-c
-c NOTE iv in arg list is really ivx, referring to voice rather than staff.
-c
-c Find which iarp, if any
-c
- do 1 iarp = 1 , narp
- if (abs(tnow-tar(iarp)).lt.tol) go to 2
-1 continue
-c
-c If here, this is the *first* call for this arp.
-c
- narp = narp+1
- tar(narp) = tnow+tol*.5
- ivar1(narp) = iv
- ipar1(narp) = ip
- levar1(narp) = nolev
- ncmar1(narp) = ncm
- return
-2 continue
-c
-c If here, this is *second* call at this time, narp points to values from 1st.
-c
-c Check for shift. Set IsArpShift and iarps
-c
- do 3 iarps = 1 , NumArpShift
- if (IvArpShift(iarps) .eq. ivar1(iarp) .and.
- * IpArpShift(iarps) .eq. ipar1(iarp)) then
- IsArpShift = .true.
- notexq = chax(92)//'loffset{'
- write(notexq(10:14),'(f3.1,a2)') Arpshift(iarps),'}{'
- lnote = 14
- go to 4
- end if
-3 continue
- IsArpShift = .false.
- lnote = 0
-4 continue
- if (iv .eq. ivar1(iarp)) then
-c
-c Arp is in a single voice.
-c
- levbot = min(levar1(iarp),nolev)-ncm+3
- invert = abs(levar1(iarp)-nolev)+1
- else
-c
-c Arp covers >1 voice. Lower voice has to be the first, upper is current and
-c is where the symbol will be written.
-c Check whether ivx's ivar1(iarp) & iv are in same staff
-c
- do 5 iiv = 1 , nm
- if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and.
- * ivmx(iiv,2).eq.ivar1(iarp))) then
- iivivx1 = iiv
- go to 6
- end if
-5 continue
- print*,'Screwup#1 in putarp'
- stop
-6 continue
- do 7 iiv = 1 , nm
- if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and.
- * ivmx(iiv,2).eq.iv)) go to 8
-c
-c Found iv for both voices (iivivx1, iiv), done looking
-c
-7 continue
- print*,'Screwup#2 in putarp'
- stop
-8 continue
- if (iivivx1 .eq. iiv) then
- nstaffshift = 0
- else
- nstaffshift = -nint(2*xinsnow)
- end if
-c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp)
- levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp)
- invert = -levbot+4+nolev-ncm
- end if
-c
-c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote
-c
- isym = mod(invert,2)+1
- ilvert = (invert+1)/2
- if (levbot .ge. 0 .and. levbot .le. 9) then
-c
-c Single digit
-c
- if (.not.IsArpShift) then
- notexq = chax(92)//symq(isym)//chax(48+levbot)
- else
- notexq = notexq(1:lnote)//
- * chax(92)//symq(isym)//chax(48+levbot)
- end if
- lnote = lnote+10
- else
- if (.not.IsArpShift) then
- notexq = chax(92)//symq(isym)//'{'
- else
- notexq = notexq(1:lnote)//chax(92)//symq(isym)//'{'
- end if
- lnote = lnote+10
- if (levbot .ge. -9) then
-c
-c Need two spaces for number
-c
- write(notexq(lnote+1:lnote+3),'(i2,a1)')levbot,'}'
- lnote = lnote+3
- else
- write(notexq(lnote+1:lnote+4),'(i3,a1)')levbot,'}'
- lnote = lnote+4
- end if
- end if
-c if (ilvert .le. 9) then
-c call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1,
-c * soutq,lsout)
-c else
-c write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
-c call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout)
-c end if
-
- if (ilvert .gt. 9) then
- write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//chax(48+ilvert)
- lnote = lnote+1
- end if
- if (IsArpShift) then
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- call addstr(notexq(1:lnote),lnote,soutq,lsout)
-c
-c cancel out the stored time, to permit two arps at same time!
-c
- tar(iarp) = -1.
- return
- end
- subroutine putast(elask,indxask,outq)
- character*129 outq,tag
- character*9 fmtq
- if (elask .ge. 0.) then
- if (elask.lt.0.995) then
- lp = 3
- else if (elask .lt. 9.995) then
- lp = 4
- else
- lp = 5
- end if
- write(fmtq,'(a5,i1,a3)')'(a2,f',lp,'.2)'
- else
- lp = 5
- fmtq = '(a2,f5.1)'
- end if
-c
-c Overwrite as follows: ...xyz*ask *lmnop... ->
-c ...xyz*ast{.nn}*lmnop...
-c ...xyz*ast{n.nn}*lmnop...
-c ...xyz*ast{nn.nn}*lmnop...
-c or for negative, ...xyz*ast{-nn.n}*lmnop...
- tag = outq(indxask+9:)
- write(outq(indxask+3:),fmtq)'t{',elask
- outq = outq(1:indxask+4+lp)//'}'//tag
- return
- end
- subroutine putcb(ivx,ip,notexq,lnote)
- common /comcb/ nbc,ibcdata(36)
- character*79 notexq
- logical btest
-c ivxip = ivx+16*ip
- do 1 ibc = 1 , nbc
-c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2
-c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
-c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2
- ivxbc = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
- ipbc = igetbits(ibcdata(ibc),8,4)
- if (ivx .eq. ivxbc .and. ip .eq.ipbc) go to 2
-1 continue
- call printl('Error in putbc, Call Dr. Don')
- stop
-2 continue
- if (btest(ibcdata(ibc),27)) then
- lnote = 8
- notexq = char(92)//'pbreath'
- else
- lnote = 9
- notexq = char(92)//'pcaesura'
- end if
- ivshft = igetbits(ibcdata(ibc),6,13)
-c?? ivshft = igetbits(ibcdata(ibc),6,13)-32
- if (ivshft .gt. 0) ivshft = ivshft-32
- if (ivshft.lt.0 .or. ivshft.gt.9) then
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- if (ivshft .lt. -9) then
- write(notexq(lnote+1:lnote+3),'(i3)')ivshft
- lnote = lnote+3
- else
- write(notexq(lnote+1:lnote+2),'(i2)')ivshft
- lnote = lnote+2
- end if
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- else
- notexq = notexq(1:lnote)//char(48+ivshft)
- lnote = lnote+1
- end if
- ihshft = igetbits(ibcdata(ibc),8,19)
- if (ihshft .eq. 0) then
- notexq = notexq(1:lnote)//'0'
- lnote = lnote+1
- else
- hshft = .1*(ihshft-128)
-c
-c -12.8<hshft<12.8
-c
- notexq = notexq(1:lnote)//'{'
- lnote = lnote+1
- if (hshft .lt. -9.95) then
- write(notexq(lnote+1:lnote+5),'(f5.1)')hshft
- lnote = lnote+5
- else if (hshft.lt.-0.05 .or. hshft.gt.9.95) then
- write(notexq(lnote+1:lnote+4),'(f4.1)')hshft
- lnote = lnote+4
- else
- write(notexq(lnote+1:lnote+3),'(f3.1)')hshft
- lnote = lnote+3
- end if
- notexq = notexq(1:lnote)//'}'
- lnote = lnote+1
- end if
- return
- end
- subroutine putfig(ivx,ifig,offnsk,figcheck,soutq,lsout)
- parameter (nm=24)
- common /comfig/ itfig(2,74),figqq(2,74),ivupfig(2,74),nfigs(2),
- * fullsize(nm),ivxfig2,ivvfig(2,74)
- character*10 figqq,figq
- character*80 soutq,notexq
- character*1 ch1q,ch2q,sq,chax
- character*5 nofq,nofaq
- character*4 Figutq,Conttq
- logical figcheck
- if (ivx .eq. 1) then
- Figutq = 'Figu'
- Conttq = 'Cont'
- else
- Figutq = 'Figt'
- Conttq = 'Cott'
- end if
- sq = chax(92)
- if (ivvfig(ivx,ifig) .ne. 0) then
-c
-c Alter figdrop
-c
- notexq = sq//'global'//sq//'advance'//sq//'figdrop'
- lnote = 23
- if (ivvfig(ivx,ifig) .lt. 0) then
- notexq = notexq(1:lnote)//'-'
- lnote = lnote+1
- endif
- notexq = notexq(1:lnote)//char(48+abs(ivvfig(ivx,ifig)))
- lnote = lnote+1
- call addstr(notexq,lnote,soutq,lsout)
- end if
- if (abs(offnsk) .gt. .0001) then
-c
-c Write offset for floating figure, to two decimal places
-c
- notexq = sq//'off{'
- if (-offnsk .lt. -9.995) then
- write(notexq(6:11),'(f6.2)')-offnsk
- lnote = 11
- else if (-offnsk.lt.-.995 .or. -offnsk.gt.9.995) then
- write(notexq(6:10),'(f5.2)')-offnsk
- lnote = 10
- else if (-offnsk.lt.-.0001 .or. -offnsk.gt..995) then
- write(notexq(6:9),'(f4.2)')-offnsk
- lnote = 9
- else
- write(notexq(6:8),'(f3.2)')-offnsk
- lnote = 8
- end if
- notexq = notexq(1:lnote)//sq//'noteskip}'
- call addstr(notexq,lnote+10,soutq,lsout)
- end if
- figq = figqq(ivx,ifig)
- ic = 1
-c nof = 0
-c nofa = -1
- nof = -ivupfig(ivx,ifig)
- nofa = -ivupfig(ivx,ifig)-1
-c
-c Beginning of manual loop
-c
-1 ch1q = figq(ic:ic)
-c
-c Exit when first blank is encountered
-c
- if (ch1q .eq. ' ') go to 2
-c
-c Starting a level. Set up vertical offset.
-c
-c lnof = 1
-c nofq = chax(nof+48)
-c if (nof .gt. 9) then
-c lnof = 2
-c nofq = '1'//chax(nof-10+48)
-c end if
-c if (nofa .eq.-1) then
-c lnofa = 2
-c nofaq = '-1'
-c else if (nofa .lt. 10) then
-c lnofa = 1
-c nofaq = chax(nofa+48)
-c else
-c lnofa = 2
-c nofaq = '1'//chax(nofa+38)
-c end if
- call istring(nof,nofq,lnof)
- call istring(nofa,nofaq,lnofa)
- if (ch1q .eq. '0') then
-c
-c Continuation figure. Next number is length (in noteskips). The number will
-c end at the first blank or char that is not digit or decimal point. If
-c colon, it is a separator and must be skipped
-c
- icnum = ic+1
-3 continue
- ic = ic+1
- if (index('0123456789.',figq(ic:ic)) .gt. 0) go to 3
- lnum = ic-icnum
- call addstr(sq//Conttq//nofq(1:lnof)//'{'
- * //figq(icnum:ic-1)//'}',7+ic-icnum+lnof,soutq,lsout)
- if (figq(ic:ic) .ne. ':') ic=ic-1
- else if (ch1q.eq.'#'.or.ch1q.eq.'-'.or.ch1q.eq.'n') then
- ic = ic+1
- ch2q = figq(ic:ic)
- if (ch2q .eq. ' ') then
-c
-c Figure is a stand-alone accidental, so must be centered
-c
- if (ch1q .eq. '#') then
- call addstr(sq//Figutq//nofaq(1:lnofa)//
- * '{'//sq//'sharpfig}',16+lnofa,soutq,lsout)
- else if (ch1q .eq. '-') then
- call addstr(sq//Figutq//nofaq(1:lnofa)//
- * '{'//sq//'flatfig}',15+lnofa,soutq,lsout)
- else if (ch1q .eq. 'n') then
- call addstr(sq//Figutq//nofaq(1:lnofa)//
- * '{'//sq//'natfig}',14+lnofa,soutq,lsout)
- end if
- go to 2
- else
-c
-c Figure is an accidental followed by a number
-c First put the accidental (offset to the left)
-c
- if (ch1q .eq. '#') then
- call addstr(sq//Figutq//
- * nofaq(1:lnofa)//'{'//sq//'fsmsh}',
- * 13+lnofa,soutq,lsout)
- else if (ch1q .eq. '-') then
- call addstr(sq//Figutq//
- * nofaq(1:lnofa)//'{'//sq//'fsmfl}',
- * 13+lnofa,soutq,lsout)
- else if (ch1q .eq. 'n') then
- call addstr(sq//Figutq//
- * nofaq(1:lnofa)//'{'//sq//'fsmna}',
- * 13+lnofa,soutq,lsout)
- end if
-c
-c Now put the number
-c
- call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch2q//'}',
- * 8+lnof,soutq,lsout)
- endif
- else if (ch1q .eq. '_') then
-c
-c Placeholder only (for lowering a figure). Don't do anything!
-c
- continue
- else
-c
-c Figure is a single number, maybe with s after
-c
- call addstr(sq//Figutq//nofq(1:lnof)//'{',
- * 6+lnof,soutq,lsout)
- ch2q = figq(ic+1:ic+1)
- if (ch2q .eq. 's') then
-c
-c Use a special character. Insert font call
-c
- ic = ic+1
- call addstr(sq//'ligfont',8,soutq,lsout)
- end if
- call addstr(ch1q//'}',2,soutq,lsout)
-c call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}',
-c * 8+lnof,soutq,lsout)
- end if
- if (ic .ge. 10) go to 2
- ic = ic+1
- nof = nof+4
- nofa = nofa+4
- go to 1
-2 continue
- if (abs(offnsk) .gt. .0001) then
- notexq = sq//'off{'
- if (offnsk .lt. -9.995) then
- write(notexq(6:11),'(f6.2)')offnsk
- lnote = 11
- else if (offnsk.lt.-.995 .or. offnsk.gt.9.995) then
- write(notexq(6:10),'(f5.2)')offnsk
- lnote = 10
- else if (offnsk.lt.-.0001 .or. offnsk.gt..995) then
- write(notexq(6:9),'(f4.2)')offnsk
- lnote = 9
- else
- write(notexq(6:8),'(f3.2)')offnsk
- lnote = 8
- end if
- notexq = notexq(1:lnote)//sq//'noteskip}'
- call addstr(notexq,lnote+10,soutq,lsout)
- end if
- if (ifig .lt. nfigs(ivx)) then
- ifig = ifig+1
- else
- nfigs(ivx) = 0
- figcheck = .false.
- end if
- return
- end
- subroutine putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
- * ncm,islur,nvmx,nv,ihornb,stemlin,outq,lout,ip,islhgt,
- * beamon,iscrd)
-c
-c All args are individual array element *values* except nornb,ihornb,ulq.
-c notcrd = .true. if ornament is on main note.
-c nolevm is level of main note (for chords)
-c
- parameter (nm=24)
- character*1 ulpzq,ulq(nm,9),udqq,sq,chax
- character*8 noteq
- character*79 notexq,outq
- integer*4 ihornb(nm,24),nornb(nm)
- logical btest,iscrd,usehornb,beamon
- common /comivxudorn/ivxudorn(63)
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- sq = chax(92)
- lout = 0
- usehornb = .false.
- if (nodur .lt. 64) then
- stemlen = stemlin
- else
- stemlen = 0.
- end if
-c
-c Get up-downness. ulpzq is opposite from stem direction for both beams and
-c non beams. Can use in name of ornament [ . or _ ]
-c
- if (beamon) then
- if (ulq(ivx,ibmcnt) .eq. 'u') then
- ulpzq = 'l'
- else
- ulpzq = 'u'
- end if
- else
- if (udqq(nolevm,ncm,islur,nvmx,ivx,nv).eq.'l' ) then
- ulpzq = 'u'
- else
- ulpzq = 'l'
- end if
- end if
-c
-c To enable >1 ornament on a note, next line is top of manual loop.
-c
-2 continue
-c
-cc Bit # of last ornament (last of bits 0-21)
-cc Bit # of last ornament (last of bits 0-24)
-c Bit # of last ornament (last of bits 0-24,29-30)
- if (btest(iornq,29)) then
- ibit = 29
- else if (btest(iornq,30)) then
- ibit = 30
- else
- ibit = log2(iand(iornq,4194303))
-c ibit = log2(iand(iornq,33554431))
- end if
- iornt = 2**ibit
-c
-c Begin routine to set height. Bits 0-13: (stmgx+Tupf._)
-c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n
-c 19-20: >^, 21: ? (with or w/o 16-18)
-c and 29-30: C (coda), G (new segno)
-c
-c Do not use beam height for . or _
-c
- if (btest(iornq,22) .and. iand(iornt,6144).eq.0) then
-c
-c Height is set by special beam stuff.
-c Do not leave ihorn set, do separately for every ornament
-c
- ihorn = ihornb(ivx,nornb(ivx))
- if (ulpzq .eq. 'u') ihorn = ihorn-2
-c
-c Following flag tells whether to increment nornb when exiting the subroutine.
-c
- usehornb = .true.
- else if (ibit .eq. 14) then
-c
-c Down fermata. Don't worry about upper chord notes.
-c
- if (ulpzq .eq. 'l') then
- ihorn = min(nolev,ncm-3)
- else
- ihorn = min(nolev-stemlen,ncm-3.)
- end if
- else if (btest(iornt,13) .or. btest(iornt,0)) then
-c
-c ( or )
-c
- ihorn = nolev
- else if (iand(iornt,6144) .gt. 0) then
-c
-cc Staccato . or tenuto _ , but not special beam stuff. Need up-down info
-c NOTE: removed .&_ from special beam treatment.
-c Staccato . or tenuto _ Need up-down info
-c
- if (.not.iscrd .or. (maxlev.ne.nolev.and.ulpzq.eq.'l') .or.
- * (minlev.ne.nolev.and.ulpzq.eq.'u')) then
- ihorn = nolev
- else if (maxlev .eq. nolev) then
- ulpzq = 'u'
- ihorn = max(nolev+stemlen,ncm+3.)
- else
- ulpzq = 'l'
- ihorn = min(nolev-stemlen,ncm-3.)
- end if
- else if (iscrd .and. nolev .eq. minlev) then
- if (ulpzq .eq. 'l') then
- ihorn = min(nolev-3,ncm-6)
- else
- ihorn = min(nolev-nint(stemlen)-3,ncm-6)
- end if
- else if (ibit.eq.10 .and. nolev.gt.90) then
-c
-c Special treatment for fermata on a shifted rest
-c
- ihorn = ncm+5
- else if (ulpzq.eq.'l') then
-c
-c (iscrd and nolev=maxlev) or (.not.iscrd)
-c
- ihorn = max(nolev+stemlen+2,ncm+5.)
- else if (ibit.eq.29 .or. ibit.eq.30) then
-c
-c coda or new segno, no height tweak
-c
- ihorn = ncm+5
- else
- ihorn = max(nolev+2,ncm+5)
- end if
- ioff = 0
- iclracc = 0
-c
-c Begin routine to set name. Bits 0-13: (stmgx+Tupf._)
-c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n
-c
- if (btest(iornt,2)) then
- notexq = sq//'shake'
- lnote = 6
- else if (btest(iornt,3)) then
- notexq = sq//'mordent'
- lnote = 8
- else if (btest(iornt,1)) then
- notexq = sq//'mtr'
- lnote = 4
- else if (btest(iornt,5)) then
- notexq = sq//'xtr'
- lnote = 4
- else if (btest(iornt,6)) then
- notexq = sq//'ptr'
- lnote = 4
- else if (btest(iornt,13)) then
- notexq = sq//'rpn'
- lnote = 4
- else if (btest(iornt,0)) then
- notexq = sq//'lpn'
- lnote = 4
- else if (btest(iornt,12)) then
- notexq = sq//ulpzq//'st'
- lnote = 4
- else if (btest(iornt,11)) then
- notexq = sq//ulpzq//'pz'
- lnote = 4
- else if (btest(iornt,8)) then
- notexq = sq//'upz'
- lnote = 4
- ioff = -2
- else if (btest(iornt,9)) then
- notexq = sq//'uppz'
- lnote = 5
- ioff = -2
- else if (btest(iornt,10)) then
- if (nodur .lt. 48) then
- notexq = sq//'fermataup'
- else
- notexq = sq//'Fermataup'
- end if
- lnote = 10
- ioff = -2
- else if (btest(iornt,14)) then
- if (nodur .lt. 48) then
- notexq = sq//'fermatadown'
- else
- notexq = sq//'Fermatadown'
- end if
- lnote = 12
- else if (btest(iornt,21)) then
-c
-c "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21
-c
- if (btest(iornq,16)) then
- notexq = sq//'qsharp'
- lnote = 7
- ioff = 2
- iornq = ibclr(iornq,16)
- iclracc = 16
- else if (btest(iornq,17)) then
- notexq = sq//'qflat'
- lnote = 6
- ioff = 1
- iornq = ibclr(iornq,17)
- iclracc = 17
- else if (btest(iornq,18)) then
- notexq = sq//'qnat'
- lnote = 5
- ioff = 2
- iornq = ibclr(iornq,18)
- iclracc = 18
- else
- notexq = sq//'qedit'
- lnote = 6
- ioff = 0
- end if
- else if (btest(iornt,16)) then
- notexq = sq//'esharp'
- lnote = 7
- ioff = 2
- else if (btest(iornt,17)) then
- notexq = sq//'eflat'
- lnote = 6
- ioff = 1
- else if (btest(iornt,18)) then
- notexq = sq//'enat'
- lnote = 5
- ioff = 2
- else if (btest(iornt,19)) then
- notexq = sq//'usf'
- lnote = 4
- ioff = -2
- else if (btest(iornt,20)) then
- notexq = sq//'usfz'
- lnote = 5
- ioff = -2
- else if (btest(iornt,29)) then
- notexq = sq//'ccoda'
- lnote = 6
- else if (btest(iornt,30)) then
- notexq = sq//'ssegno'
- lnote = 7
- end if
- iudorn = 0
-c
-c User-defined level shift of ornament from default?
-c
- if (btest(iornq,25)) then
-c
-c Find which (if any) element of kudorn has the shift.
-c
- do 3 iudorn = 1 , nudorn
-c if (ibit .lt. 21) then
-c if (ibit.lt.21 .or. ibit.eq.29) then
- if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then
- ibitt = ibit
-c
-c Could have oes, but not oe? or oes?
-c
- else if (iclracc .gt. 0) then
-c
-c Earlier cleared edit. accid, meaning it was oes?
-c
- ibitt = iclracc+6
- else
- ibitt = 21
- end if
- ibitt=ip+ishft(mod(ivx,16),8)+ishft(nolev,12)+ishft(ibitt,19)
-c if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4
- if (ibitt .eq. iand(33554431,kudorn(iudorn))
- * .and. ivx.eq.ivxudorn(iudorn)) go to 4
-3 continue
-c
-c Nothing shifted on this note; exit this if block
-c
- iudorn = 0
- go to 5
-4 continue
- ioffinc = iand(63,ishft(kudorn(iudorn),-25))-32
- if (ibit.eq.19 .and. ioffinc .lt. -7) then
-c
-c Convert usf to lsf. The reason has to do with positioning being impossile
-c for some mysterious reason when you drop \usf below the staff
-c
- notexq = sq//'lsf'
- ioffinc = ioffinc+6
- end if
- ioff = ioff+ioffinc
- end if
-5 continue
-c
-c Shift level to avoid slur. Conditions are
-c 1. There is a slur
-c 2. No user-defined orn height shift (btest(iornq,25))
-c 3. upslur (islhgt>0)
-c 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737
-c 5. islhgt+3 >= height already computed.
-c
- if (.not.btest(iornq,25) .and.
- * islhgt.gt.0 .and. iand(iornt,30737).eq.0)
- * ioff = ioff+dim(islhgt+3,ihorn )
- call notefq(noteq,lnoten,ihorn+ioff,ncm)
- if (lnoten.eq.1) call addblank(noteq,lnoten)
- if (iand(iornt,32896) .gt. 0) then
-c
-c T-trill or trill w/o "tr"
-c
- call dotrill(ivx,ip,iornt,noteq,lnoten,notexq,lnote)
- else
- notexq = notexq(1:lnote)//noteq(1:lnoten)
- lnote = lnote+lnoten
- end if
- if (iudorn .gt. 0) then
- if (btest(kudorn(iudorn),31)) then
-c
-c Horizontal shift
-c
- lform = lfmt1(ornhshft(iudorn))
- write(noteq(1:lform),'(f'//chax(48+lform)//'.1)')
- * ornhshft(iudorn)
- notexq = sq//'roffset{'//noteq(1:lform)//'}{'
- * //notexq(1:lnote)//'}'
- lnote = lnote+lform+12
- ornhshft(iudorn) = 0.
- kudorn(iudorn) = ibclr(kudorn(iudorn),31)
- end if
- end if
-c
-c Zero out the bit for ornament just dealt with.
-c
- iornq = ibclr(iornq,ibit)
- if (lout .eq. 0) then
- outq = notexq(1:lnote)
- else
- outq = outq(1:lout)//notexq(1:lnote)
- end if
- lout = lout+lnote
-c
-c Check bits 0-21, go back if any are still set
-c If bit 29 or 30 had been set, would have been used first time thru,
-c and you wouldn't use both coda and segno on same note
-c
- if (iand(iornq,4194303) .gt. 0) go to 2
- if (usehornb) nornb(ivx) = nornb(ivx)+1
- return
- end
- subroutine putshft(ivx,onoff,soutq,lsout)
- parameter (nm=24)
- common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
- character*80 soutq,notexq
- character*1 sq,chax
- logical onoff
- sq = chax(92)
-c
-c Start user-defined offsets X(...): or X(...)S
-c
- if (onoff) nudoff(ivx) = nudoff(ivx)+1
-c
-c Xoff is in pts. Round off to nearest .1. Will use at end of shift.
-c
- xoff = udoff(ivx,nudoff(ivx))
- xoff = sign(int(10.*abs(xoff)+.5)/10.,xoff)
- if (.not.onoff) xoff = -xoff
- if (xoff .lt. -9.95) then
- ifmt = 5
- else if (xoff.lt.-.95 .or. xoff.gt.9.95) then
- ifmt = 4
- else
- ifmt = 3
- end if
- write(notexq,'(f'//chax(48+ifmt)//'.1)')xoff
- call addstr(sq//'off{'//notexq(1:ifmt)//'pt}',8+ifmt,
- * soutq,lsout)
- return
- end
- subroutine puttitle(inhnoh,xnsttop,etatop,sq,etait,etatc,
- * etacs1,nv,vshrink,sepsymq)
-c
-c Called once per page, at top of page! If vshrink, only called for p.1.
-c Actual titles only allowed on p.1. (set by headlog).
-c 3/18/01: The above comment is probably bogus...can use Tt on later pages.
-c
- common /comlast/ islast,usevshrink
- logical islast,usevshrink
- common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
- * inhead
- common /cominbot/ inbothd
- character*127 notexq
- character*120 instrq,titleq,compoq
- parameter (nm=24)
- character*1 sq,sepsymq(nm),chax
- logical headlog,vshrink
- notexq = sq//'znotes'
- lenline = 7
- do 22 iv = 1 , nv-1
- notexq = notexq(1:lenline)//sepsymq(iv)
- lenline = lenline+1
-22 continue
- notexq = notexq(1:lenline)//sq//'zcharnote{'
- lenline = lenline+11
- if (.not.headlog) then
- inhead = inhnoh
- end if
- if (vshrink .and. usevshrink) then
- inhead = 16
- end if
- ndig = int(alog10(inhead+.01))+1
- write(notexq(lenline+1:lenline+ndig+10),'(i'//chax(48+ndig)//
- * ',a10)')inhead,'}{'//sq//'titles{'
- lenline = lenline+ndig+10
-c
-c Vertical skip at top of page (\Il) = etatop*glueil. Needed whether
-c headers are present or not.
-c
- glueil = xnsttop/etatop
- vskil = etatop*glueil
- if (vshrink .and. usevshrink) vskil = 2
- call writflot(vskil,notexq,lenline)
- if (.not.headlog) then
- if (islast) write(11,'(a)')notexq(1:lenline)
- * //'}{}{0}{}{0}{}{0}}'//sq//'en%'
- else
- notexq = notexq(1:lenline)//'}{'
- lenline = lenline+2
- lcq = lenstr(instrq,120)
- if (lcq .gt. 0) then
- xitil = etait*glueil
- if (vshrink .and. usevshrink) xitil = 2
- notexq = notexq(1:lenline)//instrq(1:lcq)//'}{'
-c
-c Null out instrument once used
-c
- instrq = ' '
- lenline = lenline+lcq+2
- call writflot(xitil,notexq,lenline)
- else
- notexq = notexq(1:lenline)//'}{0'
- lenline = lenline+3
- end if
- if (islast) write(11,'(a)')notexq(1:lenline)//'}%'
- notexq = '{'
- lenline = 1
- lcq = lenstr(titleq,120)
- if (lcq .gt. 0) then
- notexq = notexq(1:lenline)//titleq(1:lcq)
- lenline = lenline+lcq
- else
- call printl(' ')
- call printl('WARNING')
- call printl(
- * ' In a title block, you have specified instrument and/or')
- call printl(
- * ' composer but no title for the piece.')
- end if
- notexq = notexq(1:lenline)//'}{'
- lenline = lenline+2
- xtcil = etatc*glueil
- lcq = lenstr(compoq,120)
- if (lcq .eq. 0) xtcil = 2*xtcil
- if (vshrink .and. usevshrink) xtcil = 2
- call writflot(xtcil,notexq,lenline)
- notexq = notexq(1:lenline)//'}{'
- lenline = lenline+2
- if (lcq .gt. 0) then
- notexq = notexq(1:lenline)//compoq(1:lcq)//'}{'
- lenline = lenline+2+lcq
-c
-c Null out compoq so it does not get written later
-c
- compoq = ' '
- xcsil = etacs1*glueil
- if (vshrink .and. usevshrink) xcsil = 2
- call writflot(xcsil,notexq,lenline)
- else
- notexq = notexq(1:lenline)//'}{0'
- lenline = lenline+3
- end if
- if (islast) write(11,'(a)')notexq(1:lenline)//'}}'//sq//'en%'
- headlog = .false.
- end if
- return
- end
- subroutine putxtn(ntupv,iflop,multb,iud,wheadpt,poenom,
- * nolev1,islope,slfac,xnlmid,islur,lnote,notexq,ncmid,nlnum,
-c * eloff,iup,irest,usexnumt)
- * eloff,iup,irest,mult,usexnumt)
-c
-c Places digit for xtuplet.
-c
- character*1 chax
- character*8 noteq
- character*79 notexq
- logical btest,usexnumt
- if (iflop.ne.0 .and. multb.gt.0) then
-c
-c Number goes on beam side, move R/L by .5 wheadpt for upper/lower
-c
- eloff = eloff-0.5*iud*wheadpt/poenom
-c
-c Number goes on beam side, must use beam parameters to set pos'n
-c
- nlnum = nolev1+islope/slfac*eloff+iup*(multb+8)
- if (multb .ge. 2) nlnum = nlnum+iup
- else
- nlnum = nint(xnlmid-1+3*iud+iflop*11)
- end if
- if (.not.btest(islur,31)) then
-c
-c Only print number when wanted. First check vert, horiz offset
-c
- if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64
- if (btest(irest,7)) eloff = eloff+
- * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom
- if (.not.usexnumt) then
- notexq = chax(92)//'xnum{'
- lnote = 10
- istrtn = 7
- else
- notexq = chax(92)//'xnumt{'
- lnote = 11
- istrtn = 8
- end if
- if (eloff .lt. 0.995) then
- write(notexq(istrtn:istrtn+3),'(i1,f3.2)')0,eloff
- else if (eloff .lt. 9.995) then
- write(notexq(istrtn:istrtn+3),'(f4.2)')eloff
- else
- write(notexq(istrtn:istrtn+4),'(f5.2)')eloff
- lnote = lnote+1
- end if
- call notefq(noteq,lnoten,nlnum,ncmid)
- notexq = notexq(1:lnote)//'}'//noteq(1:lnoten)
- lnote = lnote+1+lnoten
- if (ntupv .lt. 10) then
- write(notexq(lnote+1:lnote+1),'(i1)')ntupv
- lnote = lnote+1
- else
- notexq = notexq(1:lnote)//'{'
- write(notexq(lnote+2:lnote+3),'(i2)')ntupv
- notexq = notexq(1:lnote+3)//'}'
- lnote = lnote+4
- end if
- end if
- return
- end
- subroutine read10(string,lastchar)
- parameter (maxblks=9600)
- character*131072 bufq
- integer*2 lbuf(maxblks)
- common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
- character*(*) string
- character*128 lnholdq
- logical lastchar
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- logical mrecord,mplay,endmac
- common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
- * ic1mac(20),ilmac,iplmac
- if (.not.mplay) then
- if (ilbuf .gt. nlbuf) go to 999
- call getbuf(string)
- return
-999 lastchar = .true.
- return
- else
-c
-c Play a macro. Set pointer to first character needed in buffer
-c
- if (ilmac .eq. il1mac(macnum)) then
-c
-c Getting first line of macro
-c
- ip1 = ip1mac(macnum)
- iplmac = ip1-ic1mac(macnum)
- else if (ilmac .le. il2mac(macnum)) then
-c
-c Beyond first line of macro. Advance line-start pointer.
-c
- iplmac = iplmac+lbuf(ilmac-1)
- ip1 = iplmac+1
- else
-c
-c Beyond last line of macro. Terminate it!
-c
- mplay = .false.
- endmac = .true.
- return
- end if
- if (ilmac .eq. il2mac(macnum)) then
-c
-c Getting last line of macro.
-c
- ip2 = ip2mac(macnum)
- else
-c
-c Getting line before last line of macro.
-c
- ip2 = iplmac+lbuf(ilmac)
- end if
- if (ip2 .ge. ip1) then
- string = bufq(ip1:ip2)
- else
-c
-c Kluge for when macro start is on a line by itself
-c
- string = ' '
- end if
- ilmac = ilmac+1
- return
- end if
- end
- function readin(lineq,iccount,nline)
-c
-c Reads a piece of setup data from file lineq, gets a new lineq from
-c file 10 (jobname.pmx) and increments nline if needed, passes over
-c comment lines
-c
- character*128 lineq
- character*1 durq,chax
-4 if (iccount .eq. 128) then
-1 call getbuf(lineq)
- nline = nline+1
- if (lineq(1:1) .eq. '%') go to 1
- iccount = 0
- end if
- iccount = iccount+1
-c
-c Find next non-blank or end of line
-c
- do 2 iccount = iccount , 127
- if (lineq(iccount:iccount) .ne. ' ') go to 3
-2 continue
-c
-c If here, need to get a new line
-c
- iccount = 128
- go to 4
-3 continue
-c
-c iccount now points to start of number to read
-c
- i1 = iccount
-5 call getchar(lineq,iccount,durq)
-c
-c Remember that getchar increments iccount, then reads a character.
-c
- if (index('0123456789.-',durq) .gt. 0) go to 5
- i2 = iccount-1
- if (i2 .lt. i1) then
- print*,'Found "'//durq//'" instead of number'
- call stop1()
- end if
- icf = i2-i1+49
- read(lineq(i1:i2),'(f'//chax(icf)//'.0)')readin
- return
- end
- subroutine readmeter(lineq,iccount,mtrnum,mtrden)
- character*128 lineq
- character*1 durq,chax
- if (index(lineq(iccount+1:iccount+3),'/') .eq. 0) then
-c
-c No slashes, so use old method
-c
- call getchar(lineq,iccount,durq)
- if (durq .eq. '-') then
-c
-c Negative numerator is used only to printed; signals vertical slash
-c
- call getchar(lineq,iccount,durq)
- mtrnum = -(ichar(durq)-48)
- else if (durq .eq. 'o') then
-c
-c Numerator is EXACTLY 1
-c
- mtrnum = 1
- else
- mtrnum = ichar(durq)-48
- if (mtrnum .eq. 1) then
-c
-c Numerator is >9
-c
- call getchar(lineq,iccount,durq)
- mtrnum = 10+ichar(durq)-48
- end if
- end if
- call getchar(lineq,iccount,durq)
- if (durq .eq. 'o') then
- mtrden = 1
- else
- mtrden = ichar(durq)-48
- if (mtrden .eq. 1) then
- call getchar(lineq,iccount,durq)
- mtrden = 10+ichar(durq)-48
- end if
- end if
- else
-c
-c Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm'
-c
- iccount = iccount+1
- ns = index(lineq(iccount:128),'/')
- read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrnum
-c
-c Reset iccount to start of second integer
-c
- iccount = iccount+ns
-c
-c There must be either a slash or a blank at pos'n 2 or 3
-c
- ns = index(lineq(iccount:iccount+2),'/')
- if (ns .eq. 0) ns = index(lineq(iccount:iccount+2),' ')
- read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrden
-c
-c Set iccount to last character used
-c
- iccount = iccount+ns-1
- end if
- return
- end
- subroutine readnum(lineq,iccount,durq,fnum)
-c
-c This reads a number starting at position iccount. Remember that on exit,
-c getchar leaves iccount at the last character retrieved. So must only
-c call this routine *after* detecting a number or decimal.
-c On exit, durq is next character after end of number.
-c
- character*128 lineq
- character*1 durq,chax
- i1 = iccount
-1 call getchar(lineq,iccount,durq)
- if (index('0123456789.',durq) .gt. 0) go to 1
- i2 = iccount-1
- if (i2 .lt. i1) then
- print*,'Found "'//durq//'" instead of number'
- call stop1()
- else if (lineq(i1:i1).eq.'.'.and.lineq(i2:i2).eq.'.') then
- i2 = i2-1
- iccount = iccount-1
- end if
- icf = i2-i1+49
- read(lineq(i1:i2),'(f'//chax(icf)//'.0)')fnum
- return
- end
- subroutine setbits(isdata,iwidbit,ishift,ivalue)
-c
-c Sets iwidbits of isdata, shifted by ishift, to ivalue
-c
- ibase = 2**iwidbit-1
- isdata = iand(not(ishft(ibase,ishift)),isdata)
- isdata = ior(isdata,ishft(ivalue,ishift))
- return
- end
- subroutine setbm2(xelsk,nnb,sumx,sumy,ipb,islope,nolev1)
-c
-c The MEAN SQUARE slope algorithm
-c
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,
- * isfig
- real*4 xelsk(24)
- integer ipb(24)
- ibc = ibmcnt(ivx)
- sumxx = 0.
- sumxy = 0.
- do 2 inb = 1 , nnb
- sumxx = sumxx+xelsk(inb)**2
- sumxy = sumxy+xelsk(inb)*nolev(ivx,ipb(inb))
-2 continue
- delta = nnb*sumxx-sumx*sumx
- em = (nnb*sumxy-sumx*sumy)/delta
- islope = nint(0.5*em*slfac)
- if (iabs(islope) .gt. 9) islope = isign(9,islope)
- beta = (sumy-islope/slfac*sumx)/nnb
- nolev1 = nint(beta)
-c
-c Check if any stems are too short
-c
- smin = 100.
- iul = -1
- if (ulq(ivx,ibc) .eq. 'u') iul = 1
- do 4 inb = 1 , nnb
- ybeam = nolev1+iul*stemlen+islope*xelsk(inb)/slfac
- ynote = nolev(ivx,ipb(inb))
- smin = min(smin,iul*(ybeam-ynote))
-4 continue
- if (smin .lt. stemmin) then
- deficit = stemmin-smin
- nolev1 = nint(nolev1+iul*deficit)
- end if
- return
- end
- subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,
- * ivx,nline)
- character*1 charq,durq
- common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
- logical mrecord,mplay,endmac,btest
- character*128 lnholdq,lineq
- common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
- * ic1mac(20),ilmac,iplmac
-c
-c Macro action
-c
- call g1etchar(lineq,iccount,charq)
- if (charq.eq.'S' .and. ivx.ne.1) then
- print*
- print*
- print*,'*********WARNING*********'
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * '"MS..." only put in parts by scor2prt if in voice #1!')
- end if
- if (index('RSP ',charq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Illegal character after "M" (macro)!')
- call stop1()
- else if (charq .ne. ' ') then
-c
-c Record or playback a macro. Get the number of the macro.
-c
- call g1etchar(lineq,iccount,durq)
- if (index('123456789',durq) .eq. 0) then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Must input number after "MR","MP", or "MS"!')
- call stop1()
- end if
- call readnum(lineq,iccount,durq,fnum)
- macnum = nint(fnum)
- if (durq .ne. ' ') then
- call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
- * 'Macro number must be followed by a blank!')
- call stop1()
- end if
- if (index('RS',charq ).gt. 0) then
-c
-c Record or save a macro
-c
- if (macnum.lt.1 .or. macnum.gt.20) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Macro number not in range 1-20!')
- call stop1()
- end if
- macuse = ibset(macuse,macnum)
- if (charq .eq. 'R') then
- call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
- else if (charq .eq. 'S') then
-c
-c Save (Record but don't activate)
-c
-1 call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
- if (mrecord) then
- call getbuf(lineq)
- nline = nline+1
- iccount = 0
- go to 1
- end if
- iccount = iccount+ndxm+1
- end if
- else
-c
-c Playback the macro
-c
- if (.not.btest(macuse,macnum)) then
- call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
- * 'Cannot play a macro that has not been recorded!')
- call stop1()
- end if
- icchold = iccount
- lnholdq = lineq
- iccount = 128
- mplay = .true.
- ilmac = il1mac(macnum)
- end if
- end if
- return
- end
- subroutine setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
-c
-c Sets last 2 args depending on 1st 2, (logical) num, denom.
-c ibmtyp = 1, 2, or 3 defines set of masks for beam groupings.
-c 1: all duple meters
-c 2: triple w/ denom=4, subdivide in groups of 2 8ths
-c 3: triple w/ denom=8, subdivide in groups of 3 8ths
-c Note that lenbar is set at top or when 'm' symbol is read in getnote
-c
- if (mtrdenl .eq. 4) then
- if (mod(mtrnuml,3) .eq. 0) then
- ibmtyp = 2
- ibmrep = mtrnuml/3
- else
- ibmtyp = 1
- ibmrep = mtrnuml/2
- end if
- else if (mtrdenl .eq. 2) then
- ibmtyp = 1
- if (mtrnuml .eq. 3) then
- ibmrep = 3
- else
- ibmrep = 2*mtrnuml/mtrdenl
- end if
- else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then
-c
-c Added 170726
-c
- ibmtyp = 1
- ibmrep = mtrnuml/4
- else
-c
-c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8
-c
- ibmtyp = 3
- ibmrep = mtrnuml/3
- end if
-c
-c Reset so we don't keep writing new meters
-c
- mtrnuml = 0
-c
-c Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter
-c
- ibmrep = max(ibmrep,1)
- return
- end
- subroutine SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest)
-c
-c The outer combo algorithm
-c
- parameter (nm=24)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- common /comipl2/ ipl2(nm,200)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,btest,
- * isfig,vxtup,l1ng,l2ng,bar1syst,drawbm
- common /comeskz2/ eskz2(nm,200)
- real*4 slope(800),xelsk(24)
- integer ipb(24)
- common /comask/ bar1syst,fixednew,scaldold,
- * wheadpt,fbar,poenom
- common /comas1/ naskb,task(40),wask(40),elask(40)
- common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
- * mtupv(nm,9),nxtinbm(nm),
- * islope(nm),xels11(24),eloff(nm,9),
- * nssb(nm),issb(nm),lev1ssb(nm,20)
- common /comdraw/ drawbm(nm)
- common /combmh/ bmhgt,clefend
- common /commvl/ nvmx(nm),ivmx(nm,2),ivx
- common /comtol/ tol
- ibc = ibmcnt(ivx)
- nxtinbm(ivx) = 0
- n1 = ipl2(ivx,ibm1(ivx,ibc))
-c
-c Initialize counters used in this subroutine, and then later during actual
-c beam drawing, to count later segments of single-slope beam groups
-c
- nssb(ivx) = 0
- issb(ivx) = 0
-c
-c Set flag for xtup beam starting with rest (no others can start with rest)
-c
- if (btest(irest(ivx,ipo(n1)),0)) ixrest = 1
-c
-c Figure how many elemskips to each note. Use the list, counting only non-rests.
-c
- eskz0 = eskz(ivx,ibm1(ivx,ibc))
- nnb = 0
- sumx = 0.
- sumy = 0.
- ipxt1 = 0
- iplast = ibm2(ivx,ibc)
- do 2 ip = ibm1(ivx,ibc) , iplast
- if (.not.btest(irest(ivx,ip),0)) then
- nnb = nnb+1
- ipb(nnb) = ip
- xelsk(nnb) = eskz(ivx,ip)-eskz0
- sumx = sumx+xelsk(nnb)
- sumy = sumy+nolev(ivx,ipb(nnb))
- if (btest(nacc(ivx,ip),21)) then
-c
-c This is the starting note of later segment of single-slope beam group
-c Temporarily store ip here.
-c
- nssb(ivx) = nssb(ivx)+1
- lev1ssb(ivx,nssb(ivx)) = nnb
- end if
- end if
-c
-c New xtup stuff here. Final object is to get distance from start of xtup
-c to number. xtinbm counts xtups in this beam only. mtupv is the printed
-c number. ntupv is number of notes in xtup, and is only used to get
-c eloff, the distance from start of xtup to the number.
-c
- if (btest(nacc(ivx,ip),18)) ndoub = ndoub+1
- if (ipxt1.eq.0 .and. nodur(ivx,ip).eq.0) then
-c
-c Xtup is starting here
-c
- nxtinbm(ivx) = nxtinbm(ivx)+1
- ipxt1 = ip
- if (btest(nacc(ivx,ip),18)) then
- ndoub = 1
- else
- ndoub = 0
- end if
- else if (ipxt1.gt.0 .and. nodur(ivx,ip).gt.0) then
-c
-c Xtup ends here. Set total number of notes in xtup.
-c
- ntupv(ivx,nxtinbm(ivx)) = ip+1-ipxt1
-c
-c Set printed number for embedded xtup.
-c
- mtupv(ivx,nxtinbm(ivx)) = ntupv(ivx,nxtinbm(ivx))+ndoub
-c
-c Middle note of xtup if ntupv odd, note to left of gap if even.
-c
- ipxtmid = (ip+ipxt1)/2
- eloff(ivx,nxtinbm(ivx)) = eskz2(ivx,ipxtmid)-eskz2(ivx,ipxt1)
- if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0)
- * eloff(ivx,nxtinbm(ivx)) = eloff(ivx,nxtinbm(ivx))+
- * .5*(eskz2(ivx,ipxtmid+1)-eskz2(ivx,ipxtmid))
- ipxt1 = 0
- end if
-2 continue
-c
-c Reset nxtinbm for use as counter as #'s are posted by putxtn(..)
-c
- nxtinbm(ivx) = 0
- smed = 0.
-c if (.not.btest(islur(ivx,ipb(1)),2)) then
- if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then
-c
-c No forced 0 slope
-c
-c if (nnb .eq. 1) go to 6
- nsc = 0
- do 5 inb = 1 , nnb-1
- do 5 jnb = inb+1 , nnb
- nsc = nsc+1
- slope(nsc) = (nolev(ivx,ipb(jnb))-nolev(ivx,ipb(inb)))/
- * (xelsk(jnb)-xelsk(inb))
- if (abs(slope(nsc)) .lt. 1.e-4) then
- nsc = nsc+1
- slope(nsc) = slope(nsc-1)
- nsc = nsc+1
- slope(nsc) = slope(nsc-1)
- end if
-5 continue
- if (nsc .eq. 1) then
- smed = slope(1)
- go to 6
- end if
- nscmid = nsc/2+1
- do 7 i = 1 , nscmid
- do 7 j = i+1 , nsc
- if (slope(j) .lt. slope(i)) then
- t = slope(j)
- slope(j) = slope(i)
- slope(i) = t
- end if
-7 continue
- smed = slope(nscmid)
- if (nsc .eq. 2*(nsc/2)) then
-c
-c Even number of slopes in the list, so median is ambiguous
-c
- if (abs(slope(nscmid-1)) .lt. abs(slope(nscmid))-tol) then
-c
-c Lower-numbered one is truly less in absolute value, so use it
-c
- smed=slope(nscmid-1)
- else if (abs(slope(nscmid-1)+slope(nscmid)) .lt. tol) then
-c
-c Two slopes are effectively equal. Take the one with sign of the average
-c
- sum = 0.
- do 1 i = 1 , nsc
- sum = sum+slope(i)
-1 continue
- smed = sign(smed,sum)
- end if
- end if
-6 continue
- islope(ivx) = nint(0.5*smed*slfac)
- if (iabs(islope(ivx)) .gt. 9)
- * islope(ivx) = isign(9,islope(ivx))
- else
-c
-c Forced horizontal beam
-c
- islope(ivx) = 0
- end if
- beta = (sumy-islope(ivx)/slfac*sumx)/nnb
-c
-c If ixrest>0, this is a virtual nolev1 at location of rest. Will first use
-c as is for placing xtup number and/or bracket, then reset it for start of
-c actual beam
-c
- nolev1(ivx) = nint(beta)
-c
-c Check if any stems are too short
-c
- smin = 100.
- iul = -1
- if (ulq(ivx,ibc) .eq. 'u') iul = 1
- ssq = 0.
- syb = 0.
- yb1 = nolev1(ivx)
- * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1))
- do 4 inb = 1 , nnb
- ybeam = yb1+islope(ivx)*xelsk(inb)/slfac
- * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1)
- syb = syb+ybeam
- ynote = nolev(ivx,ipb(inb))
- off = ybeam-ynote
- if (inb .eq. 1) then
- off1 = off
- else if (inb .eq. nnb) then
- off2 = off
- end if
- ssq = ssq+off*off
- smin = min(smin,iul*off)
-4 continue
- dnolev = 0.
- if (smin .lt. stemmin) then
- deficit = stemmin-smin
- nolevo = nolev1(ivx)
- nolev1(ivx) = nint(nolev1(ivx)+iul*deficit)
- dnolev = nolev1(ivx)-nolevo
- off1 = off1+dnolev
- off2 = off2+dnolev
- end if
- ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2
- if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and.
- * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax)
-c * .and. .not.btest(islur(ivx,ipb(1)),2)) then
- * .and. .not.btest(islur(ivx,ipb(1)),2)
- * .and. nnb.ne.1) then
-c
-c The first check is to save trouble of putting xtup's in setbm2.
-c The penultimate check is that first and last stems aren't both excessive.
-c The last check is that a 0 slope has not been forced
-c
- call setbm2(xelsk,nnb,sumx,sumy,ipb,islope(ivx),nolev1(ivx))
- end if
-c
-c Check if beam starts or ends too high or low.
-c
- xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)
- l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0.
- xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb)
- l2ng = iul*(xnolev2-ncmid(iv,ipb(nnb)))+xboff+7 .lt. 0
- if (l1ng .or. l2ng) then
-c
-c Need to correct start or stop, also slope
-c
- if (l1ng) then
- nolev1(ivx) = nint(ncmid(iv,ipb(1))-(7.+xboff)*iul)
- end if
- if (l2ng) then
- xnolev2 = nint(ncmid(iv,ipb(nnb))-(7.+xboff)*iul)
- end if
-c
-c Since one or the other end has changed, need to change slope
-c
-c if (.not.btest(islur(ivx,ipb(1)),2))
- if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1)
- * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb))
- end if
- if (nssb(ivx) .gt. 0) then
-c
-c This is a single-slope beam group. Store start heights for later segs.
-c
- do 3 issbs = 1 , nssb(ivx)
- lev1ssb(ivx,issbs) = nolev1(ivx)+islope(ivx)/slfac*
- * xelsk(lev1ssb(ivx,issbs))
-3 continue
- end if
- return
- end
- subroutine sortpoe(nsyst,poe,ipoe)
- parameter (nks=125)
- real*4 poe(nks)
- integer*4 ipoe(nks)
-c
-c Initialize ipoe:
-c
- do 3 iord = 1 , nsyst
- ipoe(iord) = iord
-3 continue
-c
-c Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will
-c be index of smallest poe, and ipoe(nsyst) will be index of biggest poe.
-c
- do 4 io1 = 1 , nsyst-1
- do 5 io2 = io1+1 , nsyst
- if (poe(ipoe(io1)) .gt. poe(ipoe(io2))) then
-c
-c Interchange the indices
-c
- itemp = ipoe(io1)
- ipoe(io1) = ipoe(io2)
- ipoe(io2) = itemp
- end if
-5 continue
-4 continue
- return
- end
- subroutine spsslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
- * isdat4,nsdat,notcrd,nolev,starter)
- parameter (nm=24)
-c
-c Reads in slur data. Record all h/v-shifts for non-chords, user-specified
-c ones for chords.
-c 5/26/02 This subr is called ONLY for postscript slurs.
-c
-c See subroutine doslur for bit values in isdat1,2,3
-c
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
- logical notcrd,btest
- character*128 lineq
- character*1 durq,dumq,starter
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- logical upslur,fontslur,WrotePsslurDefaults
-c
-c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve
-c
- numint = 0
- ivoff = 0
- ihoff = 0
- nsdat = nsdat+1
- if (starter.eq.'{' .or. starter.eq.'}')
- * isdat2(nsdat)=ibset(isdat2(nsdat),3)
- call setbits(isdat1(nsdat),5,13,iv)
- call setbits(isdat1(nsdat),1,12,kv-1)
- call setbits(isdat1(nsdat),8,3,ip)
- isdat3(nsdat) = 0
- isdat4(nsdat) = 0
- ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur
-c
-c Get ID code
-c
- call getchar(lineq,iccount,durq)
-c if (index('uldtb+-hfnHps ',durq) .gt. 0) then
- if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then
-c
-c Null id. Note for ps slurs, 'H' cannot be an ID
-c
- iccount = iccount-1
- if (lineq(iccount:iccount) .eq. 't') then
- idcode = 1
- else
- idcode = 32
- end if
- else
-c
-c Set explicit idcode
-c
- idcode = ichar(durq)
- if (lineq(iccount-1:iccount-1) .eq. 't') then
-c
-c Make t[ID] look like s[ID]t
-c
- isdat2(nsdat) = ibset(isdat2(nsdat),3)
- end if
- if (lineq(iccount+1:iccount+1).eq.'x') then
-c
-c Flag for 2-voice, indexed slurs
-c
- iccount = iccount+1
- call setbits(isdat1(nsdat),1,1,1)
- end if
- end if
- call setbits(isdat1(nsdat),7,19,idcode)
-c
-c Set start/stop: look thru list from end for same idcode,iv,kv
-c
- do 2 isdat = nsdat-1 , 1 , -1
- if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
- * iv .eq. igetbits(isdat1(isdat),5,13) .and.
-c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
- * (kv-1 .eq. igetbits(isdat1(isdat),1,12)
- * .or. btest(isdat1(isdat),1))) then
-c
-c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0.
-c
- if (btest(isdat1(isdat),11)) go to 3
-c
-c Found slur is a turnoff, so new one is a turnon. Jump down to set bit
-c
- go to 4
- end if
-2 continue
-c
-c If here, this is turnon.
-c
-4 continue
- isdat1(nsdat) = ibset(isdat1(nsdat),11)
-3 continue
-c
-c Now done with initial turnon- or turnoff-specifics.
-c
- if (nint(SlurCurve).ne.0 .and. btest(isdat1(nsdat),11)) then
-c
-c There's a default curvature tweak
-c
- icurv1 = nint(SlurCurve)+3
- if (icurv1 .eq. 2) icurv1 = 1
- isdat3(nsdat) = ibset(isdat3(nsdat),0)
- call setbits(isdat3(nsdat),6,2,32+icurv1)
- end if
-c
-c Loop for rest of input
-c
-1 call getchar(lineq,iccount,durq)
- if (index('uld',durq) .gt. 0) then
-c
-c Force direction
-c
- isdat1(nsdat) = ibset(isdat1(nsdat),26)
- if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
- go to 1
- else if (index('+-',durq) .gt. 0) then
- numint = numint+1
- if (numint .eq. 1) then
-c
-c Vertical offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- iccount = iccount-1
- ivoff = nint(fnum)
- if (durq .eq. '-') ivoff = -ivoff
- else if (numint .eq. 2) then
-c
-c Horizontal offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- iccount = iccount-1
-c
-c fnum is abs(hshift), must be 0 to 6.3
-c
- ihoff = fnum*10 + .5
- if (durq .eq. '-') ihoff = -ihoff
-c
-c Later will set bits to 1...127 to represent -6.3,...+6.3
-c
- else
-c
-c Must be the 3rd signed integer, so it's a curve specification
-c
- isdat3(nsdat) = ibset(isdat3(nsdat),0)
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- icurv1 = nint(fnum)
- if (durq .eq. '-') icurv1 = -icurv1
- call setbits(isdat3(nsdat),6,2,32+icurv1)
- if (dumq .ne. ':') then
-c
-c Back up the pointer and loop for more input
-c
- iccount = iccount-1
- else
-c
-c Expect two single digits as parameters for curve
-c
- isdat3(nsdat) = ibset(isdat3(nsdat),1)
- call setbits(isdat3(nsdat),3,8,
- * ichar(lineq(iccount+1:iccount+1))-48)
- call setbits(isdat3(nsdat),3,11,
- * ichar(lineq(iccount+2:iccount+2))-48)
- iccount = iccount+2
- end if
- end if
- go to 1
- else if (durq .eq. 't') then
- isdat2(nsdat) = ibset(isdat2(nsdat),3)
- go to 1
- else if (durq .eq. 'b') then
- isdat2(nsdat) = ibset(isdat2(nsdat),4)
- go to 1
- else if (durq .eq. 's') then
-c
-c Endpoint tweaks for linebreak slurs.
-c
- call getchar(lineq,iccount,durq) ! Must be +|-
-c
-c Next is vertical offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- if (durq .eq. '-') fnum=-fnum
- call setbits(isdat4(nsdat),6,ilb12*16,nint(fnum)+32)
- if (index('+-',dumq) .gt. 0) then
-c
-c Also a horizontal offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,durq,fnum)
- if (dumq .eq. '-') fnum=-fnum
- call setbits(isdat4(nsdat),7,ilb12*16+6,nint(10*fnum)+64)
- end if
- iccount = iccount-1
- ilb12 = 1
- go to 1
- else if (index('fnhH',durq).gt.0) then
-c
-c Special ps slur curvatures.
-c Translate to old \midslur args (1,4,5,6)
-c
- icurv1 = index('fnxhH',durq)
- if (icurv1 .eq. 5) then
-c
-c check for 2nd H
-c
- if (lineq(iccount+1:iccount+1) .eq. 'H') then
- iccount = iccount+1
- icurv1 = 6
- end if
- end if
- isdat3(nsdat) = ibset(isdat3(nsdat),0)
- call setbits(isdat3(nsdat),6,2,32+icurv1)
- go to 1
- else if (durq .eq. 'p') then ! Local adjustment
- call getchar(lineq,iccount,durq) ! +|-
- call getchar(lineq,iccount,dumq) ! s|t
-c 26 \sluradjust (p+s)
-c 27 \nosluradjust (p-s)
-c 28 \tieadjust (p+t)
-c 29 \notieadjust (p-t)
- if (durq .eq. '+') then
- if (dumq .eq. 's') then
- isdat2(nsdat) = ibset(isdat2(nsdat),26)
- else
- isdat2(nsdat) = ibset(isdat2(nsdat),28)
- end if
- else
- if (dumq .eq. 's') then
- isdat2(nsdat) = ibset(isdat2(nsdat),27)
- else
- isdat2(nsdat) = ibset(isdat2(nsdat),29)
- end if
- end if
- go to 1
- else if (durq .eq. 'v') then ! Stem slur
- isdat1(nsdat) = ibset(isdat1(nsdat),2)
- go to 1
- end if
-c
-c Record shifts
-c
- call setbits(isdat2(nsdat),6, 6,ivoff+32)
- call setbits(isdat2(nsdat),7,12,ihoff+64)
-c
-c Record chord flag, note level, notehead shift
-c
- if (notcrd) then
- call setbits(isdat2(nsdat),7,19,nolev)
- else
- nolevc = igetbits(icrdat(ncrd),7,12)
- call setbits(isdat2(nsdat),7,19,nolevc)
- isdat2(nsdat) = ibset(isdat2(nsdat),0)
- call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
- end if
- return
- end
- subroutine sslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
- * nsdat,notcrd,nolev,starter)
- parameter (nm=24)
-c
-c Reads in slur data. Record all h/v-shifts for non-chords, user-specified
-c ones for chords.
-c 5/26/02 now only for non-postscript slurs, use spsslur() for postscript
-c
-c See subroutine doslur for bit values in isdat1,2,3
-c
- common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
- * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
- * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
- integer*4 isdat1(202),isdat2(202),isdat3(202)
- logical notcrd,btest
- character*128 lineq
- character*1 durq,dumq,starter
- common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
- * ,WrotePsslurDefaults,SlurCurve
- logical upslur,fontslur,WrotePsslurDefaults
-c
-c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve
-c
- numint = 0
- ivoff = 0
- ihoff = 0
- nsdat = nsdat+1
- if (starter.eq.'{' .or. starter.eq.'}')
- * isdat2(nsdat)=ibset(isdat2(nsdat),3)
- call setbits(isdat1(nsdat),5,13,iv)
- call setbits(isdat1(nsdat),1,12,kv-1)
- call setbits(isdat1(nsdat),8,3,ip)
- isdat3(nsdat) = 0
-c
-c Get id letter
-c
- if (lineq(iccount:iccount) .eq. 't') then
-c
-c Old-style t-slur. Use special idcode = 1
-c
- idcode = 1
- else
- call getchar(lineq,iccount,durq)
- if (index('uldtb+-hf ',durq) .gt. 0) then
-c
-c Null id
-c
- idcode = 32
- iccount = iccount-1
- else if (durq.eq.'H') then
-c
-c Postscript slur, cannot use 'H' as code, must check for 2nd 'H'
-c
- idcode = 32
- iccount = iccount-1
-c
-c There may be another "H", but no need to deal with it yet
-c
- else
-c
-c Set explicit idcode
-c
- idcode = ichar(durq)
- end if
- end if
- call setbits(isdat1(nsdat),7,19,idcode)
-c
-c Set start/stop: look thru list from end for same idcode,iv,kv
-c
- do 2 isdat = nsdat-1 , 1 , -1
- if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
- * iv .eq. igetbits(isdat1(isdat),5,13) .and.
- * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
-c
-c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0.
-c
- if (btest(isdat1(isdat),11)) go to 3
-c
-c Found slur is a turnoff, so new one is a turnon. Jump down to set bit
-c
- go to 4
- end if
-2 continue
-c
-c If here, this is turnon.
-c
-4 continue
- isdat1(nsdat) = ibset(isdat1(nsdat),11)
-3 continue
-c
-c Now done with initial turnon- or turnoff-specifics. Loop for rest of input
-c
-1 call getchar(lineq,iccount,durq)
- if (index('uld',durq) .gt. 0) then
-c
-c Force direction
-c
- isdat1(nsdat) = ibset(isdat1(nsdat),26)
- if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
- go to 1
- else if (index('+-',durq) .gt. 0) then
- numint = numint+1
- if (numint .eq. 1) then
-c
-c Vertical offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- iccount = iccount-1
- ivoff = nint(fnum)
- if (durq .eq. '-') ivoff = -ivoff
- else if (numint .eq. 2) then
-c
-c Horizontal offset
-c
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- iccount = iccount-1
-c
-c fnum is abs(hshift), must be 0 to 6.3
-c
- ihoff = fnum*10 + .5
- if (durq .eq. '-') ihoff = -ihoff
-c
-c Later will set bits to 1...127 to represent -6.3,...+6.3
-c
- else
-c
-c Must be the 3rd signed integer, so it's a curve specification
-c
- isdat3(nsdat) = ibset(isdat3(nsdat),0)
- iccount = iccount+1
- call readnum(lineq,iccount,dumq,fnum)
- icurv1 = nint(fnum)
- if (durq .eq. '-') icurv1 = -icurv1
- call setbits(isdat3(nsdat),6,2,32+icurv1)
- if (dumq .ne. ':') then
-c
-c Back up the pointer and loop for more input
-c
- iccount = iccount-1
- else
-c
-c Expect two single digits as parameters for curve
-c
- isdat3(nsdat) = ibset(isdat3(nsdat),1)
- call setbits(isdat3(nsdat),3,8,
- * ichar(lineq(iccount+1:iccount+1))-48)
- call setbits(isdat3(nsdat),3,11,
- * ichar(lineq(iccount+2:iccount+2))-48)
- iccount = iccount+2
- end if
- end if
- go to 1
- else if (durq .eq. 't') then
- isdat2(nsdat) = ibset(isdat2(nsdat),3)
- go to 1
- else if (durq .eq. 'b') then
- isdat2(nsdat) = ibset(isdat2(nsdat),4)
- go to 1
- else if (index('fhH',durq) .gt. 0) then
-c
-c Special ps slur curvatures. Translate to old \midslur args (1,4,5,6)
-c
- icurv1 = 2+index('fhH',durq)
- if (icurv1 .eq. 3) then
- icurv1 = 1
- else if (icurv1 .eq. 5) then
-c
-c check for 2nd H
-c
- if (lineq(iccount+1:iccount+1) .eq. 'H') then
- iccount = iccount+1
- icurv1 = 6
- end if
- end if
- isdat3(nsdat) = ibset(isdat3(nsdat),0)
-c
-c Must change sign if downslur, but cannot do it now since we don't know
-c slur direction for sure.
-c
- call setbits(isdat3(nsdat),6,2,32+icurv1)
- go to 1
- end if
-c
-c Record shifts
-c
- call setbits(isdat2(nsdat),6, 6,ivoff+32)
- call setbits(isdat2(nsdat),7,12,ihoff+64)
-c
-c Record chord flag, note level, notehead shift
-c
- if (notcrd) then
- call setbits(isdat2(nsdat),7,19,nolev)
- else
- nolevc = igetbits(icrdat(ncrd),7,12)
- call setbits(isdat2(nsdat),7,19,nolevc)
- isdat2(nsdat) = ibset(isdat2(nsdat),0)
- call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
- end if
- return
- end
- subroutine stop1()
- call exit(1)
- end
- subroutine topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
- * xinstf1,mtrnmp,mtrdnp,vshrink,fbar,fontslur)
- parameter (nm=24)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink,fontslur
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
- * xinsnow,lowdot
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- character*79 inameq
- character*44 basenameq
- character*24 fmtq
- character*5 fbarq
- character*1 clefq(nm),sq,chax,clefqiv
- common /comstart/ facmtr
- logical vshrink,lowdot,rename
- logical novshrinktop,cstuplet
- common /comnvst/ novshrinktop,cstuplet
- common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
- * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
- logical EarlyTransOn,LaterInstTrans
- common /comsize/ isize(nm)
- common /comis4bignv/ is4bignv,AIset
- logical is4bignv,AIset
- common /comc8flag/ c8flag(nm)
- logical c8flag
- sq = chax(92)
- vshrink = xinstf1.gt.20. .and. .not.novshrinktop
- if (vshrink) then
- xinsnow = 10.
- else
- xinsnow = xinstf1
- end if
- if (.not.islast) return
-c
-c Initialize octave treble clef tracker
-c
- do 6 im = 1 , nm
- c8flag(im) = .false.
-6 continue
- write(11,'(a)')'%%%%%%%%%%%%%%%%%'
- write(11,'(a)')'%'
- write(11,'(a)')'% '//basenameq(1:lbase)//'.tex'
- write(11,'(a)')'%'
- write(11,'(a)')'%%%%%%%%%%%%%%%%'
- write(11,'(a)')sq//'input musixtex'
- write(11,'(a)')sq//'input pmx'
- write(11,'(a)')
- * sq//'setmaxslurs{24}'//sq//'setmaxinstruments{24}%'
- if (.not.fontslur) write(11,'(a)')sq//'input musixps'
-c
-c Need to input musixmad to permit more slurs.
-c
- if (musicsize .eq. 20) then
- write(11,'(a)')sq//'normalmusicsize%'
- else if (musicsize .eq. 16) then
- write(11,'(a)')sq//'smallmusicsize%'
- else if (musicsize .eq. 24) then
- write(11,'(a)')sq//'largemusicsize%'
-c
-c Eliminate, per Tennent's analysis and musixtex changes since first input
-c
-c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
-c * 'meterlargefont}%'
- else if (musicsize .eq. 29) then
- write(11,'(a)')sq//'Largemusicsize%'
-c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
-c * 'meterLargefont}%'
- end if
-c
-c Set sizes. Have sizes per staff in isize(.) and noinst per staff in
-c nsperi(.)
-c
-c 130324
-c iiv = 1
- do 5 iinst = 1 , noinst
-c if (isize(iiv) .eq. 1) then
- if (isize(iinst) .eq. 1) then
- if(iinst.le.9) then
- write(11,'(a8,i1,a)')
- * sq//'setsize',iinst,sq//'smallvalue%'
- else
- write(11,'(a9,i2,a)')
- * sq//'setsize{',iinst,'}'//sq//'smallvalue%'
- end if
-c else if (isize(iiv) .eq. 2) then
- else if (isize(iinst) .eq. 2) then
- if(iinst.le.9) then
- write(11,'(a8,i1,a)')
- * sq//'setsize',iinst,sq//'tinyvalue%'
- else
- write(11,'(a9,i2,a)')
- * sq//'setsize{',iinst,'}'//sq//'tinyvalue%'
- end if
- end if
-c iiv = iiv+nsperi(iinst)
-5 continue
- write(fbarq,'(f5.3)')fbar
- write(11,'(a)')sq//'nopagenumbers'
- write(11,'(a)')sq//'tracingstats=2'//sq//'relax'
- write(11,'(a7,i3,a2)')sq//'hsize=',nint(widthpt),'pt'
- write(11,'(a6,i'//chax(49+int(log10(height+.1)))//',a2)')
- * sq//'vsize',int(height+.1),'pt'
- if (abs(hoffpt) .gt. 0.1) then
- if (hoffpt .le. -10.) then
- write(11,'(a8,i3,a2)')sq//'hoffset',nint(hoffpt),'pt'
- else if (hoffpt .lt. 0.) then
- write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
- else if (hoffpt .lt. 10.) then
- write(11,'(a8,i1,a2)')sq//'hoffset',nint(hoffpt),'pt'
- else
- write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
- end if
- end if
- if (abs(voffpt) .gt. 0.1) then
- if (voffpt .le. -10.) then
- write(11,'(a8,i3,a2)')sq//'voffset',nint(voffpt),'pt'
- else if (voffpt .lt. 0.) then
- write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
- else if (voffpt .lt. 10.) then
- write(11,'(a8,i1,a2)')sq//'voffset',nint(voffpt),'pt'
- else
- write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
- end if
- end if
-c
-c The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if
-c 3 sharps and treble clef, to avoid vertical clash with top space g#
-c
- if (isig.eq.3 .and. clefq(nv).eq.'t') write(11,'(a)')
- * sq//'def'//sq//'raisebarno{4.5'//sq//'internote}'
- if (noinst .lt. 10) then
- write(11,'(a19,i1,a1)')sq//'def'//sq//'nbinstruments{',
- * noinst,'}'
- else
- write(11,'(a19,i2,a1)')sq//'def'//sq//'nbinstruments{',
- * noinst,'}'
- end if
- iv = 0
- do 1 iinst = 1 , noinst
- nstaves = nsperi(iinst)
- if (iinst .lt. 10) then
- write(11,'(a)')sq//'setstaffs'//chax(48+iinst)
- * //chax(48+nstaves)
- else
- write(11,'(a11,i2,a)')sq//'setstaffs{',iinst,'}'
- * //chax(48+nstaves)
- end if
- iv = iv+1
- clefqiv = clefq(iv)
- if (clefqiv.eq.'8') then
- clefqiv='t'
- iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
- c8flag(iv) = .true.
- end if
- if (nstaves .eq. 1) then
- fmtq = chax(48+numclef(clefq(iv)))
- lfmtq = 1
- else
- fmtq = '{'//chax(48+numclef(clefq(iv)))
- lfmtq = 2
- do 2 k = 2 , nstaves
- iv = iv+1
- fmtq = fmtq(1:lfmtq)//chax(48+numclef(clefq(iv)))
- lfmtq = lfmtq+1
-2 continue
- fmtq = fmtq(1:lfmtq)//'}'
- lfmtq = lfmtq+1
- end if
- if (iinst .lt. 10) then
- write(11,'(a)')sq//'setclef'//chax(48+iinst)//fmtq(1:lfmtq)
- else
- write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq)
- end if
- if (clefq(iv) .eq. '8') then
- if (iinst .lt. 10) then
- write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)//
- * sq//'treblelowoct%'
- else
- write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'//
- * sq//'treblelowoct%'
- end if
- c8flag(iv) = .true.
- end if
- do 3 lname = 79 , 2 , -1
- if (inameq(iinst)(lname:lname) .ne. ' ') go to 4
-3 continue
-4 continue
- lnam(iinst) = lname
- if (iinst .lt. 10) then
- write(11,'(a8,i1,a)')sq//'setname',iinst,
- * '{'//inameq(iinst)(1:lname)//'}'
- else
- write(11,'(a9,i2,a)')sq//'setname{',iinst,
- * '}{'//inameq(iinst)(1:lname)//'}'
- end if
-1 continue
- write(11,'(a18,i2,a2)')sq//'generalsignature{',isig,'}%'
- if (EarlyTransOn)
- * call Writesetsign(nInstTrans,iInstTrans,iTransKey,EarlyTransOn)
- call wgmeter(mtrnmp,mtrdnp)
- ipi = nint(fracindent*widthpt)
- if (ipi .lt. 10) then
- write(11,'(a11,i1,a2)')sq//'parindent ',ipi,'pt'
- else if (ipi .lt. 100) then
- write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
- else
- write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
- end if
- write(11,'(a)')sq//'elemskip1pt'//sq//'afterruleskip'
- * //fbarq//'pt'//sq//'beforeruleskip0pt'//sq//'relax'
- if (.not.vshrink) then
- if (xinstf1 .lt. 9.95) then
- fmtq = '(a,f3.1,a)'
- else
- fmtq = '(a,f4.1,a)'
- end if
- facis = 1.
- if (is4bignv) facis = .95
- write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt'
- * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax'
- else
- write(11,'(a)')sq//'stafftopmarg0pt'//
- * sq//'staffbotmarg5'//sq//'Interligne'//sq//
- * 'interstaff{10}'//sq//'relax'
- end if
- if (nv.eq.1) write(11,'(a)')sq//'nostartrule'
- write(11,'(a)')sq//'readmod{'//basenameq(1:lbase)//'}'
- if (cstuplet) then
- write(11,'(a)')sq//'input tuplet'
- * //sq//'def'//sq//'xnumt#1#2#3{'//sq//'zcharnote{#2}{~}'
- * //sq//'def'//sq//'tuplettxt{'//sq//'smalltype'//sq//'it{#3}'
- * //sq//'/'//sq//'/}}%'
- write(11,'(a)')sq//'let'//sq//'ovbkt'//sq//'uptuplet'
- * //sq//'let'//sq//'unbkt'//sq//'downtuplet%'
- end if
- write(11,'(a)')sq//'startmuflex'//sq//'startpiece'//sq//
- * 'addspace'//sq//'afterruleskip%'
- return
- end
- character*1 function udfq(nolev,ncm)
-c
-c Slur directions
-c
- common /combc/ bcspec
- logical bcspec
- ntest = nolev-ncm
- if (ntest.lt.0 .or.
- * (ntest.eq.0 .and. bcspec .and. ncm.eq.23) ) then
- udfq = 'd'
- else
- udfq = 'u'
- end if
- return
- end
- character*1 function udqq(nole,ncm,isl,nvmx,ivx,nv)
-c
-c Stem direction for single notes
-c
- character*1 ulfq
- character*1 udqqq
- logical btest
- if (btest(isl,30)) then
-c
-c Absolute override
-c
- if (btest(isl,17)) then
- udqqq = 'u'
- else
- udqqq = 'l'
- end if
- else if (nvmx .eq. 1) then
-c
-c Single voice per staff, default
-c
- udqqq = ulfq(1.*nole,ncm)
- else
-c
-c Multi-voice per staff, 1st is lower, 2nd upper
-c
- if (ivx .le. nv) then
- udqqq = 'l'
- else
- udqqq = 'u'
- end if
- end if
- udqq = udqqq
- return
- end
- character*1 function ulfq(xnolev,ncm)
-c
-c Stem directions
-c
- common /combc/ bcspec
- logical bcspec
- test = xnolev-ncm
- if (test.lt.-.001 .or.
- * (test.lt..001.and.bcspec.and.ncm.eq.23) ) then
- ulfq = 'u'
- else
- ulfq = 'l'
- end if
- return
- end
- function upcaseq(chq)
- character*1 chq,upcaseq,chax
- if (ichar(chq).ge.61.and.ichar(chq).lt.122) then
- upcaseq = chax(ichar(chq)-32)
- else
- upcaseq = chq
- print*,'Warning, upcaseq was called with improper argument: '
- * //chq
- stop
- end if
- return
- end
- subroutine wgmeter(mtrnmp,mtrdnp)
-c
-c Writes meter stuff to file 11, so only called if islast=.true.
-c
- character*1 sq,chax
- if (mtrdnp .eq. 0) return
- sq=chax(92)
- if (mtrnmp.gt.0 .and. mtrnmp.le.9) then
- if (mtrdnp .lt. 10) then
- write(11,'(a25,i1,a2,i1,a3)')
- * sq//'generalmeter{'//sq//'meterfrac{',
- * mtrnmp,'}{',mtrdnp,'}}%'
- else
- write(11,'(a25,i1,a2,i2,a3)')
- * sq//'generalmeter{'//sq//'meterfrac{',
- * mtrnmp,'}{',mtrdnp,'}}%'
- end if
- else if (mtrnmp .ge. 10) then
- if (mtrdnp .lt. 10) then
- write(11,'(a25,i2,a2,i1,a3)')
- * sq//'generalmeter{'//sq//'meterfrac{',
- * mtrnmp,'}{',mtrdnp,'}}%'
- else
- write(11,'(a25,i2,a2,i2,a3)')
- * sq//'generalmeter{'//sq//'meterfrac{',
- * mtrnmp,'}{',mtrdnp,'}}%'
- end if
- else if (mtrnmp .lt. 0) then
- write(11,'(a26,i1,a2,i1,a3)')
- * sq//'generalmeter{'//sq//'meterfracS{',
- * -mtrnmp,'}{',mtrdnp,'}}%'
- else if (mtrdnp .le. 4) then
- write(11,'(a21,i1,a2)')
- * sq//'generalmeter{'//sq//'meterN',mtrdnp,'}%'
- else if (mtrdnp .eq. 5) then
- write(11,'(a)')sq//'generalmeter'//sq//'allabreve%'
- else if (mtrdnp .eq. 6) then
- write(11,'(a)')sq//'generalmeter'//sq//'meterC%'
- else if (mtrdnp .eq. 7) then
- write(11,'(a)')sq//'generalmeter'//sq//'meterIIIS%'
- end if
- return
- end
- subroutine writemidi(jobname,ljob)
- parameter(nm=24,mv=24576)
- common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
- * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
- * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
- * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
- * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
- * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
- * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
- * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
- * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
- character*1 ulq,sepsymq,sq
- logical beamon,firstgulp,figbass,figchk,isfig
- character*1 byteq(4),char,chax
- character*10 tempoq,instq
- character*44 jobname
- integer*2 mmidi
- logical restpend,relacc,notmain,twoline,ismidi,crdacc
- common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
- * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
- * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
- * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
- * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
- * debugmidi
- logical debugmidi
- common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
- * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
- common /comevent/ miditime,lasttime
- logical mmacrec,gottempo
- common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
- * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
- * mmacrec,gottempo
- character*79 inameq
- common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
- * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
- * lnam(nm),inameq(nm)
- logical rename
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
-c
-c Used to be icmm(0:nm); did midi fail when nv>16?
-c
- integer*2 iinsiv,icmm(0:15)
- character*5 versionc
- common /comver/ versionc
-c
-c These are not consecutive because channel 9 is reserved for percussion.
-c
- data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
-c
-c Write Header
-c
- write(51,'(a,$)')'MThd'//char(0)//char(0)//char(0)//char(6)
- * //char(0)//char(1)//char(0)//char(numchan+1)//char(0)//char(240)
- if (debugmidi)
- * write(52,'(a6,10Z4)')'"MThd"',0,0,0,6,
- * 0,1,0,numchan+1,0,240
-c
-c Write the "conductor" track, for keys, meter, and tempos
-c Get the number of bytes in the conductor event stream
-c
- ndata = 1+imidi(numchan)-msecstrt(numchan,nmidsec)
- do 15 isec = 1 , nmidsec-1
- ndata = ndata+1+msecend(numchan,isec)-msecstrt(numchan,isec)
-15 continue
-c ib1 = (4+ljob+26+ndata+4)/256
-c ib0 = 4+ljob+26+ndata+4-256*ib1
- ib1 = (4+ljob+27+ndata+4)/256
- ib0 = 4+ljob+27+ndata+4-256*ib1
- write(51,'(a,$)')'MTrk'//char(0)//char(0)//char(ib1)//char(ib0)
-c
-c Text header
-c
-c * //char(0)//char(255)//char(1)//char(ljob+26)
- * //char(0)//char(255)//char(1)//char(ljob+27)
- if (debugmidi)
- * write(52,'(a6,8z4)')'"MTrk"',0,0,ib1,ib0,
- * 0,255,1,ljob+27
- write(51,'(a,$)')jobname(1:ljob)
- if (debugmidi) write(52,'(a)')'"'//jobname(1:ljob)//'"'
-c
-c (separate writes are needed to defeat compiler BUG!!!)
-c
-c write(51,'(a,$)')'.mid, produced by PMX 2.30'
- write(51,'(a,$)')'.mid, produced by PMX '//versionc
- if (debugmidi) write(52,'(a)')
- * '".mid, produced by PMX '//versionc//'"'
-c
-c Conductor event data: Loop over sections.
-c
- do 16 isec = 1 , nmidsec
- if (isec .lt. nmidsec) then
- mend = msecend(numchan,isec)
- else
- mend = imidi(numchan)
- end if
- do 17 i = msecstrt(numchan,isec) , mend
- write(51,'(a,$)')char(mmidi(numchan,i))
- if (debugmidi) write(52,'(z4)')mmidi(numchan,i)
-17 continue
-16 continue
-c
-c And close out the time sig / tempo track.
-c
- write(51,'(a,$)')char(0)//char(255)//char(2*16+15)//char(0)
- if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
-c
-c Loop over track for each voice: The following sets up iv.
-c
- iv = nv
- if (twoline(nv)) then
- kv = 2
- else
- kv = 1
- end if
-c
- do 5 icm = 0 , numchan-1
-c
-c Get the number of bytes in the data stream
-c
- ndata = 1+imidi(icm)-msecstrt(icm,nmidsec)
- do 11 isec = 1 , nmidsec-1
- ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec)
-11 continue
-c
-c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count,
-c
- ndata = ndata+11
-c
-c Add 4+lnam(iinsiv(iv)) if lnam>0 ,
-c
- if (lnam(iinsiv(iv)).gt.0) ndata = ndata+4+lnam(iinsiv(iv))
-c
-c Separate total byte counts into 4 bytes
-c
- do 2 ibyte = 1 , 4
- if (ndata .gt. 0) then
- byteq(ibyte) = char(mod(ndata,256))
- ndata = ishft(ndata,-8)
- else
- byteq(ibyte) = char(0)
- end if
-2 continue
-c
-c Now write front stuff for this track
-c
- write(51,'(a,$)')'MTrk'//byteq(4)//byteq(3)//byteq(2)//byteq(1)
- * //char(0)//char(12*16+icmm(icm))//char(midinst(iinsiv(iv)))
- * //char(0)//char(11*16+icmm(icm))//char(10)//char(midbc(icm))
- if (debugmidi) write(52,'(a4,z2,a7,11z4)')'icm=',icm,
- * ' "MTrk"',ichar(byteq(4)),ichar(byteq(3)),ichar(byteq(2)),
- * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iinsiv(iv)),
- * 0,11*16+icmm(icm),10,midbc(icm)
- if (lnam(iinsiv(iv)) .gt. 0) then
-c
-c Add instrument name as sequence name
-c
- write(51,'(a,$)')char(0)//char(255)//char(3)
- * //char(lnam(iinsiv(iv)))
- if (debugmidi) write(52,'(4z4)')0,255,3,lnam(iinsiv(iv))
- write(51,'(a,$)')
- * inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))
- if (debugmidi) write(52,'(a)')
- * '"'//inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))//'"'
- end if
- write(tempoq,'(i2)')icm
- write(instq,'(i3)')midinst(iinsiv(iv))
- call printl('MIDI instrument '//tempoq(1:2)//' is '//instq(1:3))
-c
-c Notes: Loop over sections.
-c
- do 9 isec = 1 , nmidsec
- if (isec .lt. nmidsec) then
- mend = msecend(icm,isec)
- else
- mend = imidi(icm)
- end if
- do 10 i = msecstrt(icm,isec) , mend
- write(51,'(a,$)')char(mmidi(icm,i))
- if (debugmidi) write(52,'(z4)')mmidi(icm,i)
-10 continue
-9 continue
-c
-c Closing 4 bytes
-c
- write(51,'(a,$)')chax(0)//char(255)//char(2*16+15)//char(0)
- if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
- if (kv .eq. 2) then
- kv = 1
- else if (iv .eq. 1) then
- go to 5
- else
- iv = iv-1
- if (twoline(iv)) kv=2
- end if
-5 continue
- write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan)
- write(15,'(1x,a12,(10i6))')
- * 'Bytes used:',(imidi(icm),icm=0,numchan)
- close(51)
- if (debugmidi) close(52)
- return
- end
- subroutine Writesetsign(nInstTrans,iInstTrans,iTransKey,flag)
- parameter(nm=24)
- integer*4 iInstTrans(nm),iTransKey(nm)
- character*79 notexq
- character*1 chax
- logical flag
-c
-c Assumes notexq is blank
-c
- do 1 i = 1 , nInstTrans
- notexq = chax(92)//'setsign'
- lnote = 8
- if (iInstTrans(i) .lt. 10) then
- notexq = notexq(1:lnote)//chax(48+iInstTrans(i))
- lnote = lnote+1
- else
- write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
- * '{',iInstTrans(i),'}'
- lnote = lnote+4
- end if
- if (iTransKey(i) .lt. 0) then
- write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
- * '{',iTransKey(i),'}'
- lnote = lnote+4
- else
- notexq = notexq(1:lnote)//chax(48+iTransKey(i))
- lnote = lnote+1
- end if
- write(11,'(a)')notexq(1:lnote)//'%'
-1 continue
- flag = .false.
- return
- end
- subroutine writflot(x,notexq,lenline)
- character*(*) notexq
- if (x .lt. 0.95) then
- write(notexq(lenline+1:lenline+2),'(f2.1)')x
- lenline = lenline+2
- else if (x .lt. 9.95) then
- write(notexq(lenline+1:lenline+3),'(f3.1)')x
- lenline = lenline+3
- else
- write(notexq(lenline+1:lenline+4),'(f4.1)')x
- lenline = lenline+4
- end if
- return
- end
- subroutine wsclef(iv,ninow,nclef)
-c subroutine wsclef(iv,ninow,clefq,nclef)
-c
-c Writes \setclef for instrument containing *staff* iv
-c
- parameter (nm=24)
- common /comlast/ islast,usevshrink
- logical islast,usevshrink
- common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
- logical rename
-c
-c In pmx271, had removed clefq, so with 2 or more staves in
-c an instrument, had problems. So replace in 272
-c
- common /comclefq/ clefq(nm)
- character*1 clefq,chax
- character*40 temq
- common /comc8flag/ c8flag(nm)
- logical c8flag
- if (nclef .lt. 7) then
- clefq(iv) = chax(48+nclef)
- else
- clefq(iv)='9'
- end if
- if (.not.islast) return
- iv1 = 1
- do 1 iinst = 1 , ninow
- if (iv .lt. iv1+nspern(iinst)) go to 2
- iv1 = iv1+nspern(iinst)
-1 continue
- print*
- print*,'Should not be here in wsclef!'
- call stop1()
-2 continue
-c
-c Here, iinst is the instrument number with staff of clef change
-c
- iv2 = iv1+nspern(iinst)-1
- if (iinst .lt. 10) then
- temq = chax(92)//'setclef'//chax(48+iinst)
- ltem = 9
- else
- write(temq,'(a9,i2,a1)') chax(92)//'setclef{',iinst,'}'
- ltem = 12
- end if
- if (iv1 .eq. iv2) then
-c
-c Only one staff (iv) in instrument with clef change
-c
- write(11,'(a)')temq(1:ltem)//clefq(iv)//'%'
- else
- temq = temq(1:ltem)//'{'
- ltem = ltem+1
-c
-c Loop over staves, but clefq has only changed for one of them
-c
- do 3 iiv = iv1 , iv2
- temq = temq(1:ltem)//chax(48+numclef(clefq(iiv)))
- ltem = ltem+1
-3 continue
- write(11,'(a)')temq(1:ltem)//'}%'
- end if
- if (c8flag(iv)) then
-c
-c If we change FROM octave treble clef to some other, need the following.
-c
- write(11,'(a)')char(92)//'settrebleclefsymbol'//chax(48+iinst)
- * //char(92)//'trebleclef%'
- c8flag(iv) = .false.
- end if
- return
- end
- subroutine chkpmxlyr(lineq,iccount,lyrerr)
- character*128 lineq
- character*1 charq
- lyrerr = 0
-c
-c On entry, last char was "
-c
-18 call g1etchar(lineq,iccount,charq)
- if (iccount .eq. 121) then
- lyrerr = 2
- return
-c else if (charq.eq.'"') then
- else if (charq.eq.'"' .and.
- * .not.(lineq(iccount-1:iccount-1).eq.char(92))) then
- call g1etchar(lineq,iccount,charq)
-c
-c Check for raise/lower command
-c
- if (charq .eq. '@') then
-c
-c @ positions lyrics vertically for current voice
-c [a,b] above or below of the staff
-c +/- i offset, \internotes
-c
- call g1etchar(lineq,iccount,charq)
- if (index('ab',charq).eq.0) then
- lyrerr = 3
- return
- end if
- call g1etchar(lineq,iccount,charq)
- if (index('+-',charq).eq.0) then
- lyrerr = 4
- return
- end if
- call g1etchar(lineq,iccount,charq)
- if (index('0123456789',charq).eq.0) then
- lyrerr = 5
- return
- end if
- else if (charq .ne. ' ') then
-c
-c 2nd " must be followed by ' '
-c
- lyrerr = 1
- return
- end if
- return
- end if
- go to 18
- end
- subroutine dopmxlyr(lineq,iccount)
-c
-c lineq has " at iccount. Find end of lyrics string, replace "..."
-c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ',
-c (unless preceded with '\'), check length
-c
- character*128 lineq,lineqt
- character*1 sq,chax
- sq = chax(92)
- iend = lenstr(lineq,128)
-c
-c i2nd = iccount+index(lineq(iccount+1:128),'"')
-c Find position of closing '"'; must bypass any \" which is used for umlaut
-c
- i2nd = iccount+index(lineq(iccount+1:128),'"')
-2 continue
- if (lineq(i2nd-1:i2nd-1).eq.char(92)) then
- i2nd = i2nd+index(lineq(i2nd+1:128),'"')
- go to 2
- end if
- istart = iccount
-1 itilde = istart+index(lineq(istart+1:i2nd-1),'~')
- if (itilde.gt.istart.and.itilde.lt.i2nd) then
-c
-c Replace tilde if not preceded by \
-c
- if (iend .ge. 117) then
- print*,'Sorry, lyric string is too long, stopping'
- call stop1()
- else if (lineq(itilde-1:itilde-1) .eq. sq) then
- istart = itilde
- go to 1
- end if
- lineqt = lineq(1:itilde-1)//sq//'lk '
- * //lineq(itilde+1:iend)
- iend = lenstr(lineqt,128)
- i2nd = i2nd+3
- lineq = lineqt
- go to 1
- end if
- if (iccount .eq. 1) then
- lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq
- * //lineq(i2nd+1:128)
- else
- lineqt = lineq(1:iccount-1)//sq//'pmxlyr{'
- * //lineq(iccount+1:i2nd-1)//'}'//sq
- * //lineq(i2nd+1:128)
- end if
- i2nd = i2nd+8
- lineq = lineqt
- if (lineq(i2nd+1:i2nd+1) .eq. '@') then
- lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq
- * //lineq(i2nd+5:128)
- lineq = lineqt
- end if
- return
- end
- subroutine inst2chan(midc,midi,midchan,nv,iinsiv,twoline)
-c propagate per-instrument quantities to per-channel ones
- parameter (nm=24)
- integer*4 midc(0:nm),midi(nm),midchan(nm,2)
- integer*2 iinsiv(nm)
- logical twoline(nm)
- do iv = nv, 1, -1
- if (twoline(iv)) then
- midc(midchan(iv,2)) = midi(iinsiv(iv))
- end if
- midc(midchan(iv,1)) = midi(iinsiv(iv))
- end do
- end
-
-
+ program pmxab
+c
+c This program, PMX, developed by Don Simons
+c (dsimons@roadrunner.com), is a preprocessor for MusiXTeX. In concert with
+c MusiXTeX and TeX, its purpose is to allow the user to create high-quality
+c typeset musical scores by including a sequence of PMX commands in an ASCII
+c input file.
+c
+c This program is free software: you can redistribute it and/or modify
+c it under the terms of the GNU General Public License as published by
+c the Free Software Foundation, either version 3 of the License, or
+c (at your option) any later version.
+c
+c This program is distributed in the hope that it will be useful,
+c but WITHOUT ANY WARRANTY; without even the implied warranty of
+c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+c GNU General Public License for more details.
+c
+c You should have received a copy of the GNU General Public License
+c along with this program. If not, see <http://www.gnu.org/licenses/>.
+c
+c
+ character*9 date
+ character*5 version,versionc
+ common /comver/ versionc
+c
+c To compile with gfortran:
+c 1. Merge all files using copy *.for epmx[nnnn].for
+c 2. Search and replace all character*65536 with character*131072
+c 3. Comment/uncomment getarg lines
+c 4. gfortran -O pmx[nnnn].for -o pmxab.exe
+c
+c To do
+c Correct Rainer's email address in manual
+c Linesplit (\\) in h
+c Tt at start of a movement.
+c Toggle midi on or off; allow midi only.
+c Page number printed on 1st page even if 1 system.
+c Still need inserted space for chordal accidentals
+c Voicewise transposition.
+c better segno
+c coda
+c duevolte
+c Fix xtup bracket direction in 2-line staves?? (maybe leave as is)
+c Sticky ornaments with shifts.
+c Deal with Werner's vertical spacing thing associated with title.
+c Multiple ties in midi
+c Werner's missing c in MIDI due to start/stop ties on same note.
+c Beams with single 64ths
+c 128ths and/or dotted 64ths
+c Close out MIDI with integral # of beats?
+c Increase ast dimensions or redo logic.
+c Does slur direction get set for user-defined single-note stem dir'ns?
+c Transpose by sections.
+c Optimization loop over sections only
+c Command-line option to read nbarss in. Write out nbarss when optimizing.
+c (or just read from .plg?)
+c Beams over bar lines.
+c 2-digit figures
+c A real coule (slanted line between notes in a chord)
+c Dotted slurs for grace notes.
+c Undotted chord notes with dotted main note.
+c Forced line break without line number
+c Fix dot moving when 2nds in chord get flipped
+c To do: increase length on notexq in dodyn
+c 2.98
+c Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...)
+c 2.97
+c Fix problem with beaming after new movement command
+c 2.96 and 2.95
+c replace and '\','/'. and '"' with chax();
+c eliminate do loops with shared last line
+c delete superfluous comments in source
+c 2.94
+c Allow moving dots on main and chord note in 2-note termolos
+c Add definitions of \hbp and \hbpp to pmx.tex
+c 2.91
+c Tweak: insert \stdstemfalse before every user-shortened or lengthened stem.
+c This cancels defaul extensions to middle line and also (with 'L') allows
+c stems that are longer than 4.66 but still don't reach middle line.
+c Allow alteration of number height in multibar rest, option n.
+c Fix bug introduced in 2.89 so that the "o" in "mo800" is now OK.
+c 2.90
+c Many tweaks to allow gaps at end or middle of a system using
+c L[n]S[x] and LC[y]. New pmx.tex.
+c 2.88
+c Comment out print*,"Changed pathname to..." since it was going
+c iteration when optimizing linebreaks with the undocumented option Ao.
+c Add nv back in as argument for getmidi, so loop transferring data
+c from midivel to midvelc can be executed. This corrects bug and
+c allows per-instrument change in midi velocities at the start
+c of any block
+c Add subroutine inst2chan to transfer midi data as noted above. Works with
+c Iv but buggy when used with IT and Ib
+c 2.87
+c Allow changes to and from octave treble clef. Instrument with it
+c must only have one staff.
+c Some fixes for beam multiplicity changes at staff jumps. Must still
+c use inline for mult. increase at downward staff jump. See sjb.pmx.
+c 2.84
+c Bug fix: dots in chordal seconds
+c Bug fix: Initialize ihornb for non-beamed, down xtup
+c Bug fix: When using "AT" with 2-note x3c rD.
+c 2.83
+c Fix problems when changing to or from octave treble clef.
+c Fix beaming (or not) and number location for xtups with
+c multiple rests. Still some problems with number height but
+c can be band-aided with number height tweak option.
+c Tweak error messages for options on "R" command.
+c Allow forced beam height and slope tweaks with 2-note tremolos
+c Allow chordal note with 2-note tremolos, adding dots as needed.
+c Fix call to ncmid in beamstrt when setting start height for beam of
+c 2-note trem, by changing arg from ivx to iv
+c 2.82
+c bugfix: beams with rests, not confused with xtups.
+c x option after slur index to allow slurs to go from one voice to another.
+c x option also for ties
+c 2.81
+c Allow string of rests to end xtup
+c in chordal half-note 2-note tremolo, make chord notes open.
+c 2.80
+c Add 2-note tremolos
+c 2.78
+c Expand bufq to 131072 bytes
+c Expand maxblks tp 9600
+c Allow up to 75 pages
+c Index postscript hairpins from 1 up instead of by voice #.
+c Add option 'o' to forced beam for open notehead (\hb); set ipl(3)
+c Add option T[n], n=1,2,3 for single stem tremolo
+c 2.77
+c Enable AV+/-x+/-y to add vskip bigh before or after \eject
+c 2.76
+c 2.75
+c Bugfix: unbeamed xtups with dots: in beamn1 and beamid allow dotted 16th, and
+c 2 or 3 flags on shortened note.
+c 2.74
+c Bugfix: allow "0" as argument of @ command on lyrics string.
+c Check for and allow "\ in centered page headings with P command.
+c Check for and allow "\ in text dynamics with D command.
+c For lyrics string starting in xtuplet, insert check for inputting musixlyr.
+c For staff-crossing beamed xtuplet chords, if 2nd segment of a joined beam
+c starts with a blank rest, put '\sk' into the TeX.
+c To enable high-to-both beamed etup staff-crossing chord, for blank
+c rest at start of forced beam, shift \sk's from before to after \ib..;
+c so \ib is at start and note in upper voice has a beam to connect to.
+c Expand range of vertical xtup number shift, now stored in mult(16-22)
+c Check for and allow \" within lyrics strings, for umlauts.
+c 2.73 (160121)
+c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as
+c inline TeX. Replace all '~' inside "..." and not preceded with '\', by
+c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\
+c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ",
+c add (as type 2 string) '\\input musixlyr \'
+c After inputting pathname, change any '\' to '/', for Linux compatibility.
+c 2.72 (160110)
+c Really finalize \mbrest...go back to 3 args to deal with clef changes.
+c Fine tune centered whole bar rests to deal with clef changes
+c Fix bug in wsclef when >1 staff per instrument, since \setclef
+c needs to know instrument and specify clefs on all staves for that
+c instrument. Ones that were not changed by user will not be printed,
+c and will be kept the same as before.
+c Fix bug with arpegii from one voice to another in same staff.
+c 2.71 (151226)
+c Finalize mbrest mods
+c 2.705
+c Fix error message
+c 2.704 (140614)
+c Octave treble clef
+c Make horizontal ornament shift (ornhshft) floating
+c 2.703 (140323)
+c Option v[-]n at end of any figure will alter figdrop for rest of system
+c 2.702
+c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v"
+c 2.701
+c oC = coda (\code{10})
+c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote)
+c oG = new seqno
+c To do: fix grace note spacing problem (partially done)
+c 2.622
+c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes
+c Kn[+/-...] \ignorenats at signature changes
+c Fix tie checks in doslur() and dopsslur() to subtract iTransAmt from nolevs
+c before checking and setting pitch levels levson() and levsoff()
+c Define midisig separately from isig. Put in common commidisig.
+c Use for explicit midi signature and for accid corrections to midi piches
+c in addmidi.
+c 2.621
+c Make keyboard rest option work in xtuplets. Created subroutine
+c chkkbdrests, modified make2bar to include calls to chkkbdrests as rqd.
+c 2.620
+c Allow user-defined rest height tweaks at start of beam.
+c 2.619
+c At movement break, change \nbinstruments in \newmovement macro; add
+c 3rd arg to \newmovement in pmx.tex; modify pmxb.for and getnote.for
+c to remove call to newnoi and change call to \newmovement
+c 2.618
+c Add option Ac[l,4] to set vert and horiz size and offsets to properly
+c center page for letter or a4 paper.
+c 2.617
+c In g1etnote, change if-check for note to use index(...) instead
+c of ichar(charq) since it was messing up gfortran optimizer
+c After pmxa, search for and remove penultimate line <blank><blank>/
+c because it was screwing up linux-compiled versions
+c Bugfix: Increase dimension of kicrd from 7 to 10 in crdaccs(...)
+c 2.616 (111110)
+c Allow hairpins to span multiple notes groups (gulps).
+c 2.615+ (110810)
+c Fix midi when some instruments are transposed, by subtracting
+c iTransAmt(instno(iv)) from pitch values sent to via addmidi in
+c make2bar.for (for main notes) and docrd (for chord notes)
+c 2.615 (110725)
+c Fig bug with size-setting (in topfile) when instrument has >1 staves
+c 2.615 (110724)
+c Make AS[0|-|s|t]... really set sizes
+c 2.614
+c Mod notex.for to fix Terry's bug with raised dotted rests (caused
+c by double-hboxing).
+c 2.613
+c Bugfix: In pmxa, change "do while" limit to keep from overwriting instno.
+c 2.612
+c Enhance AS to allow s or t for smallsize or tinysize
+c 2.611
+c Error trap for "D" before any notes in a block.
+c 2.610
+c Instrument-wise key changes and transposition (incomplete)
+c 2.603
+c 101211 In getpmxmod.for, decreased nline by 2 to fix locating errors
+c following reading in an include file.
+c 101121 Added some error messages in g1etset.for setup data
+c 2.602
+c Correct slur indexing in linebreakslurs.
+c Account for comment lines in line count for error messages
+c 2.601
+c Bug fix: allow 24 slurs with graces
+c 2.60 Changes made make it really big
+c increase mv (size of midi) ? Note: MIDI can't have >16 voices w/o
+c major reprogramming, and 16 may also be a problem (icmm)
+c nm=24 (voices) done
+c 24 slurs done
+c 24 simultaneous beams (Replace index 24 by 0, so get 0-23)
+c bufq*131072 (gfortran only)
+c getarg syntax (gfortran only)
+c 2.523+
+c Fix voice numbering for normal dynamics and text dynamics
+c 2.523
+c Version of bigpmx first posted to Hiroaki's web site.
+c 2.522
+c 5/26/10 Replace ipl bits 0-7 with ipl2, add new common for it.
+c With 2.521+ as starting version, incorporate bigpmx mods to allow 24 voices.
+c 5/13/10 Fix log2 function
+c 5/15/10 Fix bitwise storage for dynamics, fix segnoo string length.
+c 2.521+
+c 091025 Enable dotting 2nd part of linebreak slur or tie.
+c To adjust barno height due to linebreak slur, use \bnrs instead of
+c explicitly redefining \raisebarno (pmxb)
+c 2.521
+c Bugfix
+c 2.520
+c 090519 Enable ligfonts (special figured bass characters)
+c 2.519
+c Fix another bug which kept \sk from being output so misaligned some notes.
+c 2.518
+c Fix bugs: referencing fig data, char declaration for member of
+c common/comfig/
+c 2.517
+c Allow figures in voice 1 + any one other.
+c 2.516
+c Allow figures in voice #2
+c 2.515+ to do: Change manual and activate rule against clef change in voice #2.
+c 2.515
+c 071222 Changes in getnote to allow auto forced beams to start anywhere.
+c 071206 In make2bar, shift fermataup7 to left over centered pause.
+c 070901 In doslur, check for nolev <=2 in case slur ends on rest in 2-line
+c staff (it was screwing up vertical justification).
+c n34 for tweaks to midi durations of quarter note septuplets.
+c To do: In ref250.tex, the tables where 's,t,)' is explained, the line
+c [+,- i] ... Vertical adjustment of the start of second segment
+c should it be replaced by
+c [s +,- i] ... Vertical adjustment of the start of second segment
+c 2.514
+c Changes in make2bar to get horizontal spacing right when normal grace
+c follows after grace
+c Changes in dograce to get octaves right for any material entered inside
+c \gaft, which shields transpose register changes from the outside world.
+c 2.513
+c In make1bar, near end, for forced beams starting with a rest, copy hgt and
+c slope tweaks to ALL notes after first, not just the second one, so if
+c there's more than one rest at start the tweaks are still observed.
+c In beamid and beamend, add stand-alone triply-flagged notes for xtups.
+c 2.512
+c Near end of pmxb, fix error trap to allow redundant 'RD'
+c Enable multiplicity down-up '][' within xtup.
+c 2.511
+c Introduce eskz2 for xtup #'s and bracket lengths, to remove bug caused by
+c adjusteskz as in bar 7 of barsant.
+c 2.510a
+c Test: remove restriction on tempo changes in MIDI macros
+c Send to CM for beta testing.
+c 2.509+
+c To do: Correct manual on AS. "-" is for smaller staves.
+c 2.510
+c Forgot to declare litq, voltxtq as character in subroutine getgrace
+c 2.509
+c Corrected small bug in arpeggio shifting (ivx <= iv in call putarp)
+c 2.508
+c Allow graces in xtups. New subroutine getgrace.
+c 2.507
+c To do: Raise/lower figures.
+c To do: Add 24, 29 to list of musicsizes in manual
+c New sub adjusteskz to account for ask's when computing lengths of
+c brackets for unbeamed xtups, slopes and horizontal posn's of number
+c Bug fix: in beamn1, beamid, and beamend, allow unbeamed xtups w/ 2 flags
+c Add look-left option for keyboard rests, "L" in rest command, set iornq(30)
+c 2.506
+c Fix bug with AK, when simultaneous rests have same duration, use defaults.
+c 2.505
+c Keyboard rests AK
+c 2.504
+c Space after normal grace: option X[n]
+c Fixed og when nv .ne. noinst, by using sepsymq instead of '&'
+c (To do) length of xtup bracket when there is added non-collision space.
+c Trap musicsize if .ne. 16,20,24,29.
+c 2.503
+c Enable arpeggio left shift with ?-x
+c To do: In manual, arpeggio over 2 staves.
+c Allow musicsize of 24 and 29. Had to define meter font size explicitly,
+c also change font size for text dynamics, but not much else so far.
+c Bugfix in beamstrt, introduced in 2415, ip was changed before putxtn
+c was called, causing error in printing replacement number.
+c 2.502
+c Incorporate Dirk Laurie's patch to use { , } , for ties.
+c Figure height adjustment: append +[n]
+c Change ec font stuff in pmx.tex per Olivier Vogel's comment (CM email?)
+c 2.501
+c Readjust horizontal offset back to .8 in LineBreakTies
+c Fix zero-subscript (iudorn) in putorn
+c 2.50
+c Increase number of text-dynamics (dimension of txtdynq) per block
+c from 12 to 41.
+c Slur option n to override altered default curvature.
+c Allow default ps slur curvature tweaks with Ap+/-c
+c 2.416
+c Increase length of textdynq from 24 to 128
+c (Todo) Add comment in manual about blank lines at end.
+c Configuration file: Define subroutine getpmxmod, check path in environment
+c variable pmxmoddir, check existence, read lines into bufq after setup.
+c Increase dimension on idynn in dodyn from 4 to 10 for max number
+c of marks in a bar
+c Increase allowable # of lines from 2000 to 4000.
+c (To do) Replace definition of \liftpausc per Olivier.
+c (To do) Fix extraneous error message if RD is placed at very end.
+c 2.415
+c Fix "AT" option: replace putxtn,topfile,beamstrt,beamid to use \xnumt
+c instead of redefining \xnum. Change font used to \smallfont (as for
+c normal xtups,
+c Allow slur to start on rest.
+c 2.414
+c Correct bug in crdacc when adding accidental to boundary causes number of
+c segments to decrease
+c Special rule for 3-accidental chords: If no 2nds, place them in order
+c top, bottom, middle.
+c 2.413
+c Correct bugs in chordal accidentals, related to left-shifted noteheads
+c (a) Special problems with downstem when main note needs shifting
+c (b) Assign 0 rank to boundary segs due to left-shifted noteheads
+c 2.412
+c Change default horiz shift of start of seg 2 of linebreak slurs:
+c -.7 for slurs, -1.2 for ties,
+c Use height of start of seg 1 slur itself for end of 1 and start of 2.
+c 2.411
+c "Apl" activates special treatment of linebreak slur/tie's; breaks all in 2.
+c "s" option in start of slur/tie as precursor to vert/horiz tweaks for end
+c of seg 1. of linebreak slur/tie, 2nd "s" for start of seg2.
+c With "Apl", curvature adjustments on starting slur command apply to seg 1,
+c those on ending command to seg 2.
+c 2.410
+c "AT" to allow Col. S.'s tuplet option. Simply input tuplet.tex and redefine
+c \xnum, \unbkt, \ovbkt.
+c "s" option in main xtup input after "x": slope tweak for bracket. mult(4) is
+c flag, mult(5-9) is tweak value+16
+c 2.409
+c Bugfix in docrd for MIDI: Use original pitch in case main/chord were
+c switched due to 2nds.
+c Remove "o" from error message for "A" command.
+c New syntax: optional instrument number separator ":" in movement
+c break command to precede a 2-digit instrument.
+c Conditional output formats for \setname at movement break to allow
+c instrument numbers >9.
+c Bugfix in coding to raise barno due to slur over line break (pmxb)
+c Move date/version data statement in pmxab to a better place.
+c 2.408
+c Allow pnotes{x} when x>9.995 (mod is only to format stmt in make2bar).
+c Bug fix in \liftPAusep in notex.for and in pmx.tex
+c Character variables for version and date
+c For up-stem single graces slurred to down-stem, shift slur start left by
+c 0.8 so slur doesn't get too short.
+c Initialize and slide mult, same as other full-program variables in /all/.
+c 2.407
+c Allow AN[n]"[partname]" to be parsed by scor2prt as filename for part n,
+c 2.406
+c Alter PMX: put \dnstrut into \znotes in \starteq (for system spacing
+c equalization).
+c Put dimensions of double sharps and flats in crdacc (for chords).
+c Bugfix: Use sepsymq in LineBreakTies(..) instead of '&'
+c Use only first 4 bits of mult for multiplicity+8, so rest can be used
+c for other stuff.
+c Move stemlength stuff in nacc(27-30) to mult(27-30) to remove conflict.
+c 2.405: Not published but saved for safety.
+c Option Aph to write \special{header=psslurs.pro} top of each page, so
+c dviselec will work OK.
+c 2.404
+c Allow slur to end on rest, but not start on a rest. Efaults height
+c of ending is default height of start (before any automatic or user-
+c defined djustments). User may adjust height as normal from default.
+c 2.403
+c Bugfix: turn off repeated beaming patterns.at end of non-last voice.
+c 2.402
+c Automatic repeated forced beams. Start with "[:" End with next explicit
+c forced beam or end of input block.
+c Increase # of forced beams per line of music per input block from 20 to 40
+c 2.401
+c Optional K-Postscript Linebreak Ties, Apl. New subroutine LineBreakTies.
+c Makes 1st part normal shape, and starts 2nd part a little further left.
+c Enable arpeggios in xtuplets. Had to make time itar(narp) a real.
+c 2.40
+c Set up WrotePsslurDefaults (logical) so only write defaults on 1st Ap.
+c Fix non-ps-slur input to \midslur (third signed integer). Do not reverse
+c sign for down-slurs.
+c 2.359
+c Add error exit subroutine stop1 to make exit status g77-compatible..
+c Absolute octave on xtup chord note was 2 octave too high, fixed in getnote
+c Fermata on vertically shifted rest: special trap in putorn() to set height.
+c Correct multiple grace note spacing for small staves (in dograce,
+c define wheadpt1 depending on staff size)
+c 2.358
+c Allow curvature corrections at start of postscript slur, in dopsslur()
+c Local slur options p[+|-][s|t] for [nos|s]luradjust,[not|t]ieadjust
+c Options for [Nos|S]luradjust,[Not|T]ieadjust,[noh|h]alfties: Ap[+|-][s|t|h]
+c Make t[ID] act like s[ID]t, most mods in spsslur().
+c Add spsslur() to read in data for ps slurs, call from getnote.
+c In beamstrt, save args for SetupB in common comipb to save them for
+c 2nd call when xtup starts with rest
+c Add spacing for ornament ")" as if it were accidental, in make2bar().
+c Horiz shift start and end of ps ties, dep. on stem dir'n, in dopsslur()
+c Horiz. shift start of ps grace slur, 2 places in dograce().
+c Horiz shift end of grace slur in endslur()
+c Make st slurs into postscript ties. Separate subroutine dopsslur(),
+c Non-beamed xtup: "a" in 1st note or rest, before "x" (sets drawbm=.false.)
+c Allow two D"x" on same note. Introduced jtxtdyn1 in dodyn.
+c 2.357a
+c Fix missing "end" in backfill.com, too-long lines in g1etnote, getnote
+c 2.357
+c Increase dimension for # of lit TeX strings from 52 to 83.
+c Allow blank rest in middle of xtuplet. Only mods in g*etnote().
+c 2.356
+c Increased some dimensions from 30 to 40 to allow up to 40 pages.
+c In unbeamed xtups, "n" did not suppress bracket. Fixed in beamstrt().
+c Fix parsing of "f,h,H,HH" in sslur.
+c Fix bug with cdot, note-level for slur termination (in getnote)
+c 2.355
+c Midi transposition: IT[+|-][n1][+|-][n2]...[+|-][n(noinst)],
+c n=# of half-steps. Restrict to mult. of 12 now, to avoid key-sig issues
+c Make midi recognize ps ties in doslur.
+c Correct ttieforsl so that it eats 2nd argument properly, using \zcharnote
+c to get octave right.
+c 2.354
+c With postscript slurs, make t-slurs real ties by inserting replacement
+c macros \tieforisu, etc, defined in pmx.tex
+c Check for open cresc or decresc at end of input block, using list[de]cresc
+c Hairpin syntax conditional on postscript slurs. Backup to fill in start
+c level, using new backfill(...). Separate height tweaks for
+c start and finish.
+c 2.353
+c K-0+n to transpose by half step (rather than just change key)
+c Allow "rm[n]" when nv>1. Require it in all parts. Just write a stack of
+c \mbrest's
+c Enable "Rz"; define \setzalaligne in pmx.tex. Special treatment at end
+c of input block before movement break, and at start of block after
+c movement break, using \newmovement rather than \setzalaligne, since
+c former already redefines \stoppiece. In second case, set rptfg2='z'.
+c Make clefq(nm) common between pmxb and getnote; change references in
+c getnote at 'M' to array elements, setting all new clefs as you go.
+c 2.352
+c Remove \parskip redefinition from pmx.tex; write it into TeX file when
+c "Ae" is invoked.
+c Ap to activate postscript slurs. Add macro \psforts to pmx.tex to redefine
+c \tslur in case \midslur was used. Allow slur inputs 'f','h','H','HH',
+c translate them thru mapping to (1,4,5,6) as \midslur params, then let
+c \psforts translate them back to ps slur macors.
+c 2.351
+c Number slurs from 0 up instead of 11 down, anticipating postscript slurs.
+c Write "\eightrm" instead of "\cmr8" for \figfont with small baseline size.
+c Increase length of basenameq to 44 characters everywhere.
+c Increase dimension of mcpitch (midi-chord-pitch) to 20.
+c Set default systems per page to 1 if nv>7
+c In pmxb, move place where isystpg is reset to 0, so that \eject gets
+c written when there is just one system per page.
+c 2.35
+c Cautionary accidentals with 'c' anywhere in note symbol.
+c NEW pmx.tex with \resetsize to set size to normal or small depending on
+c current \internote. Used with new coding in dograce() to get right
+c new size in case user has \setsize'ed some lines to \smallvalue. For
+c \smallvalue-sized staves, redefine \tinynotesize to give 11-pt font.
+c Affects pmx.tex.
+c Continuation figure with fractional length. May now mix with other figures.
+c If another figure follow Cont-fig, separate with colon.
+c 2.342
+c Bugfix in getnote to recognize relative octave shift in grace at start of
+c input block.
+c In make2bar, initialize islhgt=0 earlier than before (possible solution
+c to Suse g77 compile problem that I could not reproduce)..
+c Bugfix in beamstrt & beamn1 for r2x6 c4D d d d
+c 2.341
+c Syntax check: Forced page break page number must be > than previous.
+c Bugfix: Define ivx when "sliding down" breath/caesure data in pmxb.
+c 2.34
+c New pmx.tex with redefined liftpausc
+c Bug fix with dotted, non-beamed xtups.
+c 2.332
+c Fix bugs in horizonal shifts, spacing, for accid's, graces, noteheads.
+c Allow arbitrary pos. input to W in g1etnote and getnote.
+c 2.331
+c Bug-fix in dodyn(..): typo on length of arg of txtdyn
+c 2.33
+c Caesura (oc), breath (ob). Set iornq(28), store rest of data in ibcdata()
+c 2.321
+c Rescale accidental shifts. Still use 7 bits but now map (0,127)
+c onto (-1.,5.35)
+c Fix ihornb bug in dodyn, seen with dynamics on lower-voice non-beamed xtups
+c 2.32 (Noticed after posting)
+c Prohibit "/" as figure.
+c 2.32 (Posted)
+c Tidied up accidentals in chords, do spacing.
+c Still to do:
+c check for "(" on chord notes in spacing algo
+c small accids
+c double accids
+c autoshift slurs
+c 2.310
+c Extra call to precrd ahead of spacing chk, and single-note crd/acc
+c shifts seem OK, but not multiple. crd/acc shifts not recorded 1st time.
+c 2.309
+c Alternate algo for accid shifts in chords.
+c 2.308
+c Auto horiz. notehead shifting added to precrd.
+c 2.307
+c Auto shifting of multiple accidentals in chords.
+c "Ao" in main chord note to keep accidentals in order. Set nacc(28).
+c If there are any manual main or chord note shifts, then
+c If any manual shift is preceded by "A" then
+c 1. Auto-shifting proceeds
+c 2. "A"-shifts add to autoshifts
+c 3. non-"A" shifts are ignored!
+c Else (>0 man shifts, none has "A")
+c No auto-ordering, No autoshifts,
+c End if
+c End if
+c 2.306
+c Initialize legacy note level to middle C in case user forgets to set
+c octave.
+c Shift xtup note?
+c Shift in elemskips rather than noteheads?
+c 2.305
+c Stop pmxb from multiple endvolta's at start of new page.
+c 2.304
+c "Sx" in a note means shorten stemlength by x \internotes. "Sx:" turn on
+c for multiple notes in the voice, "S:" last shortened note.
+c 2.303
+c vshrink stuff all OK? Description is in pmxb.
+c 2.302
+c Toggle vshrink with "Av". vshrink normally kicks in when \interstaff
+c hits 20. This still needs work.
+c Add " /" to last line if last char is not % or /.
+c 2.301
+c Check in beamn1 for single note before multiplicity down-up.
+c allow '.PMX' as well as '.pmx'
+c 2.299
+c Correct typo in pmxb involving PMXbarnotrue.
+c Replacement printed number for xtup: Unsigned integer after 'n' after 'x'
+c Minor upgrade parsing xtuplet options 'x...'
+c Correct dimension of nxtinbm in make2bar.
+c 2.298
+c Account for doubled xtup notes in subroutine getx (user-defined spaces),
+c by adding ndoub as an argument..
+c 2.297
+c Created and solved compiler problem. Put drawbm(NM) in its own common.
+c Add new def'ns [\a|PA]usc, \lift[pa|PA]usc to pmx.tex, use them in make2bar
+c when \centerbar is used.
+c Modify \mbrest & \CenterBar in pmx.tex to use \volta@endcor etc. Have PMX
+c use right 2nd and 3rd args for \mbrest when key, meter, or clef changes.
+c 2.296
+c Correct printed numbers for forced beams with multiple xtups. For each beam
+c make list in setupb by voice of eloff (h-offset) and mtupv (printed #)
+c Increase lengths of jobname and infileq by 20 characters
+c Enable whole notes and breves as 1st or last note of xtup in beamn1 and
+c beamend, and wholes in beamid.
+c 2.295
+c Midi balance Ib[n1]:[n2]:...[nn]
+c Single-slope beam groups [...]-[...]
+c Trap "i" unless after accidental (main notes, xtups, chord notes)
+c 2.294
+c Unequal xtups with "D" to double a note in an xtup.
+c As above, "F" will (a) increase multiplicity by 1 for marked note and next
+c one and (b) add a dot to the first one.
+c Fix bug with e.g. c84 [ .d e.f ] by checking whether forced beam is on
+c when "." is encountered, then correcting beam start time.(end of getnote)
+c MIDI velocity (volume) set: Iv[n1]:[n2]:[n3]...
+c 2.293
+c Check for single notes spanning bar lines.
+c Correct various bugs with staff-jumping beams. (1) for 2nd segment, vxtup
+c must be set in make2bar since beamstrt is not called, fixing problem with
+c dot at end. (2) add ivjb2 to flag which voice has 2nd segment and fix
+c problem when >2 staves.
+c Add nodur to args of dodyn, so can check if stemless and avoid height tweak
+c Correct bug in getdyn setting flag in idynda2(0) for manual horiz. tweak
+c 2.292a
+c Undo syntax check for Type 2 or 3 TeX string starting in column 1.
+c Meanwhile, Werner's problem with a mid-line Type 3 string has gone away?!
+c 2.292
+c Allow comments in xtuplets
+c Enable multiple octave jumps in grace notes.
+c Allow dynamics in xtuplets.
+c Fix bug in getdyn searching for end of text string (correct length of lineq
+c to 128)
+c Fix bug in dodyn, must ignore horiz. interaction tweak for
+c user-text (idno = 0)
+c Syntax check for Type 2 or 3 TeX string starting in column 1
+c (NOTE: later undone!)
+c Syntax check for page number > npages at forced line break.
+c 2.291
+c Fix error in AS command (accid spacing for small systems), making only
+c one spec per staff, nv total.
+c Stop using MIDI channel 10
+c 2.29
+c Fix error in console output format for # of bytes used in MIDI file.
+c Fix bug in dograce so no space is added between grace and main note when
+c there is a MIDI-only accidental.
+c Fix bug so oes?+4 works. It was too ugly to explain.
+c ...Different ways of storing accidental specs on input and output.
+c No longer zap \writezbarno in special situations.
+c Fix bug in dyntxt level on rest
+c Line spacing equalization. Add macros \starteq, \endeq, \spread, etc.
+c Activate with Ae. (Maybe later could input alternate values for
+c \upamt, \dnamt, \parskip). Put \starteq on 1st note in voice 1
+c in the page, and \endeq on 1st note of next-to-last line in page.
+c 2.28
+c Flip direction of forced beam "[f..."
+c Fix beam numbering for staff jumping beams. Uses irest(23,24,29,30)
+c Fix bug in sliding ip's for txtdyn's
+c In dyn's allow vert. offsets +/-64, horiz +/-25.6 (store in idnyda2(1-99)
+c 2.27
+c Comment out lines in dodyn checking number of dynamic marks found. Voice
+c order may not be monotonic if two lines on a staff.
+c Literal dynamic: D"[text]"
+c 2.26
+c Allow hairpin start-stop on same note by disabling auto-tweaks in dodyn,
+c increasing dimension of idynn to 4 to allow 4 symbols on same note.
+c Increase voltxtq length from 10 to 20.
+c AS[-/0][-/0]... to inform PMX that "-" voices are small, and rough
+c accounting for ast's is done by defining effective headwidth
+c whead1 in makebar2 to be 0.8*whead.
+c 2.25
+c Fix logic bug with sepsym's when # of instruments changes.
+c Slight increases in default offsets for hairpin starts after "p"
+c 2.24
+c Hairpins D< or D> as toggle.
+c Many automatic position tweaks for letter-group dynamics and hairpins.
+c 2.23
+c Continued rhythmic shortcuts: space followed by "." or ","
+c 2.22
+c In call to doslur, change tno(...) to tnote(...). This was only
+c used when checking to slurs per stem directions, and should have been
+c the note duration all along.
+c MIDI-only accidental, bit 17 in nacc, or 27 in icrdat.
+c Use "i" anywhere in note symbol.
+c 2.21
+c Increase from 20 to 30 dimensions for movement breaks and midi sections.
+c Fix out-of-order declarations per mutex comments
+c Add "Bad error" and "Kluging" messages to log file.
+c 2.197
+c add /comips/ to save tie-check midi variables
+c For spacing of clef changes at start of input block, changed integer time
+c lastnodur to prevtn, so it works with xtups. Possible incompatibility!
+c 2.196
+c Fix Ickbug with time check in ncmid()
+c Interchange \fermataup7 and \pausec to get proper alignment
+c Enable French violin clef "f", number 7 in PMX, but 9 in MusiXTeX.
+c Add defn's of \hsp, \hspp to pmx.tex
+c Fix pre-slurs on xtup chord notes.
+c Fixed raised PAuse, define \liftPAuse
+c Replace \zbreve\sk with \breve.
+c Made "1" work as mtrdenl by doubling it and mtrnuml. BUT WAIT...what
+c about "o" and 1 as shorthand for 16???? Search for "Kluge"
+c Added "vo" (voice) as MIDI instrument 55
+c Allow 3-digit page numbers (search for "toppageno")
+c Fix bug caused by prior fix (cancelling accid after bar line was ignored).
+c Fix double accids in chords
+c 2.194
+c Fix bug with accid/tie/barline/chord in addmidi by restructuring accid if
+c block.
+c Add meter to MIDI file with every pause
+c Purify FORTRAN?
+c 2.193
+c Increased # of in-line TeX strings from 36 to 52.
+c Fix entry of # of bytes in header of tempo/meter/key track to allow >255.
+c 2.191
+c Event track: Tempos, meters, keys all together. Data in comevent
+c 2.15
+c Pretty good midi capability. Still no attention to slurs on chord notes.
+c 2.11
+c 11 Dec 99 c rm1
+c 11 Dec 99 "oes?", "oe?"
+c 11 Dec 99 Cancel slur horizontal tweaks with non-stemmed notes
+c 11 Dec 99 Error message for shifted, repeated ornaments.
+c 2.10 (Version 2.1)
+c Fix bug with lowdot and xtuplets
+c 2.09
+c Fix bug with multiple ornament heights over beams, when one is . or _
+c Error message from pmxa if rest on last note of xtup.
+c Enable 12 slurs.
+c Reinstate multiple rests at start of xtup.
+c 2.07
+c Combine consecutive type-1 TeX strings.
+c \midslur and \curve as 3rd signed digit in slur termination, + 2 opt.int's.
+c Fixed breve chord notes in docrd
+c Check irest(28) as well as vxtup when setting nodur for chord notes, since
+c vxtup isn't set until 1st *main* note in xtup
+c Vectorize nolev1, slope, ixrest. Klug fix for xtups with variable spacing.
+c 2.06+
+c Make deterministic the beam slope calculation when there are an even # of
+c slopes in list and middle two are equal magnitude but opposite sign.
+c pmxa Trap for "o:" before 1st note in block
+c Partial bug fix for 64th notes in xtuplets.
+c Make ixrest a vector, since with new time scheme may not finish xtup in
+c same notes block.
+c Increase max # of pages from 20 to 30 (dimensions of nsystp,..., in pmxb)
+c 2.06
+c Account for changes in nv when computing \interstaff. Add a counter
+c nistaff(iflb) = # of interstaff spaces per system = nv-1. Set whenever
+c setting isysflb(iflb). Note nv can only change at a forced line break.
+c Note also, iflb starts at 0!
+c 2.05
+c Automatic start of new notes group with part 2 of staff-jump beam
+c In make1bar, set irest bit 29 of lowest-voice note at same time,
+c use as flag when making notes groups.
+c For now, remove dummy blank line at end...it zaps terminal repeats.
+c 2.02
+c Fixed slur-counting bug for multiple, slurred, aftergraces.
+c 2.01
+c Increase to ask(1400)
+c Increase max forced page breaks to 18
+c Define pausc for centered pause
+c 2.0a
+c Insert dummy blank line at very end to handle input files w/o terminal CR-LF
+c pmx03r
+c Option m[n] in S symbol to change musicsize (for parts)
+c Double dotted rests now work.
+c Write file name to log file
+c Check existence of input file
+c Allow 24-char jobname, may end with ".pmx"
+c Comment out time stuff
+c Replace 3-argument getarg with 2-argument + iargc
+c Fix bug with negative noinst due to nint<=int replacement
+c move lovation of iv in isdat1 to allow iv>7.
+c Set nm=12
+c pmx03q
+c replace int(x+.001) with nint(x)
+c Write TeX file name to screen and to pml.
+c Replace char(...) with chax(...) to sovle msdev bug.
+c Bug fix: macro terminations when M is on a line by itself.
+c Bug fix: don't accumulate space for XS in pmxa.
+c Streamline Macros: use pointers to bufq instead of scratch files
+c pmx03p
+c Store input file in single character array bufq.
+c lbuf(i)*2 is length of line i
+c ipbuf is position just before next line to be read.
+c pmx03
+c Optimize read/writes
+c pmx02
+c Fix line count (for errors) when there are saved macros
+c pmx01
+c In optimize mode, open/close macros (Watch out for residual zz files!)
+c Command line input
+c Option Ao to optimize, otherwise normal processing
+c
+ccccccc
+ parameter (nks=125,nm=24,mv=24576,maxblks=9600)
+ character*128 lnholdq
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /comevent/ miditime,lasttime
+ logical slmon,dbltie
+ common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
+ * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
+ * slmon(0:nm),dbltie
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+ integer*2 iinsiv
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ common /commus/ musize,whead20
+ integer*4 nbars0(nks),nbars(nks),ipoe(nks),nbari(nks)
+ real*4 poe0(nks),poe(nks)
+ logical isfirst,optimize
+ logical*4 fexist
+ character*44 jobname
+ character*47 infileq
+ common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
+ * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
+ * idum,itsofar(nm),nib(nm,15),nn(nm),
+ * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
+ logical rest,firstline,newmeter
+ common /comdiag/ n69(0:nm),n34(0:nm)
+ logical mmacrec,gottempo
+ common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
+ * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
+ * mmacrec,gottempo
+ common /truelinecount/ linewcom(20000)
+c
+c Added 130302 only to get nsperi from g1etnote, for use in midi setup
+c
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ logical lastchar,fbon,issegno,isheadr,isvolt
+ character*1 chax
+c
+c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing
+c nmidsec section starts and stops based on PLAYING macros (not recording).
+c
+ccccccccccccccccccccccccc
+c
+ data date /'12 Dec 21'/
+ data version /'2.98'/
+c
+ccccccccccccccccccccccccc
+ data maxit,ncalls /200,0/
+ data isfirst /.true./
+c itstart = mytime()
+ versionc = version
+c
+c Initialize midi parameters
+c
+ gottempo = .false.
+ ismidi = .false.
+ debugmidi = .false.
+ relacc = .false.
+ mmacrec = .false.
+ nmidsec = 1
+ mgap = 10
+ miditime = 0
+ lasttime = 0
+ nmidcrd = 0
+ nusebl = 0
+ notmain = .false.
+ do 3 ivx = 1 , nm
+ twoline(ivx) = .false.
+ midinst(ivx) = 6
+ midivel(ivx) = 127
+ midibal(ivx) = 64
+ miditran(ivx) = 0
+3 continue
+ do 12 icm = 0 , nm
+ imidi(icm) = 0
+ restpend(icm) = .false.
+ trest(icm) = 0.
+ levson(icm) = 0
+ levsoff(icm) = 0
+ slmon(icm) = .false.
+ naccbl(icm) = 0
+ n69(icm) = 0
+ n34(icm) = 0
+ msecstrt(icm,1) = 1
+12 continue
+c
+c End of midi parameter initialization
+c
+ musize = 0
+ optimize = .false.
+ numargs = iargc()
+ if (numargs .eq. 0) then
+ print*,'You could have entered a jobname on the command line,'
+ print*,' but you may enter one now:'
+ read(*,'(a)')jobname
+ numargs = 1
+ else
+c call getarg(1,jobname,idum) ! May need to replace this w/ next line
+ call getarg(1,jobname)
+ end if
+10 ljob = lenstr(jobname,44)
+ if (ljob .gt. 44) then
+ print*,'Jobname is too long. Try again.'
+ call stop1()
+ else if (ljob .eq. 0) then
+ print*,'No was jobname entered. Try again.'
+ call stop1()
+ else if (numargs .eq. 2) then
+ if (ljob.eq.2 .and. jobname(1:2).eq.'-o') then
+ optimize = .true.
+c call getarg(2,jobname,idum) ! May need to replace this w/ next line
+ call getarg(2,jobname)
+ numargs = 1
+ go to 10
+ else
+ print*,'Illegal option on command line'
+ call stop1()
+ end if
+ end if
+c
+c Strip ".pmx" if necessary
+c
+ ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
+ if (ndxpmx .gt. 0) then
+ jobname = jobname(1:ndxpmx-1)
+ ljob = ljob-4
+ end if
+c
+c Check for existence of input file
+c
+ infileq = jobname(1:ljob)//'.pmx'
+ inquire(file=infileq,EXIST=fexist)
+ if (.not.fexist) then
+ inquire(file=jobname(1:ljob)//'.PMX',EXIST=fexist)
+ if (.not.fexist) then
+ print*,'Cannot find file '//infileq
+ call stop1()
+ else
+ infileq = jobname(1:ljob)//'.PMX'
+ end if
+ end if
+c
+c Open a log file
+c
+ open(15,file=jobname(1:ljob)//'.pml')
+ call printl('This is PMX, Version '//version//', '//date)
+ ljob4 = ljob
+ call printl('Opening '//infileq)
+ open(18,file=infileq)
+c
+c Copy input file into common buffer
+c
+ ipbuf = 0
+ linewcom(1) = 1
+ do 8 ilbuf = 1 , maxblks
+ ncomments = 0
+14 read(18,'(a)',end=9)lnholdq
+ lbuf(ilbuf) = lenstr(lnholdq,128)
+ if (lbuf(ilbuf) .eq. 0) then
+c
+c Blank line. Make it a single blank with length 1
+c
+ lbuf(ilbuf) = 1
+ lnholdq = ' '
+ end if
+c
+c Now line has at least one non blank character. Check for comment
+c As of Version 260, do not copy comments into bufq
+c But need to count %'s for error messaging
+c if (lnholdq(1:1).eq.'%') go to 14
+ if (lnholdq(1:1).eq.'%') then
+ ncomments = ncomments+1
+ go to 14
+ end if
+c
+c When here, have counted all preceding comments and have a real line
+c
+ if (ilbuf .gt. 1) then
+ linewcom(ilbuf) = linewcom(ilbuf-1)+1+ncomments
+ else
+ linewcom(1) = 1+ncomments
+ end if
+ if (ipbuf+lbuf(ilbuf).gt.131072) then
+ print*,'Too many characters in file, stopping'
+ call stop1()
+ end if
+ bufq(ipbuf+1:ipbuf+lbuf(ilbuf)) = lnholdq
+ ipbuf = ipbuf+lbuf(ilbuf)
+8 continue
+ call printl('Too many lines in input file')
+ call stop1()
+9 continue
+c
+c Insert dummy line to handle input files w/o CR-LF at end.
+c
+ nlbuf = ilbuf-1
+c nlbuf = ilbuf
+c bufq(ipbuf+1:ipbuf+3) = ' / '
+c lbuf(nlbuf) = 3
+ close(18)
+ do 6 numit = 1 , maxit
+ if (optimize) call printl('Starting an iteration')
+c
+c When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0.
+c Otherwise, nbars0 is the input
+c When islast=.false., pmxb only returns poe's, otherwise does whole job
+c
+ call pmxa(jobname,ljob4,isfirst,nsyst,nbars0,optimize)
+ if (.not.optimize) then
+ if (ismidi) then
+c
+c This was moved here from writemidi 130302 to allow midivel,bal,tran, to be
+c set up here as functions of instrument rather than iv (staff).
+c Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv)
+c
+ nstaves = 0
+ ivt = 0
+ do 16 iinst = 1 , nm
+ nstaves = nstaves+nsperi(iinst)
+ do 17 ivtt = 1 , nsperi(iinst)
+ ivt = ivt+1
+ iinsiv(ivt) = iinst
+17 continue
+ if (nstaves .eq. nv) go to 18
+16 continue
+ print*,'Screwup!'
+ call stop1()
+18 continue
+c
+c Set up channel numbers for midi.
+c
+ numchan = 0
+ do 11 iv = nv , 1 , -1
+ if (twoline(iv)) then
+ midchan(iv,2) = numchan
+ numchan = numchan+1
+ end if
+ midchan(iv,1) = numchan
+ numchan = numchan+1
+11 continue
+c
+c numchan will now be the number of channels, but max channel # is numchan-1
+c
+c Set up velocities, balances, and midi-transpositions
+c
+ do 13 iv = nv , 1 , -1
+ if (twoline(iv)) then
+c 130302 Make these functions of instrument rather than staff (iv)
+ midvelc(midchan(iv,2)) = midivel(iinsiv(iv))
+ midbc(midchan(iv,2)) = midibal(iinsiv(iv))
+ midtc(midchan(iv,2)) = miditran(iinsiv(iv))
+ end if
+ midvelc(midchan(iv,1)) = midivel(iinsiv(iv))
+ midbc(midchan(iv,1)) = midibal(iinsiv(iv))
+ midtc(midchan(iv,1)) = miditran(iinsiv(iv))
+13 continue
+ end if
+c
+c TEMPORARY!!!
+c
+ write(15,*)'nlbuf: ',nlbuf
+ ip1 = 1
+ do 10000 ilb = 1 , nlbuf
+ ip1 = ip1+lbuf(ilb)
+10000 continue
+ iplast = ip1-1
+c
+c Check to see if (1) last line is "<blank><blank>/" and (2) next to last
+c line is "/"
+c
+ if (bufq(iplast+1-lbuf(nlbuf):iplast) .eq. ' /') then
+ if(bufq(iplast-lbuf(nlbuf):iplast-lbuf(nlbuf)).eq.chax(47))then
+ print*,'Removing last line of "<blank><blank>/"'
+ write(15,*)'Removing last line of "<blank><blank>/"'
+ nlbuf = nlbuf-1
+ end if
+ end if
+c
+ call pmxb(.true.,poe0,ncalls,optimize)
+ if (ismidi) then
+c
+c Write midi file
+c
+ open(51,file=jobname(1:ljob)//'.mid')
+ if (debugmidi) open(52,file=jobname(1:ljob)//'.dbm')
+ call printl(' ')
+ call printl('Writing '//jobname(1:ljob)//'.mid')
+ call writemidi(jobname,ljob)
+ end if
+ close(15)
+ stop
+ end if
+ write(15,*)'nlbuf: ',nlbuf
+ ip1 = 1
+ call pmxb(.false.,poe0,ncalls,optimize)
+ call poestats(nsyst,poe0,poebar0,devnorm0)
+c
+c Save initial deviation and line breaks for later comparison
+c
+ if (numit .eq. 1) then
+ devpmx = devnorm0
+ do 20 isys = 1 , nsyst
+ nbari(isys) = nbars0(isys)
+20 continue
+ end if
+ call sortpoe(nsyst,poe0,ipoe)
+ do 1 iupord = nsyst , 1 , -1
+ isysu = ipoe(iupord)
+ print*,'isysu=',isysu
+ write(15,*)'isysu=',isysu
+c
+c Skip if system isysu has poe0 < avg or isysd has poe0 > avg
+c
+ if (poe0(isysu).lt.poebar0) go to 1
+ do 5 idnord = 1 , nsyst
+ isysd = ipoe(idnord)
+ if (isysu.eq.isysd .or. nbars0(isysd).eq.1
+ * .or. poe0(isysd).gt.poebar0) go to 5
+ do 2 isyst = 1 , nsyst
+ nbars(isyst) = nbars0(isyst)
+ if (isyst .eq. isysu) then
+ nbars(isyst) = nbars(isyst)+1
+ else if (isyst .eq. isysd) then
+ nbars(isyst) = nbars(isyst)-1
+ end if
+2 continue
+ call pmxa(jobname,ljob4,isfirst,nsyst,nbars,optimize)
+ call pmxb(.false.,poe,ncalls,optimize)
+ call poestats(nsyst,poe,poebar,devnorm)
+ if (devnorm .lt. devnorm0) then
+ devnorm0 = devnorm
+ poebar0 = poebar
+ do 4 isys = 1 , nsyst
+ nbars0(isys) = nbars(isys)
+ poe0(isys) = poe(isys)
+4 continue
+ print*,'Improved with iup,idown,devnorm:',
+ * isysu,isysd,devnorm0
+ write(15,*)'Improved with iup,idown,devnorm:',
+ * isysu,isysd,devnorm0
+ write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
+ write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
+ call sortpoe(nsyst,poe0,ipoe)
+ go to 6
+ end if
+5 continue
+1 continue
+c
+c If we get here, must have gone thru all switches and found nothing better,
+c so done!
+c
+ go to 7
+6 continue
+7 continue
+ print*,'Optimum located, numit:',numit,', ncalls:',ncalls
+ write(15,*)'Optimum located, numit:',numit,', ncalls:',ncalls
+ print*,'Final error:',devnorm0,', initial error:',devpmx
+ write(15,*)'Final error:',devnorm0,', initial error:',devpmx
+ print*,'Percentage improvement:',100.*(1-devnorm0/devpmx)
+ write(15,*)'Percentage improvement:',100.*(1-devnorm0/devpmx)
+ call printl('Initial bars/system:')
+ write(*,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
+ write(15,'(5x,20i3)')(nbari(isys),isys=1,nsyst)
+ call printl('Final bars/system:')
+ write(*,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
+ write(15,'(5x,20i3)')(nbars0(isys),isys=1,nsyst)
+ call pmxa(jobname,ljob4,.false.,nsyst,nbars0,optimize)
+ call pmxb(.true.,poe0,ncalls,optimize)
+ close(15)
+ end
+ subroutine accsym(nacc,acsymq,lacc)
+ character*3 acsymq
+ iacc = iand(nacc,7)
+ if (iacc .eq. 1) then
+ acsymq = 'fl'
+ lacc = 2
+ else if (iacc .eq. 2) then
+ acsymq = 'sh'
+ lacc = 2
+ else if (iacc .eq. 3) then
+ acsymq = 'na'
+ lacc = 2
+ else if (iacc .eq. 5) then
+ acsymq = 'dfl'
+ lacc = 3
+ else if (iacc .eq. 6) then
+ acsymq = 'dsh'
+ lacc = 3
+ else
+ print*,'bad accidental: ',iacc
+ end if
+ return
+ end
+ subroutine addask(taskn,waskn,elaskn,
+ * fixednew,scaldold,tglp1,scfac,isudsp)
+ parameter (nm=24)
+ logical isudsp
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ common /comtol/ tol
+ scoarg = scaldold*scfac
+ if (isudsp) then
+c
+c Find which udsp we're dealing with
+c
+ do 1 iudsp = 1 , nudsp
+ if (abs(taskn+tglp1-tudsp(iudsp)) .lt. tol) go to 2
+1 continue
+ print*,'You should note BEEE here in addask!'
+ call stop1()
+2 continue
+c
+c Fixednew and scaldold must not be changed, since udsp's are already included
+c in fsyst from pmxa, and udsp don't involve scaled space..
+c
+ if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
+c
+c Must add user-defined space to what's there already.
+c
+ wask(naskb) = wask(naskb)+udsp(iudsp)
+ else
+c
+c This place has no other space.
+c
+ naskb = naskb+1
+ task(naskb) = taskn
+ wask(naskb) = udsp(iudsp)
+ elask(naskb) = 0.
+ end if
+ else
+c 130330 start
+ oldwask = 0.
+ oldelask = 0.
+c 130330 end
+c
+c This is a normal space, no effect if smaller than existing space
+c
+ if (naskb.gt.0 .and. abs(taskn-task(max(1,naskb))).lt.tol) then
+c
+c We already put in some space at this time
+c Check if new one needs more space than old one at same time
+c
+ if (waskn .gt. wask(naskb)) then
+c
+c 130330 We were double counting the larger space when it came 2nd
+c Need to fix but don't see how yet. Assume times came in order and
+c that last naskb defined spaces that need updating
+c
+ oldwask = wask(naskb)
+ oldelask = elask(naskb)
+c End of 130330 insertions
+ naskb = naskb-1
+ else
+ return
+ end if
+ end if
+ naskb = naskb+1
+ task(naskb) = taskn
+ wask(naskb) = waskn
+ elask(naskb) = elaskn
+c 130330 start
+c fixednew = fixednew+waskn
+c scaldold = scaldold+elaskn
+ fixednew = fixednew+waskn-oldwask
+ scaldold = scoarg+elaskn-oldelask
+c 130330 end
+ end if
+ return
+ end
+ subroutine addblank(noteq,lnoten)
+ character*8 noteq
+ character*1 tchar
+ tchar = noteq(1:1)
+ noteq = ' '//tchar
+ lnoten = 2
+ return
+ end
+ subroutine addfb(nfb,iv,tnew,t1fb,t2fb,ulfbq,ifbadd)
+ parameter (nm=24)
+ integer nfb(nm)
+ common /comtol/ tol
+ real*4 t1fb(nm,20),t2fb(nm,20)
+ character*1 ulfbq(nm,20)
+ ifbadd = 1
+ nfb(iv) = nfb(iv)+1
+ do 1 ifb = nfb(iv)-1 , 1 , -1
+ if (tnew .lt. t1fb(iv,ifb)-tol) then
+ t1fb(iv,ifb+1) = t1fb(iv,ifb)
+ t2fb(iv,ifb+1) = t2fb(iv,ifb)
+ ulfbq(iv,ifb+1) = ulfbq(iv,ifb)
+ else
+ ifbadd = ifb+1
+ go to 2
+ end if
+1 continue
+2 continue
+ t1fb(iv,ifbadd) = tnew
+ ulfbq(iv,ifbadd) = 'x'
+ return
+ end
+ subroutine addmidi(icm,nolev,iacc,midisig,time,rest,endrest)
+c subroutine addmidi(icm,nolev,iacc,isig,time,rest,endrest)
+ parameter(nm=24,mv=24576)
+ integer*2 mmidi,itk(25)
+ integer*4 itiesav(5,100)
+ character*1 notenumq
+ logical endrest,eximacc,it1found
+ logical rest
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+ integer*2 iinsiv
+ logical slmon,dbltie
+ common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
+ * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
+ * slmon(0:nm),dbltie
+ common /comevent/ miditime,lasttime
+ common /comdiag/ n69(0:nm),n34(0:nm)
+c common /commidisig/ midisig(nm)
+c
+c Following variables are local but must be saved. I hope they are.
+c (3/18/00) With g77 they are not, so add a common block here.
+c
+c integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:12)
+ integer*2 ipslon(0:nm),lusebl(10),jusebl(10),icmm(0:15)
+ common /comips/ ipslon,lusebl,jusebl
+c data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13/
+ data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
+c
+c Cancel out barline accidentals if there's a rest.
+c
+ if (rest) naccbl(icm) = 0
+c
+c Special path to insert dummy rest at end of a section
+c
+ if (endrest) go to 20
+c
+ do 7 ion = 0 , nmidcrd
+c
+c check if this is only to get pitch of a chord note
+c
+ if (notmain) go to 6
+c
+c check for rest
+c
+ if (rest) then
+c
+c Will not put in a note, but must update timing
+c
+ if (.not.restpend(icm)) then
+c
+c First rest in sequence, save the time
+c
+ restpend(icm) = .true.
+ trest(icm) = time
+ else
+ trest(icm) = trest(icm)+time
+ end if
+c
+c Note: code checkers don't like the above due to calling addmidi(trest(icm))
+c but this only happens if rest at end of section (endrest=.true.) (called
+c from getmidi(), in which case these above lines are bypassed.
+c
+ call chkimidi(icm)
+ return
+ end if
+c
+c time tics
+c
+ if (imidi(icm).gt.0 .and. ion.eq.0) then
+ idur = mgap
+ else
+ idur = 0
+ end if
+ if (restpend(icm)) then
+ restpend(icm) = .false.
+ idur = idur+nint(15*trest(icm))
+ end if
+c
+c time to start of note
+c
+ idurvar = isetvarlen(idur,nby2on)
+ if (nby2on .gt. 4) then
+ print*,'You got >4 bytes, something is bogus.'
+ call stop1()
+ end if
+ imidi(icm) = imidi(icm)+1
+ do 2 i = 1 , nby2on
+c
+c imidi points to cell before highest (leftmost) byte. Start with lowest byte
+c at far right, fill in backwards
+c
+ mmidi(icm,imidi(icm)+nby2on-i) = mod(idurvar,256)
+ if (nby2on .gt. 1) idurvar = idurvar/256
+2 continue
+ imidi(icm) = imidi(icm)+nby2on-1
+c
+c Note-on signal
+c
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = 9*16+icmm(icm)
+c
+c Entry point for chord note pitch determination
+c
+6 continue
+c
+c Get midi pitch. On chord iteration, only do this first time (main note),
+c since pitch was already computed for nonmain chord notes.
+c
+ if (ion .eq. 0) then
+ ipsav = nolev*12./7+11
+ ipsav0 = ipsav
+ if (midisig .ne. 0) then
+c
+c Adjust for signature
+c
+ notenumq = char(48+mod(nolev,7))
+ if (midisig.ge.index('4152630',notenumq)) then
+ ipsav = ipsav+1
+ else if (-midisig.ge.index('0362514',notenumq)) then
+ ipsav = ipsav-1
+ end if
+ end if
+c
+c Deal with accidentals.
+c
+c iacc 0 1 2 3 4 5 6 7
+c effect X fl sh na X dfl dsh X
+c iashft X -1 1 0 X -2 2 X
+c
+ jacc = 0
+ eximacc = .false.
+ if (iacc .gt. 0) then
+c
+c Adjust key-sig-adjusted pitch for explicit accidental (and exit)
+c
+ jacc = iashft(iacc)
+ eximacc = .true.
+ if (.not.relacc) jacc = jacc+ipsav0-ipsav
+c
+c (Above) Shift applies to diatonic pitch but will be added to adjusted one
+c
+ else if (naccim(icm) .gt. 0) then
+c
+c Possible implicit accidental from earlier in the bar
+c Check for prior accid in this bar at this note level
+c
+ do 3 kacc = 1 , naccim(icm)
+ if (laccim(icm,kacc) .eq. nolev) then
+ jacc = jaccim(icm,kacc)
+ eximacc = .true.
+ if (.not.relacc) jacc = jacc+ipsav0-ipsav
+ go to 4
+ end if
+3 continue
+4 continue
+ end if
+c
+c Must split off the following if block from those above because chord
+c notes can cause naccim>0, forcing us to miss other chord note's
+c accross-bar-line accidental
+c
+ if (naccbl(icm).gt.0 .and. .not.eximacc) then
+c
+c Possible carryover accid from prior bar (or prior same-pitch note).
+c
+ do 21 kacc = 1 , naccbl(icm)
+ if (laccbl(icm,kacc) .eq. nolev) then
+ jacc = jaccbl(icm,kacc)
+c
+c Since we are *using* the bar-line accid, must flag it to be saved for next.
+c
+ nusebl = nusebl+1
+ jusebl(nusebl) = jacc
+ lusebl(nusebl) = nolev
+ if (.not.relacc) jacc = jacc+ipsav0-ipsav
+ go to 22
+ end if
+21 continue
+22 continue
+ end if
+ ipsav = ipsav+jacc
+ end if
+ if (notmain) then
+ mcpitch(nmidcrd) = ipsav
+c
+c Save pitch for tie checks
+c
+ if (levson(icm).eq.nolev.and..not.slmon(icm))
+ * ipslon(icm) = ipsav
+ else
+ imidi(icm) = imidi(icm)+1
+ if (ion.eq.0) then
+ mmidi(icm,imidi(icm)) = ipsav
+ if (levson(icm).eq.nolev.and..not.slmon(icm))
+ * ipslon(icm) = ipsav
+ else
+ mmidi(icm,imidi(icm)) = mcpitch(ion)
+ end if
+ end if
+ if (ion .eq. 0) then
+c
+c Only record accids for non-chords, main chord note during chord iteration
+c and chordnotes on first call but not during iteration
+c
+ if (iacc.gt.0) then
+c
+c Set marker for accidental for possible continuations later this bar
+c but first check and clear earlier ones on same note.
+c
+ do 23 kacc = 1 , naccim(icm)
+ if (laccim(icm,kacc) .eq. nolev) then
+ do 24 macc = kacc , naccim(icm)-1
+ laccim(icm,macc) = laccim(icm,macc+1)
+ jaccim(icm,macc) = jaccim(icm,macc+1)
+24 continue
+ go to 25
+ end if
+23 continue
+ go to 26
+25 continue
+ naccim(icm) = naccim(icm)-1
+26 continue
+c
+c Flag new accidental
+c
+ naccim(icm) = naccim(icm)+1
+ laccim(icm,naccim(icm)) = nolev
+ jaccim(icm,naccim(icm)) = iashft(iacc)
+ end if
+c
+c Bail if this is a chord note on the first call (from docrd)
+c
+ if (notmain) then
+ call chkimidi(icm)
+ return
+ end if
+ end if
+c
+c Vel
+c
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = midvelc(icm)
+ call chkimidi(icm)
+7 continue
+c
+c For tie checks
+c
+ if (levson(icm).gt.0.and..not.slmon(icm)) imidso(icm) = imidi(icm)
+c
+c Entry point for special rests at section ends (endrest=T)
+c
+20 continue
+c
+c Now insert all the ends
+c
+ do 8 ioff = 0 , nmidcrd
+ if (ioff .eq. 0) then
+c
+c time to end
+c
+ idur1 = nint(15*time)
+ if (.not.endrest .or. miditime.eq.nint(15*trest(icm))) then
+ idur = idur1-mgap
+ else
+ idur = idur1
+ end if
+c
+c Deal with roundoff problems with 7-tuplets on half or quarters
+c
+ if (idur1 .eq. 69) then
+ n69(icm) = n69(icm)+1
+c if (mod(n69(icm)+6,7) .gt. 3) idur = 58
+ if (mod(n69(icm)+6,7) .gt. 3) idur = idur1-mgap-1
+ else if (idur1 .eq. 34) then
+ n34(icm) = n34(icm)+1
+ if (mod(n34(icm)+6,7) .gt. 4) idur = idur1-mgap+1
+ end if
+ idurvar = isetvarlen(idur,nby2off)
+ if (nby2off .gt. 4) then
+ print*,'You got >4 bytes, something is bogus.'
+ call stop1()
+ end if
+ imidi(icm) = imidi(icm)+1
+ call chkimidi(icm)
+ do 1 i = 1 , nby2off
+ mmidi(icm,imidi(icm)+nby2off-i) = mod(idurvar,256)
+ if (nby2off .gt. 1) idurvar = idurvar/256
+1 continue
+ imidi(icm) = imidi(icm)+nby2off-1
+ else
+c
+c Inserting end of chord note, delta time is 0
+c
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = 0
+ end if
+c
+c Note off
+c
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = 8*16+icmm(icm)
+c
+c Pitch
+c
+ imidi(icm) = imidi(icm)+1
+ if (ioff .eq. 0) then
+ mmidi(icm,imidi(icm)) = ipsav
+ else
+ mmidi(icm,imidi(icm)) = mcpitch(ioff)
+ end if
+c
+c Vel
+c
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = 0
+ call chkimidi(icm)
+ if (endrest) then
+ return
+ end if
+8 continue
+ naccbl(icm) = nusebl
+ if (nusebl .gt. 0) then
+c
+c Fix tables of "bar-line" accids that are saved due to consecutive notes.
+c
+ do 30 kacc = 1 , nusebl
+ laccbl(icm,kacc) = lusebl(kacc)
+ jaccbl(icm,kacc) = jusebl(kacc)
+30 continue
+ nusebl = 0
+ end if
+c
+c Begin tie checks
+c
+ if (slmon(icm)) then
+c
+c Prior note had a slur start
+c
+ if (levson(icm).eq.levsoff(icm) .and. iacc.eq.0) then
+c
+c We have a tie! (Assumed there would be no accidental on tie-ending note)
+c Make a list of times of all events back to the one starting at imidso+1,
+c which is at or before where the tie started. Ident tie start and stop by
+c comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie)
+c Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial
+c time.
+ nsav4tie = 0
+ imidt = imidso(icm)
+10 nsav4tie = nsav4tie+1
+ itiesav(1,nsav4tie) = igetvarlen(mmidi,icm,imidt,nbytes)
+ imidt = imidt+nbytes
+ do 11 j = 1 , 3
+ itiesav(j+1,nsav4tie) = mmidi(icm,imidt+j)
+11 continue
+ imidt = imidt+3
+ if (nsav4tie .eq. 1) then
+ itiesav(5,1) = itiesav(1,1)
+ else
+ itiesav(5,nsav4tie) = itiesav(1,nsav4tie)+
+ * itiesav(5,nsav4tie-1)
+ end if
+ if (imidt .ne. imidi(icm)) go to 10
+c
+c Find which two pitches agree with saved slur pitch.
+c
+ it1found = .false.
+ do 12 it2 = 1 , nsav4tie
+ if (itiesav(3,it2) .eq. ipslon(icm)) then
+ if (it1found) go to 13
+ it1 = it2
+ it1found = .true.
+ end if
+12 continue
+ call printl(
+ * 'Program error, tied notes, send source to Dr. Don')
+ it1 = nsav4tie+1
+ it2 = nsav4tie+1
+13 continue
+c
+c List the positions we want to keep
+c
+ jsav = 0
+ do 14 isav = 1 , nsav4tie
+ if (isav.eq.it1 .or. isav.eq.it2) go to 14
+ jsav = jsav+1
+ itk(jsav) = isav
+14 continue
+ nsav4tie = nsav4tie-2
+c
+c Now dump events it1 & it2, recompute times, restack mmidi.
+c
+ imidi(icm) = imidso(icm)
+ do 15 isav = 1 ,nsav4tie
+ if (isav .eq. 1) then
+ idurvar = isetvarlen(itiesav(5,itk(isav)),nbytes)
+ else
+ idurvar = isetvarlen(itiesav(5,itk(isav))-
+ * itiesav(5,itk(isav-1)),nbytes)
+ end if
+ imidi(icm) = imidi(icm)+1
+ do 16 i = 1 , nbytes
+ mmidi(icm,imidi(icm)+nbytes-i) = mod(idurvar,256)
+ if (nbytes .gt. 1) idurvar = idurvar/256
+16 continue
+ imidi(icm) = imidi(icm)+nbytes-1
+ do 17 i = 2 , 4
+ imidi(icm) = imidi(icm)+1
+ mmidi(icm,imidi(icm)) = itiesav(i,itk(isav))
+17 continue
+15 continue
+ end if
+ slmon(icm) = .false.
+ levsoff(icm) = 0
+ if (.not.dbltie) levson(icm) = 0
+ end if
+ if (levson(icm).gt.0) slmon(icm) = .true.
+ if (nmidcrd .gt. 0) nmidcrd = 0
+ call chkimidi(icm)
+ return
+ end
+ subroutine addstr(notexq,lnote,soutq,lsout)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink
+ character*(*) notexq
+ character*80 soutq
+ if (lsout+lnote .gt. 72) then
+ if (islast) write(11,'(a)')soutq(1:lsout)//'%'
+ lsout = 0
+ end if
+ if (lsout .gt. 0) then
+ soutq = soutq(1:lsout)//notexq(1:lnote)
+ else
+ soutq = notexq(1:lnote)
+ end if
+ lsout = lsout+lnote
+ return
+ end
+ subroutine adjusteskz(ib,istart,poenom)
+c
+c For block ib, this adds accidental spaces to eskz, for use in getting
+c length of xtup bracket and slopes of brackets and beams.
+c
+ parameter (nm=24)
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ integer*4 istart(80)
+ common /comnsp/ space(80),nb,prevtn(nm),
+ * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig
+ common /comeskz2/ eskz2(nm,200)
+ common /comtol/ tol
+ common /comntot/ ntot
+ inmin = istart(ib)+1
+ do 10 iaskb = 1 , naskb
+ if (task(iaskb) .lt. to(istart(ib))-tol) go to 10
+ eskadd = wask(iaskb)/poenom-elask(iaskb)
+ do 11 in = inmin , ntot
+ if (to(in) .gt. task(iaskb)-tol) then
+ eskz2(ivxo(in),ipo(in)) = eskz2(ivxo(in),ipo(in))+eskadd
+ if (abs(to(in)-task(iaskb)).lt. tol) inmin=inmin-1
+ else
+ inmin = inmin+1
+ end if
+11 continue
+10 continue
+ return
+ end
+ subroutine askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
+ logical figbass,ispoi,topmods,istype0,done,isbbm
+ common /comhsp/ hpttot(176)
+ common /compoi/ ispoi
+ common /combbm/ isbbm
+ common /comas3/ ask(2500),iask,topmods
+ character*40 pathnameq
+ character*44 basenameq
+ character*1 sq,chax
+ character*129 outq
+ sq = chax(92)
+ open(12,file=pathnameq(1:lpath)//basenameq(1:lbase)//'.tex')
+c
+c Transfer first 5 lines of main internal TeX file
+c
+ do 11 il = 1 , 5
+ call moveln(11,12,done)
+11 continue
+ if (istype0) then
+c
+c Transfer literal TeX stuff from special scratch file
+c
+ rewind(17)
+10 call moveln(17,12,done)
+ if (.not.done) go to 10
+ close(17)
+ end if
+c
+c Transfer next 2 lines from main scratch file
+c
+ do 3 il = 1 , 2
+ call moveln(11,12,done)
+3 continue
+ if (ispoi) write(12,'(a)')sq//'input musixpoi'
+ if (isbbm) write(12,'(a)')sq//'input musixbbm'
+ if (figbass) then
+c
+c Transfer .fig data from scratch (unit 14) into external .tex (unit 12)
+c
+4 call moveln(14,12,done)
+ if (.not.done) go to 4
+ close(14)
+ end if
+ iask = 0
+ ihs = 0
+1 read(11,'(a129)',end=999)outq
+c
+c Hardspaces.
+c
+ if (outq(1:5) .eq. sq//'xard') then
+ ihs = ihs+1
+ outq(2:2) = 'h'
+ write(outq(12:15),'(f4.1)')hpttot(ihs)
+ lenout = 19
+ go to 9
+ end if
+c
+c This part hard-wires ask's into new .tex file as ast's
+c
+2 indxask = index(outq,sq//'ask')
+ if (indxask .ne. 0) then
+ iask = iask+1
+ call putast(ask(iask),indxask,outq)
+ go to 2
+ end if
+ lenout = llen(outq,129)
+9 continue
+ write(12,'(a)')outq(1:lenout)
+c
+c If this is the line with "readmod", check for topmods.
+c
+ if (topmods .and. outq(2:8).eq.'readmod') then
+ topmods = .false.
+ rewind(16)
+ do 7 il = 1 , 1000
+ read(16,'(a129)',end=8)outq
+ lenout = llen(outq,129)
+c
+c We inserted the '%' in subroutine littex, to guarantee including blank.
+c
+ write(12,'(a)')outq(1:lenout)
+7 continue
+8 continue
+ close(16)
+ end if
+ go to 1
+999 close(11)
+ close(12)
+ return
+ end
+ subroutine backfill(iunit,oldq,lenold,newq,lennew)
+c
+c In iunit, looks backward for oldq, overwrites newq
+c Safest if both are same length!
+c
+ character*128 lineq(200),nowq
+ character*(*) oldq,newq
+ linesback = 0
+1 continue
+ backspace(iunit)
+ read(iunit,'(a)')nowq
+ ndx = index(nowq,oldq(1:lenold))
+c
+c Save the line just read
+c
+ linesback = linesback+1
+ lineq(linesback) = nowq
+ if (ndx .eq. 0) then
+ backspace(iunit)
+ go to 1
+ end if
+c
+c If here, it's replacement time.
+c
+ lineq(linesback) = nowq(1:ndx-1)//newq(1:lennew)
+ * //nowq(ndx+lenold:128)
+ backspace(iunit)
+ do 2 line = linesback , 1 , -1
+ write(iunit,'(a128)')lineq(line)
+2 continue
+ return
+ end
+ subroutine beamend(notexq,lnote)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq,ulqq,chax
+ logical beamon,firstgulp,figbass,figchk,flipend,btest,
+ * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comoct/ noctup
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
+ character*4 tempq
+ character*8 noteq
+ character*79 notexq
+ ip = ipo(jn)
+ multip = iand(mult(ivx,ip),15)-8
+ lnote = 0
+ if (ixrest(ivx) .eq. 4) then
+c
+c This is the LAST note in the xtup (i.e., all rests before). Make single.
+c
+ nodur(ivx,ip) = 2**(4-multip)
+ call notex(notexq,lnote)
+ ixrest(ivx) = 0
+ return
+ end if
+ nole = nolev(ivx,ip)
+c
+c Check for special situations with 2nds (see precrd)
+c
+ if (btest(nacc(ivx,ip),30)) then
+ nole = nole - 1
+ else if (btest(nacc(ivx,ip),31)) then
+ nole = nole + 1
+ end if
+c
+c Terminate indented beams for 2-note tremolo if needed
+c
+ if (btest(irest(ivx,ip-1),2) .and.
+ * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then
+ nindent = igetbits(irest(ivx,ip-1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ addoff = -1-.5*nindent
+ else
+ addoff = 1+.5*nindent
+ endif
+c addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx)
+ addoff = addoff+.0822*islope(ivx)
+ if (addoff .lt. -.05) then
+ write(tempq,'(f4.1)')addoff
+ else
+ write(tempq,'(f4.2)')addoff
+ end if
+ notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//'hbox{'
+ * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))//
+ * '0}}'
+ lnote = 46
+ end if
+ if (.not.drawbm(ivx)) then
+c
+c Xtuplet with no beam, just put in the right kind of note
+c
+ if (btest(irest(ivx,ip),0)) then
+c
+c Rest at end of unbeamed xtup
+c
+ lnote = 3
+ if (btest(islur(ivx,ip),29)) then
+ notexq = sq//'sk'
+c
+c 180106 There was a problem with nolev(ivx,ip) not being set to 0 for
+c a blank rest ending xtup, but hopefully returning from here will handle it.
+c
+ return
+ else if (multip .eq. 0) then
+ notexq = sq//'qp'
+ else if (multip .eq. -1) then
+ notexq = sq//'hp'
+ else if (multip .eq. 1) then
+ notexq = sq//'ds'
+ else if (multip .eq. 2) then
+ notexq = sq//'qs'
+ else
+ notexq = sq//'hs'
+ end if
+c
+c 180106 Deal with possible level tweak
+c
+ nole = mod(nolev(ivx,ip)+50,100)-50
+ if (nole .ne. 0) then
+ if (abs(nole) .lt. 10) then
+ noteq = chax(48+abs(nole))
+ lnoten = 1
+ else
+ write(noteq(1:2),'(i2)')abs(nole)
+ lnoten = 2
+ end if
+ if (nole .gt. 0) then
+ notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
+ * //notexq(1:lnote)
+ else
+ notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
+ * //notexq(1:lnote)
+ end if
+ lnote = 16+lnoten+lnote
+ end if
+ return
+ end if
+ if (btest(islur(ivx,ip),30)) then
+c
+c Forced stem direction
+c
+ ndsav = nodur(ivx,ip)
+ nodur(ivx,ip) = 2**(4-multip)
+ if (btest(nacc(ivx,ip-1),27))
+ * nodur(ivx,ip)=nodur(ivx,ip)/2
+ call notex(notexq,lnote)
+ nodur(ivx,ip) = ndsav
+ else
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+c
+c To reduce confusion due to this early update of lnote, do it
+c below, separately in each case/
+c lnote = lnoten+3
+ if (.not.btest(nacc(ivx,ip-1),27)) then
+c
+c Prior note is not regular-dotted
+c
+ if (btest(irest(ivx,ip-1),2) .and.
+ * igetbits(irest(ivx,ip-1),2,5) .gt. 0) then
+c
+c Unbeamed tremolo with indented beams. Put termination in right here
+c
+ nindent = igetbits(irest(ivx,ip-1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ addoff = -1-.5*nindent
+ else
+ addoff = 1+.5*nindent
+ endif
+c
+c Is there an islope here, for unbeamed?
+c
+ if (addoff .lt. -.05) then
+ write(tempq,'(f4.1)')addoff
+ else
+ write(tempq,'(f4.2)')addoff
+ end if
+ notexq = sq//'raise'//tempq(1:4)//sq//'internote'//sq//
+ * 'hbox{'
+ * //sq//'loffset{.7}{'//sq//'tb'//ulq(ivx,ibmcnt(ivx))//
+ * '0}}'
+ lnote = 46
+ end if
+ if (multip .eq. 0) then
+ if (btest(irest(ivx,ip-1),2) .and.
+ * nodur(ivx,ip).gt.24) then
+c
+c 2nd note of unbeamed half-note trem; make open
+c But it's not clear if unbeamed half-note tremolo is Kosher,
+c so don't worry about stem lengths here now.
+c
+ if (lnote .eq. 0) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
+ else
+ notexq = notexq(1:46)//
+ * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
+ lnote = 46
+ end if
+ else
+ if (btest(irest(ivx,ip-1),2) .and.
+ * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
+c
+c Need a dot.
+c
+ lnote = 46
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+c
+c Insert stemlength stuff here for unbeamed dotted tremolo.
+c May later combine with below to avoid repeat. But need to
+c return to normal stem length after note is set.
+c
+ nindent = igetbits(irest(ivx,ip-1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ slen = (4.5+nindent+nolev1(ivx)-nole
+ * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
+ * *islope(ivx)/slfac)*.6667
+ else
+ slen = (4.5+nindent-nolev1(ivx)+nole
+ * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
+ * *islope(ivx)/slfac)*.6667
+ end if
+ write(tempq,'(f4.1)')slen
+ notexq = sq//'slx{'//tempq//'}'//notexq(1:lnote)
+ lnote = lnote+10
+ end if
+c
+c Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem
+c (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot)
+c
+ if (btest(irest(ivx,ip-1),2)) then
+ if (lnote .eq. 0) then
+c notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//'p'
+ * //noteq(1:lnoten)
+ else
+ notexq = notexq(1:lnote)//sq//'q'
+c * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ * //ulq(ivx,ibmcnt(ivx))//'p'//noteq(1:lnoten)
+ end if
+c lnote = lnote+3+lnoten
+ lnote = lnote+4+lnoten
+ else
+ if (lnote .eq. 0) then
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ * //noteq(1:lnoten)
+ else
+ notexq = notexq(1:lnote)//sq//'q'
+ * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ end if
+ lnote = lnote+3+lnoten
+ end if
+ if (btest(irest(ivx,ip-1),2) .and.
+ * nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
+ notexq = notexq(1:lnote)//sq//'slz'
+ lnote=lnote+4
+ end if
+ end if
+ else if (btest(irest(ivx,ip-1),2)) then
+c
+c 2nd note of unbeamed quarter or 8th trem; make quarter note
+c Get stemlength change
+c
+ lnote = 46
+ nindent = igetbits(irest(ivx,ip-1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ slen = (4.5+nindent+nolev1(ivx)-nole
+ * +1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
+ * *islope(ivx)/slfac)*.6667
+ else
+ slen = (4.5+nindent-nolev1(ivx)+nole
+ * -1.3*(eskz(ivx,ip)-eskz(ivx,ip-1)-.7)
+ * *islope(ivx)/slfac)*.6667
+ end if
+ write(tempq,'(f4.1)')slen
+ notexq = notexq(1:46)//sq//'slx{'//tempq//'}'
+ lnote = lnote+10
+c
+c Check for dotted unbeamed tremolo
+c
+ if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
+c
+c Need a dot
+c
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ if (lnote .eq. 0) then
+ notexq = sq//'pt'//noteq(1:lnoten)
+ else
+ notexq = notexq(1:lnote)//sq//'pt'//noteq(1:lnoten)
+ end if
+ lnote = lnote+3+lnoten
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ end if
+ notexq = notexq(1:lnote)//
+ * sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+c * //sq//'stemcut'
+ * //sq//'slz'
+c lnote=lnote+3+lnoten+8
+ lnote=lnote+3+lnoten+4
+ else if (multip .eq. -1) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (multip .eq. 1) then
+ notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (multip .eq. 2) then
+ notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+4
+ else if (multip .eq. 3) then
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten)
+ lnote = lnoten+5
+ else if (multip .eq. -2) then
+ notexq = sq//'wh'//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (multip .eq. -3) then
+ notexq = sq//'breve'//noteq(1:lnoten)
+ lnote = lnoten+6
+ else
+ print*
+ print*,'(Error in beamend, send source to Dr. Don)'
+ call stop1()
+ end if
+ else
+c
+c Prior note is regular-dotted so this one is halved
+c
+ lnote = lnoten+3
+ if (multip .eq. 0) then
+ notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))//noteq
+ else if (multip .eq. -1) then
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))//noteq
+ else if (multip .eq. -2) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq
+ else if (multip .eq. 1) then
+ notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))//noteq
+ lnote = lnoten+4
+ else if (multip .eq. 2) then
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))//noteq
+ lnote = lnoten+5
+ end if
+ end if
+ end if
+ return
+ end if
+c
+c End of block for unbeamed. Problem if beamed but ends w/ rest. Try just
+c skipping the call in that case.
+c
+ if (.not.btest(irest(ivx,ip),0)) then
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ end if
+c call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+c lnote = 0
+c
+c New way, with flipend, which was computed in beamstrt.
+c
+ if (flipend(ivx) .and. btest(ipl(ivx,ip),30)) then
+ ulq(ivx,ibmcnt(ivx)) = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
+ flipend(ivx) = .false.
+ end if
+ if (ip .gt. ibm1(ivx,ibmcnt(ivx))) then
+c
+c This is not a one-noter from beam-jump. Check if multiplicity has increased
+c
+ if (btest(irest(ivx,ip-1),0)) then
+c
+c Prior note is a rest, check one before that
+c
+ mp = iand(mult(ivx,ip-2),15)-8
+ else
+ mp = iand(mult(ivx,ip-1),15)-8
+ end if
+ if (multip .gt. mp) then
+c
+c Assume 1-3, 2-3, or 1-2
+c
+ do 2 imp = multip , mp+1 , -1
+ call ntrbbb(imp,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
+2 continue
+ else if (btest(nacc(ivx,ip-1),27)) then
+c
+c 2nd member of dotted xtup
+c
+ call ntrbbb(multip+1,'t',
+ * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
+ end if
+ end if
+c
+c Beam termination and direction analysis
+c
+ if (btest(irest(ivx,ip),23) .and. .not.isbjmp) then
+c
+c This is the end of the first segment in a jump-beam. ivbj1=ivx will be number
+c of the jump-beam. ivbj2 will be tested along with isbjmp to see if in the
+c voice of the 2nd part of jumped beam. (May need special treatment for
+c multi-segment jump-beams
+c
+ isbjmp = .true.
+ ivbj1 = ivx
+ multbj1 = iand(15,mult(ivx,ip)-8)
+ ivbj2 = 0
+ end if
+ if (.not.btest(irest(ivx,ip),23)) then
+c
+c This is either a normal beamend or end of a sequence of jump-beam segments,
+c (170409) or rest at end of xtup
+c so some sort of termination is required
+c
+ ulqq = ulq(ivx,ibmcnt(ivx))
+ if (.not.isbjmp .or. ivx.ne.ivbj2) then
+ if (btest(irest(ivx,ip),0)) then
+c
+c Xtup ends with rest
+c
+ if (multip .eq. 1) then
+ notexq = sq//'ds'
+ lnote = 3
+ else if (multip .eq. 2) then
+ notexq = sq//'qs'
+ lnote = 3
+ else if (multip .eq. 3) then
+ notexq = sq//'hs'
+ lnote = 3
+ end if
+c
+c 170801 Borrowed from main rest entry way down below to get level adjustment:
+c BUT nole is like 102, not 2, so subtracted 100 for nole. Why different???
+c "... Now raise if necc."
+c
+ if (btest(islur(ivx,ip),29)) then
+c
+c Blank rest
+c
+ notexq = sq//'sk'
+ lnote = 3
+ else if (nole .ne. 0) then
+c
+c Bandaid. Odd case with rests in xtups + 2 voices where came thru here with
+c nolev=-4 but expected 100+/-. Try to fix.
+c
+ if (abs(nole).lt.30) nole = 100+nole
+c
+ if (abs(nole-100) .lt. 10) then
+ noteq = chax(48+abs(nole-100))
+ lnoten = 1
+ else
+ write(noteq(1:2),'(i2)')abs(nole-100)
+ lnoten = 2
+ end if
+c ??? if (nole .gt. 0) then
+ if (nole .gt. 100) then
+ notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
+ * //notexq(1:lnote)
+ else
+ notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
+ * //notexq(1:lnote)
+ end if
+ lnote = 16+lnoten+lnote
+ end if
+ return
+ else
+c
+c Normal termination
+c
+ call ntrbbb(1,'t',ulqq,mod(ivx,24),notexq,lnote)
+ end if
+ else
+c
+c Terminate a sequence of jump-beam segments.
+c
+ ulqq = chax(225-ichar(ulqq))
+ call ntrbbb(1,'t',ulqq,mod(ivbj1,24),notexq,lnote)
+ end if
+ end if
+c
+c Check for end of 2nd seg of staff-jump xtup chord blank rest
+c
+c if (isbjmp.and.ivx.eq.ivbj2
+ if (isbjmp
+ * .and.btest(islur(ivx,ip),29)) then
+ notexq = notexq(1:lnote)//sq//'sk'
+ return
+ end if
+c
+c And now the note, checking for open-head beamed tremolo
+c
+ if (btest(irest(ivx,ip-1),2)) then
+c
+c Check for dotted tremolo
+c
+ if (abs(nodur(ivx,ip)/12.-nodur(ivx,ip)/12).lt..001) then
+c
+c Need a dot
+c
+ if (nodur(ivx,ip).eq.24 .or. nodur(ivx,ip).eq.12) then
+c
+c Solid notehead
+c
+ notexq = notexq(1:lnote)//sq//'qbp'
+ else
+c
+c Assuming open notehead and nodur = 48
+c
+ notexq = notexq(1:lnote)//sq//'hbp'
+ end if
+ lnote = lnote+4
+ else
+ if (nodur(ivx,ip).eq.32 .or. nodur(ivx,ip).eq.48) then
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'hb'
+ else
+ notexq = sq//'hb'
+ end if
+ else
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
+ end if
+ lnote = lnote+3
+ end if
+ else
+c
+c No tremolo
+c
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
+ lnote = lnote+3
+ end if
+ isdotm = .false.
+ if (.not.vxtup(ivx)) then
+ if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
+ if (.not.btest(iornq(ivx,ip),13)) then
+ notexq = notexq(1:lnote)//'p'
+ else
+ notexq = notexq(1:lnote)//'m'
+ isdotm = .true.
+ end if
+ lnote = lnote+1
+ end if
+ end if
+c
+c 5/25/08 Allow >12
+c 5/9/10 Up to 24; replace 24 with 0
+c
+ if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
+ call istring(mod(ivx,24),tempq,len)
+ else
+ call istring(mod(ivbj1,24),tempq,len)
+ end if
+ if (isbjmp .and. ivx.eq.ivbj2
+ * .and..not.btest(irest(ivx,ip),23)) isbjmp=.false.
+ notexq = notexq(1:lnote)//tempq(1:len)
+ lnote = lnote+len
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (isdotm) then
+ if (lnoten .eq. 1) then
+ notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
+ lnote = lnote+3
+ else
+ notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
+ lnote = lnote+1
+ end if
+ end if
+ return
+ end
+ subroutine beamid(notexq,lnote)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq,ulqq,chax
+ logical beamon,firstgulp,figbass,figchk,flipend,btest,
+ * isfig,vxtup,isdotm,isbjmp,bar1syst,isdotted,isbj2,drawbm
+ character*79 notexq
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comoct/ noctup
+ common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ character*8 noteq
+ character*4 tempq
+ lnote = 0
+ ip = ipo(jn)
+ nole = nolev(ivx,ip)
+c
+c Check for special situations with 2nds (see precrd)
+c
+ if (btest(nacc(ivx,ip),30)) then
+ nole = nole - 1
+ else if (btest(nacc(ivx,ip),31)) then
+ nole = nole + 1
+ end if
+ if (.not.btest(irest(ivx,ip),0)) then
+ multip = iand(mult(ivx,ip),15)-8
+c if (btest(islur(ivx,ip-1),3)) multip = multip+1
+c
+c (Above test OK since must have ip>1). Double dotted note preceding
+c
+c Move the following, because can't ask for note until after checking for
+c embedded xtup with number, due to ordering/octave feature.
+c
+c call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
+ end if
+ if (btest(irest(ivx,ip),28)) vxtup(ivx) = .true.
+ if (vxtup(ivx)) then
+c
+c In an xtup
+c
+ if (btest(irest(ivx,ip),0)) then
+c
+c Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK
+c
+ nodur(ivx,ip) = 2**(4-(iand(mult(ivx,ip),15)-8))
+ call notex(notexq,lnote)
+c
+c Re-zero so next note does not get confused
+c
+ nodur(ivx,ip) = 0
+ return
+ end if
+ if (.not.drawbm(ivx)) then
+c
+c Xtuplet with no beam, just put in the right kind of note
+c
+ if (btest(islur(ivx,ip),30)) then
+c
+c Forced stem direction
+c
+ ndsav = nodur(ivx,ip)
+ nodur(ivx,ip) = 2**(4-multip)
+ if (btest(nacc(ivx,ip),19) .or.
+ * btest(nacc(ivx,ip),27)) then
+ nodur(ivx,ip)=3*nodur(ivx,ip)/2
+ else if (btest(nacc(ivx,ip-1),27)) then
+ nodur(ivx,ip)=nodur(ivx,ip)/2
+ end if
+ call notex(notexq,lnote)
+ nodur(ivx,ip) = ndsav
+ else
+c
+c Use ulq for stem direction
+c
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ lnote = 3
+ if (.not.btest(nacc(ivx,ip-1),27)) then
+c
+c Prior note of xtup is not regular-dotted
+c
+ if (multip .eq. 0) then
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. -1) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. 1) then
+ notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. 2) then
+ notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 4
+ else if (multip .eq. 3) then
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 5
+ else if (multip .eq. -2) then
+ notexq = sq//'wh'
+ end if
+ if (btest(nacc(ivx,ip),27)) then
+c
+c This xtup note is regular dotted non-beamed xtup
+c
+c notexq = notexq(1:3)//'p'
+c lnote = 4
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+ else
+c
+c Prior note of xtup is regular-dotted so this one is halved
+c
+ if (multip .eq. 2) then
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 5
+ else if (multip .eq. 1) then
+ notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 4
+ else if (multip .eq. 0) then
+ notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. -1) then
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. -2) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
+ end if
+ end if
+ notexq = notexq(1:lnote)//noteq
+ lnote = lnote+lnoten
+ end if
+ return
+ else if (nodur(ivx,ip).eq.0) then
+c
+c In the beamed xtup but not the last note
+c
+ if (nodur(ivx,ip-1).gt.0) then
+c
+c Embedded Xtup, mult>0, starts here. Put in number if needed
+c
+ nxtinbm(ivx) = nxtinbm(ivx)+1
+ iud = 1
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') iud = -1
+c
+c Get ip#, notelevel of middle note (or gap) in xtup
+c
+ ipmid = ip+ntupv(ivx,nxtinbm(ivx))/2
+ xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
+ * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
+ if (mod(ntupv(ivx,nxtinbm(ivx)),2).eq.0) xnlmid = (xnlmid+
+ * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
+ * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
+ iflop = 0
+ if (abs(xnlmid-ncmid(iv,ip)).lt.3.) iflop = -iud
+ iup = iud+2*iflop
+ if (btest(irest(ivx,ip),14)) then
+ iup = -iup
+ iflop = 0
+ if (iud*iup .lt. 0) iflop = iup
+ end if
+c
+c Place number if needed
+c
+ if (.not.btest(islur(ivx,ip),31)) then
+ mprint = igetbits(nacc(ivx,ip),5,22)
+ if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
+ call putxtn(mprint,iflop,multip,iud,wheadpt,poenom,
+ * nolev1(ivx),islope(ivx),slfac,
+ * xnlmid,islur(ivx,ip),lnote,notexq,ncmid(iv,ip),nlnum,
+ * eloff(ivx,nxtinbm(ivx)),iup,irest(ivx,ip),
+ * mult(ivx,ip),.false.)
+ end if
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ else
+c
+c Intermediate note of xtup
+c
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ end if
+ else
+c
+c Last note of xtup (but not last note of beam!)
+c
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ end if
+ else if (btest(irest(ivx,ip),0)) then
+ call notex(notexq,lnote)
+ return
+ else
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ end if
+c
+c Check for string of rests up to and including last note in xtup.
+c
+c Replace next 2 lines to keep from doing this block
+c when in second part of staff-jumping chordal xtup. This fix could
+c break some unaccounted non-chordal staff-jum xtup situations.
+c if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and.
+c * .not.btest(irest(ivx,ip),0)) then
+ if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and.
+ * .not.btest(irest(ivx,ip),0) .and.
+ * .not.(isbjmp.and.ivx.eq.ivbj2)) then
+c
+c This note is not a rest but next is a rest. Do rests continue to
+c end of xtup, where nodur>0
+c
+ do 3 ipnow = ip+1 , ip+24
+ if (nodur(ivx,ipnow).gt.0) go to 4 ! This is last of xtup
+ if (.not.btest(irest(ivx,ipnow+1),0)) go to 5 ! Next is not rest
+c
+c If I don't go to 5, know next note IS a rest!
+c
+3 continue
+4 continue
+ call ntrbbb(1,'t',ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
+ notexq = notexq(1:lnote)//sq//'qb'
+ lnote = lnote+3
+ call istring(ivx,tempq,len)
+ notexq = notexq(1:lnote)//tempq(1:len)
+ lnote = lnote+len
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ return
+5 continue
+c
+c Check if multiplicity changes in a way requiring action,
+c unless (160211) it's blank rest on start of 2nd seg of joined beam
+c
+ else if(.not.btest(irest(ivx,ip-1),24)
+ * .or..not.btest(islur(ivx,ip-1),29)) then
+ ipleft = ip-1
+ if (btest(irest(ivx,ipleft),0)) ipleft = ipleft-1
+ if (.not.btest(islur(ivx,ipleft),20)) then
+ multl = iand(15,mult(ivx,ipleft))-8
+ else
+ multl = 1
+ end if
+ mub = multip - multl
+ ipright = ip+1
+ if (btest(irest(ivx,ipright),0)) ipright = ipright+1
+ if (.not.btest(islur(ivx,ip),20)) then
+ multr = iand(15,mult(ivx,ipright))-8
+ else
+ multr = 1
+ end if
+ mua = multr-multip
+ if (mub.gt.0 .or. mua .lt. 0) then
+c
+c Multiplicity has increased from left or will decrease to right. Need action.
+c
+ if (isbjmp .and. ivx.eq.ivbj2) then
+ ivb = ivbj1
+ ulqq = chax(225-ichar(ulq(ivx,ibmcnt(ivx))))
+ else
+ ivb = ivx
+ ulqq = ulq(ivx,ibmcnt(ivx))
+ end if
+ if (mua .ge. 0) then
+ call ntrbbb(multip,'n',ulqq,ivb,notexq,lnote)
+c
+c Test for next note being blank rest, assuming staff-crossing
+c xtup chord
+c
+ else if (multl .ge. multr .and.
+ * .not.btest(islur(ivx,ip+1),29)) then
+ do 1 im = multip , 1+multr, -1
+ call ntrbbb(im,'t',ulqq,ivb,notexq,lnote)
+1 continue
+c else
+c Test for next note being blank rest, assuming staff-crossing
+c xtup chord
+c
+ else if (.not.btest(islur(ivx,ip+1),29)) then
+ do 2 im = 1+multr, multip
+ call ntrbbb(im,'r',ulqq,ivb,notexq,lnote)
+2 continue
+ call ntrbbb(multr,'n',ulqq,ivb,notexq,lnote)
+ end if
+ else if (ip .gt. 1) then
+c
+c Check for 2nd member of dotted xtup
+c
+ if (btest(nacc(ivx,ip-1),27)) call ntrbbb(multip+1,'t',
+ * ulq(ivx,ibmcnt(ivx)),ivx,notexq,lnote)
+ end if
+ end if
+c
+c Now put in the note
+c
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
+ lnote = lnote+3
+ isdotm = .false.
+ if (isdotted(nodur,ivx,ip)) then
+c
+c rule out ')'
+c
+ if (.not.btest(iornq(ivx,ip),13)) then
+ if (.not.btest(islur(ivx,ip),3)) then
+ notexq = notexq(1:lnote)//'p'
+ else
+c
+c Double dot
+c
+ notexq = notexq(1:lnote)//'pp'
+ lnote = lnote+1
+ end if
+ else
+ notexq = notexq(1:lnote)//'m'
+ isdotm = .true.
+ end if
+ lnote = lnote+1
+ else if (btest(nacc(ivx,ip),19)
+ * .or. btest(nacc(ivx,ip),27)) then
+c
+c Special dotted notation for 2:1 xtup, or normal dot in xtup
+c
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+c
+c 5/25/08 Allow >12
+c
+ if (.not.(isbjmp.and.ivx.eq.ivbj2)) then
+c call istring(mod(ivx,12),tempq,len)
+ call istring(mod(ivx,24),tempq,len)
+ else
+c call istring(mod(ivbj1,12),tempq,len)
+ call istring(mod(ivbj1,24),tempq,len)
+ end if
+ notexq = notexq(1:lnote)//tempq(1:len)
+ lnote = lnote+len
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (isdotm) then
+ if (lnoten .eq. 2) then
+ notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
+ lnote = lnote+3
+ else
+ notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
+ lnote = lnote+1
+ end if
+ end if
+ return
+ end
+ subroutine beamn1(notexq,lnote)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,btest,
+ * isfig,vxtup,isdotm,isbjmp,isbj2,drawbm
+ logical gotnote
+ common /comoct/ noctup
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ character*8 noteq,tempq,numq
+ character*79 notexq
+ gotnote = .false.
+ lnoten = 0
+ ip1 = ipo(jn)
+ multip = iand(15,mult(ivx,ip1))-8
+ if (.not.drawbm(ivx) .and. btest(irest(ivx,ip1),0)) then
+ lnote = 0
+c
+c The rest was already written in beamstrt, so just get out of here
+c
+ return
+ end if
+ nole = nolev(ivx,ipo(jn))
+c
+c Check for special situations with 2nds (see precrd)
+c
+ if (btest(nacc(ivx,ipo(jn)),30)) then
+ nole = nole - 1
+ else if (btest(nacc(ivx,ipo(jn)),31)) then
+ nole = nole + 1
+ end if
+ if (vxtup(ivx) .and. .not.drawbm(ivx)) then
+c
+c Xtuplet with no beam, just put in the right kind of note
+c
+ if (btest(islur(ivx,ip1),30)) then
+c
+c Forced stem direction
+c
+ ndsav = nodur(ivx,ip1)
+ nodur(ivx,ip1) = 2**(4-multip)
+ if (btest(nacc(ivx,ip1),19) .or.
+ * btest(nacc(ivx,ip1),27)) nodur(ivx,ip1)=3*nodur(ivx,ip1)/2
+ call notex(notexq,lnote)
+ nodur(ivx,ip1) = ndsav
+ else
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
+ gotnote = .true.
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ lnote = 3
+ if (multip .le. 0) then
+ if ((btest(irest(ivx,ip1),2) .and.
+ * nodur(ivx,ip1+1).ge.32)
+ * .or. multip .eq. -1) then
+c
+c 1st note of unbeamed half-note trem; make open
+c
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. -2) then
+ notexq = sq//'wh'
+ else
+ notexq = sq//'q'//ulq(ivx,ibmcnt(ivx))
+ end if
+c
+c Check for dot
+c
+ if (btest(irest(ivx,ip1),2) .and.
+ * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then
+c
+c Need a dot. already called addblank for noteq
+c
+ if (lnote .eq. 0) then
+ notexq = sq//'pt'//noteq(1:lnoten)
+ lnote = 3+lnoten
+ else
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+ end if
+c
+c Insert the stemlength calcs here for dotted, unbeamed.
+c Later may combine with below to avoid repeat.
+c
+ if (btest(irest(ivx,ip1),2)) then
+ nindent = igetbits(irest(ivx,ip1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ slen = (4.5+nindent+nolev1(ivx)-nole
+ * -.4*islope(ivx)/slfac)*.6667
+ else
+ slen = (4.5+nindent-nolev1(ivx)+nole
+ * +.4*islope(ivx)/slfac)*.6667
+ end if
+ write(tempq,'(f4.1)')slen
+ notexq = sq//'slx{'//tempq(1:4)//'}'//
+ * notexq(1:lnote)
+ lnote = lnote+10
+ end if
+ else if (btest(irest(ivx,ip1),2)) then
+c
+c 1st note of unbeamed quarter or 8th trem, make a quarter note
+c
+c Stem length calcs here. The .2 factor is empirical, but
+c slfac accounts for musicsize.
+c
+ nindent = igetbits(irest(ivx,ip1),2,5)
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ slen = (4.5+nindent+nolev1(ivx)-nole
+ * -.4*islope(ivx)/slfac)*.6667
+ else
+ slen = (4.5+nindent-nolev1(ivx)+nole
+ * +.4*islope(ivx)/slfac)*.6667
+ end if
+ write(tempq,'(f4.1)')slen
+ notexq = sq//'slx{'//tempq(1:4)//'}'//
+ * sq//'q'//ulq(ivx,ibmcnt(ivx))
+ lnote = 13
+c
+c Check for dotted 2-note trem; prepend dot to notexq if needed
+c
+ if (nodur(ivx,ip1+1).eq.12 .or.
+ * nodur(ivx,ip1+1).eq.24) then
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ notexq = sq//'pt'//noteq(1:lnoten)//notexq(1:lnote)
+ lnote = lnote+3+lnoten
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
+ gotnote = .true.
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ end if
+ else if (multip .eq. -1) then
+ notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. 1) then
+ notexq = sq//'c'//ulq(ivx,ibmcnt(ivx))
+ else if (multip .eq. 2) then
+ notexq = sq//'cc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 4
+ else if (multip .eq. 3) then
+ notexq = sq//'ccc'//ulq(ivx,ibmcnt(ivx))
+ lnote = 5
+ else if (multip .eq. -2) then
+ notexq = sq//'wh'
+ else if (multip .eq. -3) then
+ notexq = sq//'breve'
+ lnote = 6
+ else
+ print*
+ print*,'(Error in beamn1, send source to Dr. Don)'
+ call stop1()
+ end if
+ if (btest(nacc(ivx,ip1),19) .or. btest(nacc(ivx,ip1),27)) then
+c notexq = notexq(1:3)//'p'
+c lnote = 4
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+ notexq = notexq(1:lnote)//noteq
+ lnote = lnote+lnoten
+ end if
+ return
+ end if
+c
+c Check if mult. decreases from 1st note to 2nd
+c
+ if (ibm2(ivx,ibmcnt(ivx)).gt.ip1
+ * .or. btest(islur(ivx,ip1),20)) then
+c
+c More than one note or single-note before a multiplicity-down-up "]["
+c
+ if (btest(islur(ivx,ip1),20)) then
+ multr = 1
+ else if (.not.btest(irest(ivx,ip1+1),0)) then
+ multr = iand(15,mult(ivx,ip1+1))-8
+ else
+ multr = iand(15,mult(ivx,ip1+2))-8
+ end if
+ lnote = 0
+c
+c Check if staff-jumper
+c
+ if (isbjmp .and. ivbj2.gt.0) then
+ ivxp = ivbj1
+ else
+ ivxp = ivx
+ end if
+ if (multr .lt. multip) then
+ do 1 im = multip , multr+1 , -1
+c
+c Right-shifted 'termination'
+c
+ if (isbjmp .and. ivbj2.gt.0) then
+c
+c Jump beam
+c
+ call ntrbbb(im,'t',ulq(ivxp,ibmcnt(ivx)),
+ * ivxp,notexq,lnote)
+ else
+c
+c Same staff
+c
+ call ntrbbb(im,'r',ulq(ivx,ibmcnt(ivx)),ivxp,notexq,lnote)
+ end if
+1 continue
+ end if
+ end if
+c
+c Check for beamed, dotted 2-note tremolo
+c
+ if (btest(irest(ivx,ip1),2) .and.
+ * abs(nodur(ivx,ip1+1)/12.-nodur(ivx,ip1+1)/12).lt..001) then
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ gotnote = .true.
+ if (lnoten .eq. 1) then
+ noteq = ' '//noteq(1:1)
+ lnoten = 2
+ end if
+ end if
+c
+c Put in the note, but check first for open-head beamed tremolo.
+c
+ if (btest(irest(ivx,ip1),2) .and. nodur(ivx,ip1+1).ge.32) then
+c
+c 2-note open head tremolo
+c
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'hb'
+ else
+ notexq = sq//'hb'
+ end if
+ else
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'qb'
+ else
+ notexq = sq//'qb'
+ end if
+ end if
+ lnote = lnote+3
+ if (btest(irest(ivx,ip1),2) .and.
+ * (nodur(ivx,ip1+1).eq.24.or.nodur(ivx,ip1+1).eq.12
+ * .or.nodur(ivx,ip1+1).eq.48)) then
+c
+c 2-note trem on dotted note
+c
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+c
+c Check for dot
+c
+ isdotm = .false.
+ if (.not.vxtup(ivx)) then
+ nd = nodur(ivx,ipo(jn))
+ if (nd.ne.0) then
+ if (2**log2(nd).ne.nd) then
+ if (.not.btest(iornq(ivx,ip1),13)) then
+ if (.not.btest(islur(ivx,ip1),3)) then
+ notexq = notexq(1:lnote)//'p'
+ else
+c
+c Double dot
+c
+ notexq = notexq(1:lnote)//'pp'
+ lnote = lnote+1
+ end if
+ else
+ notexq = notexq(1:lnote)//'m'
+ isdotm = .true.
+ end if
+ lnote = lnote+1
+ end if
+ end if
+ else if (btest(nacc(ivx,ip1),19) .or.
+ * btest(nacc(ivx,ip1),27)) then
+c
+c In an xtup with special 2:1 notation with a dot on 1st note, or normal dot
+c
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+c
+c Do the number; 0 if 12
+c 5/25/08 allow >12
+c
+ if (.not.btest(irest(ivx,ip1),24)) then
+ call istring(mod(ivx,24),numq,len)
+ else
+c
+c 1st note of staff-jumping beam
+c
+ call istring(mod(ivbj1,24),numq,len)
+ end if
+ notexq = notexq(1:lnote)//numq(1:len)
+ lnote = lnote+len
+ if (.not.gotnote) then
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip1))
+ end if
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (isdotm) then
+ if (lnoten .eq. 1) then
+ notexq = notexq(1:lnote)//'{'//noteq(1:1)//'}'
+ lnote = lnote+3
+ else
+ notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
+ lnote = lnote+1
+ end if
+ end if
+ return
+ end
+ subroutine beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ character*40 restq
+ character*79 inameq
+ logical beamon,firstgulp,figbass,figchk,btest,
+ * isfig,vxtup,bar1syst,addbrack,flipend,xto,drawbm
+ common /comeskz2/ eskz2(nm,200)
+ common /comoct/ noctup
+ common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+c
+c The following is just to save the outputs from SetupB for the case of
+c xtups starting with a rest, where beamstrt is called twice.
+c
+ common /comipb/ nnb,sumx,sumy,ipb(24),smed
+ character*1 chax
+ character*8 noteq
+ character*79 notexq,tempq
+ integer nornb(nm),ihornb(nm,24)
+ real*4 space(80),squez(80)
+ logical novshrinktop,cstuplet,usexnumt,writebrests
+ common /comnvst/ novshrinktop,cstuplet
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ character*10 figq
+ common /xjbeambrests/ nbrests
+ writebrests = .true.
+ ibc = ibmcnt(ivx)
+ ipb1 = ibm1(ivx,ibc)
+ multb = iand(15,mult(ivx,ipb1))-8
+ ip = ipo(jn)
+ lnote = 0
+ nvtrem = 0 ! Vertical adjustment beams for tremolo
+c
+c Compute slopes and note offsets from start of beam. Inside SetupB, for each
+c xtup in the beam, set eloff,mtupv (in comxtup) for printed number. Also
+c gets islope(ivx), transferred in common.
+c
+ if (ixrest(ivx).eq.0 .and. .not.btest(nacc(ivx,ip),21))
+ * call SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest(ivx))
+c
+c Will always come past here after entering beamstrt for 2-note tremolo, and
+c slope will have been computed, even for unbeamed. So start the indented
+c beams here. The indented tremolo bars will be added to the notexq output
+c string, under the tacet assumption that there is no horizontal shift
+c enacted by the action just before and after the call to beamstrt.
+c
+ if (btest(irest(ivx,ipb1),2) .and.
+ * igetbits(irest(ivx,ipb1),2,5) .gt. 0) then
+ nindent = igetbits(irest(ivx,ipb1),2,5)
+ tempq = sq//'roffset{.7}{'//sq//'ib'
+ ltemp = 16
+ if (nindent .eq. 2) then
+ tempq = tempq(1:16)//'b'
+ ltemp = 17
+ else if (nindent .eq. 3) then
+ tempq = tempq(1:16)//'bb'
+ ltemp = 18
+ end if
+c
+c Use beam # 0 for indented beams
+c
+ tempq = tempq(1:ltemp)//ulq(ivx,ibc)//'0'
+ ltemp = ltemp+2
+c
+c Get adjustment to nolev1 for main beam based on nindent
+c
+ if (ulq(ivx,ibc) .eq. 'u') then
+ nvtrem = nindent-1
+ else
+ nvtrem = 1-nindent
+ end if
+c
+c Get numerical position of initiation for main beam. Will adjust height at
+c closing to account for nindent
+c
+ numinit = nolev1(ivx)-ncmid(iv,ipb1)+4
+c
+c Get forced beam height tweak, apply here for indented beams
+c
+ iadj = igetbits(ipl(ivx,ipb1),6,11)-30
+ if (iadj .ne. -30) numinit = numinit+iadj
+ if (numinit.ge.0 .and. numinit.le.9) then
+ write(noteq,'(i1)') numinit
+ lnoten = 1
+ else
+ write(noteq,'(a1,i2,a1)')'{',numinit,'}'
+ lnoten = 4
+ end if
+ tempq = tempq(1:ltemp)//noteq(1:lnoten)
+ ltemp = ltemp+lnoten
+c
+c Now do the slope.
+c 170408 Baseline is in islope(ivx). Apply slope tweak if present.
+c
+ numinit = islope(ivx)
+ iadj = igetbits(ipl(ivx,ipb1),6,17)-30
+ if (iadj .ne. -30) numinit = numinit+iadj
+ if (numinit.ge.0 .and. numinit.le.9) then
+ write(noteq,'(i1,a1)') numinit,'}'
+ lnoten = 2
+ else
+ write(noteq,'(a1,i2,a2)')'{',numinit,'}}'
+ lnoten = 5
+ end if
+ tempq = tempq(1:ltemp)//noteq(1:lnoten)
+ ltemp = ltemp+lnoten
+ notexq = tempq
+ lnote = ltemp
+ end if
+ if (btest(nacc(ivx,ip),21)) then
+c
+c This is start of later segment of single-slope beam group so use slope and
+c height from prior beam. Slope is already OK.
+c
+ issb(ivx) = issb(ivx)+1
+ nolev1(ivx) = lev1ssb(ivx,issb(ivx))
+ end if
+c
+c Move this up to before indented beams for tremolo
+c lnote = 0
+ drawbm(ivx) = .true.
+ if (btest(irest(ivx,ipb1),28) .and. ixrest(ivx).ne.2) then
+ vxtup(ivx) = .true.
+ nxtinbm(ivx) = nxtinbm(ivx)+1
+c
+c irest(28)=>Xtup starts on this note. Set up for xtuplet.
+c Number goes on notehead side at middle note (or gap) of xtup, unless that
+c puts it in staff, then it flops to stem (or beam) side.
+c __ __
+c | | | O | |
+c O | | O
+c |___| O |__| |
+c
+c iud -1 -1 1 1 ...stem direction
+c iflop 0 1 -1 0 ...direction of flop
+c iup -1 1 -1 1 ...direction of number and bracket
+c
+ iud = 1
+ if (ulq(ivx,ibc) .eq. 'u') iud = -1
+c
+c Get ip#, note level of middle note (or gap) in xtup
+c
+ ipmid = ipb1+ntupv(ivx,nxtinbm(ivx))/2
+c
+c 130129 If middle note is a rest, go to next note. Note last note cannot
+c be a rest
+c
+14 continue
+ if (btest(irest(ivx,ipmid),0)) then
+ ipmid = ipmid+1
+ go to 14
+ end if
+ xnlmid = levrn(nolev(ivx,ipmid),irest(ivx,ipmid),iud,
+ * ncmid(iv,ipmid),iand(15,mult(ivx,ipmid))-8)
+ if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0) xnlmid = (xnlmid+
+ * levrn(nolev(ivx,ipmid-1),irest(ivx,ipmid-1),iud,
+ * ncmid(iv,ipmid-1),iand(15,mult(ivx,ipmid-1))-8))/2
+ iflop = 0
+ if (abs(xnlmid-ncmid(iv,ipb1)).lt.3.) iflop = -iud
+ iup = iud+2*iflop
+ if (btest(irest(ivx,ipb1),14)) then
+c
+c Alter iud, iflop, iup to flip number/bracket. (Stare at above pic)
+c
+ iup = -iup
+ iflop = 0
+ if (iud*iup .lt. 0) iflop = iup
+ end if
+c
+c Determine if a beam is to be drawn.
+c Had problem w/ half-note 2-note xtups always F, so add a test
+c
+ if (igetbits(irest(ivx,ipb1),2,3) .ne. 0) then
+ drawbm(ivx) = .true.
+ go to 6
+ end if
+ do 5 ipp = ibm1(ivx,ibc),ibm2(ivx,ibc)
+ if (iand(15,mult(ivx,ipp))-8 .le. 0) then
+ drawbm(ivx) = .false.
+ go to 6
+ end if
+5 continue
+ drawbm(ivx) = .not.btest(islur(ivx,ibm1(ivx,ibc)),18)
+6 continue
+c
+c Are we using tuplet.tex?
+c
+ usexnumt = cstuplet .and. .not.drawbm(ivx)
+c
+c Check for single note xtup 171217
+c
+ if (btest(irest(ivx,ipb1),28) .and. nnb.eq.1) then
+ drawbm(ivx) = .false.
+ end if
+c
+c Place xtup number if needed
+c
+ if (.not.btest(islur(ivx,ipb1),31) .or. multb.le.0) then
+ mprint = igetbits(nacc(ivx,ip),5,22)
+ if (mprint.eq.0) mprint=mtupv(ivx,nxtinbm(ivx))
+c Stab in the dark! Note: tried setting unbeam flag islur18 but no go.
+ if (nnb .eq. 1) then
+ xnlmid = nolev1(ivx)
+ islope(ivx) = 0
+c
+c Move up, outside number check block, so all 1-note xtups ar unbeamed
+c drawbm(ivx) = .false.
+c
+ end if
+ call putxtn(mprint,iflop,multb,iud,wheadpt,
+ * poenom,nolev1(ivx),islope(ivx),slfac,xnlmid,islur(ivx,ipb1),
+ * lnote,notexq,ncmid(iv,ipb1),nlnum,eloff(ivx,nxtinbm(ivx)),
+ * iup,irest(ivx,ipb1),mult(ivx,ipb1),usexnumt)
+ end if
+ if (.not.drawbm(ivx)) then
+c
+c Xtuplet with no beam
+c
+ if (.not.btest(islur(ivx,ipb1),31)) then
+c
+c Number printing has not been suppressed, so put in the bracket.
+c scale = stretch factor for bracket if there are asx's
+c xnsk = length of the bracket in \noteskips = (\elemskips)/(eon)
+c
+ xnsk = (eskz2(ivx,ipb1+ntupv(ivx,nxtinbm(ivx))-1)
+ * -eskz2(ivx,ipb1))/squez(ib)/feon(space(ib)/squez(ib))
+ if (iup .eq. 1) then
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'ovbkt'
+ else
+ notexq = sq//'ovbkt'
+ end if
+ else
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//sq//'unbkt'
+ else
+c
+c Introduced 12/5/98, req'd due to possible presence of in-line TeX
+c
+ notexq = sq//'unbkt'
+ end if
+ end if
+ lnote = lnote+6
+ if (iline.eq.1) then
+ smed = smed/(1.-fracindent)
+ end if
+ xslope = 1.8*smed*slfac
+ islope(ivx) = nint(xslope)
+ nolev1(ivx) = nlnum - nint(smed*eloff(ivx,1))
+ if (islope(ivx) .eq. 0) nolev1(ivx) = nolev1(ivx)-1
+ if (iup .eq. 1) nolev1(ivx) = nolev1(ivx)+4
+ levbracket = nolev1(ivx)
+ if (iup.eq.1 .and. cstuplet) levbracket = levbracket-1
+ call notefq(noteq,lnoten,levbracket,ncmid(iv,ipb1))
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
+ lnote = lnote+lnoten+1
+ if (xnsk .lt. 0.995) then
+ write(notexq(lnote+1:lnote+4),'(i1,f3.2)')0,xnsk
+ lnote = lnote+4
+ else if (xnsk .lt. 9.995) then
+ write(notexq(lnote+1:lnote+4),'(f4.2)')xnsk
+ lnote = lnote+4
+ else
+ write(notexq(lnote+1:lnote+5),'(f5.2)')xnsk
+ lnote = lnote+5
+ end if
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ if (btest(mult(ivx,ipb1),4)) then
+c
+c Tweak slope of bracket
+c
+ islope(ivx) = islope(ivx)+igetbits(mult(ivx,ipb1),5,5)-16
+ end if
+ if (islope(ivx).lt.0 .or. islope(ivx).ge.10) then
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ if (islope(ivx) .lt. -9) then
+ write(notexq(lnote+1:lnote+3),'(i3)')islope(ivx)
+ lnote = lnote+3
+ else
+ write(notexq(lnote+1:lnote+2),'(i2)')islope(ivx)
+ lnote = lnote+2
+ end if
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ else
+ write(notexq(lnote+1:lnote+1),'(i1)')islope(ivx)
+ lnote = lnote+1
+ end if
+c
+c Done with bracket
+c
+ end if
+ if (ixrest(ivx) .eq. 1) then
+c
+c Put in the rest. Possible problem: Rest is a spacing char, but between
+c beamstrt and beamn1 some non-spacing chars. are inserted.
+c
+c 130126 Deal with vertical shifts of rest starting xtuplet
+c
+ lrest = 3
+ if (btest(islur(ivx,ip),29)) then
+ restq = sq//'sk'
+c if (multb .eq. 0) then
+ else if (multb .eq. 0) then
+ restq = sq//'qp'
+ else if (.not.drawbm(ivx).and.multb.eq.1) then
+ restq = sq//'ds'
+ else if (.not.drawbm(ivx).and.multb.eq.2) then
+ restq = sq//'qs'
+ else if (.not.drawbm(ivx).and.multb.eq.3) then
+ restq = sq//'hs'
+ else
+ restq = sq//'hpause'
+ lrest = 7
+ end if
+ if (btest(nacc(ivx,ipb1),18) .and.
+ * btest(nacc(ivx,ipb1),19)) then
+c
+c VERY special case of rest at start of F-tuplet, needs dot
+c
+ restq = sq//'pt4'//restq(1:lrest)
+ lrest = lrest+4
+ end if
+
+ nole = mod(nolev(ivx,ip)+20,100)-20
+c if (nole .eq. 0) then
+ if (nole.eq.0 .or. btest(islur(ivx,ip),29)) then
+c
+c Rest blank or is not raised
+c
+ notexq = notexq(1:lnote)//restq
+ lnote = lnote+lrest
+ else
+ if (abs(nole) .lt. 10) then
+ tempq = chax(48+abs(nole))
+ ltemp = 1
+ else
+ write(tempq(1:2),'(i2)')abs(nole)
+ ltemp = 2
+ end if
+ if (nole .gt. 0) then
+ tempq = sq//'raise'//tempq(1:ltemp)//sq//'internote'
+ else
+ tempq = sq//'lower'//tempq(1:ltemp)//sq//'internote'
+ end if
+ ltemp = 16+ltemp
+ notexq = notexq(1:lnote)//tempq(1:ltemp)//restq(1:lrest)
+ lnote = lnote+ltemp+lrest
+ end if
+c
+c No need to come back through this subroutine (as would if rest starts bar
+c & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing.
+c
+ ixrest(ivx) = 0
+ end if
+ return
+ end if
+c
+c End if block for non-beamed xtup start...note we returned
+c
+ if (ixrest(ivx) .eq. 1) then
+c
+c Insert rest at start of beamed xtup. See above note for possible problem.
+c But first check if blank rest and if in forced beam (assuming xtuplet),
+c and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*'
+c
+ if (btest(islur(ivx,ip),29) .and. btest(ipl(ivx,ip),30)) then
+ nbrests = nbrests+1
+ writebrests = .false.
+ else
+ nodur(ivx,ipb1) = 2**(4-multb)
+ call notex(tempq,ltemp)
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//tempq(1:ltemp)
+ else
+ notexq = tempq(1:ltemp)
+ end if
+ lnote = lnote+ltemp
+ end if
+c
+c Re-zero just in case!
+c
+ nodur(ivx,ipb1) = 0
+ ibm1(ivx,ibc) = ibm1(ivx,ibc)+1
+c
+c See if next note is a non-rest
+c
+ if (.not.btest(irest(ivx,ipb1+1),0)) then
+ ixrest(ivx) = 2
+ else
+c
+c Suppress reprinting xtup number next time through beamstrt
+c
+ islur(ivx,ipb1+1) = ibset(islur(ivx,ipb1+1),31)
+c
+c Set new xtup start flag
+c
+ irest(ivx,ipb1+1) = ibset(irest(ivx,ipb1+1),28)
+ end if
+ return
+ end if
+ end if
+c
+c Just ended if block for xtups
+c
+ if (vxtup(ivx) .and. ipb1.eq.ibm2(ivx,ibc)) then
+c
+c Move actual note writing to beamend
+c
+ ixrest(ivx) = 4
+ return
+ end if
+ if (issb(ivx) .eq. 0) then
+c
+c 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed
+c
+ iadj = igetbits(ipl(ivx,ipb1),6,11)-30
+ if (iadj .ne. -30) then
+ nolev1(ivx) = nolev1(ivx)+iadj
+ do 2 isssb = 1 , nssb(ivx)
+ lev1ssb(ivx,isssb) = lev1ssb(ivx,isssb)+iadj
+2 continue
+ end if
+ iadj = igetbits(ipl(ivx,ipb1),6,17)-30
+ if (iadj .ne. -30) then
+ islope(ivx) = islope(ivx)+iadj
+ if (abs(islope(ivx)) .gt. 9) islope(ivx) = sign(9,islope(ivx))
+ if (nssb(ivx) .gt. 0) then
+c
+c Cycle thru non-rest notes in SSBG, looking for bmstrts.
+c
+ isssb = 0
+ do 4 inb = 2, nnb
+ if (btest(nacc(ivx,ipb(inb)),21)) then
+c
+c Beam segment start. New start level
+ isssb = isssb+1
+ lev1ssb(ivx,isssb) =
+ * lev1ssb(ivx,isssb)+islope(ivx)*xelsk(inb)/slfac
+ end if
+4 continue
+ end if
+ end if
+ end if
+ iadj = igetbits(islur(ivx,ipb1),2,27)
+ addbrack = .false.
+ if (btest(ipl(ivx,ipb1),30)) then
+c
+c Check for altered starting polarity. Only in forced beams. Nominal start
+c level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.).
+c
+ if (ulq(ivx,ibc).eq.'u' .and.
+ * nolev1(ivx)+6.lt.nolev(ivx,ipb1)) then
+ if (lnote .eq. 0) then
+ notexq = sq//'loff{'
+ else
+ notexq = notexq(1:lnote)//sq//'loff{'
+ end if
+ lnote = lnote+6
+ addbrack = .true.
+ else if (ulq(ivx,ibc).eq.'l' .and.
+ * nolev1(ivx)-6.gt.nolev(ivx,ipb1)) then
+ if (lnote .eq. 0) then
+ notexq = sq//'roff{'
+ else
+ notexq = notexq(1:lnote)//sq//'roff{'
+ end if
+ lnote = lnote+6
+ addbrack = .true.
+ end if
+c
+c Check end level for possible flipping in forced beam. Have to do it
+c here since with multiple voices, xelsk will not be preserved.
+c
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') then
+ bmlev = nolev1(ivx)+6+islope(ivx)*xelsk(nnb)/slfac
+ flipend(ivx) = bmlev.lt.nolev(ivx,ibm2(ivx,ibc))
+ else if (ulq(ivx,ibmcnt(ivx)) .eq. 'l') then
+ bmlev = nolev1(ivx)-6+islope(ivx)*xelsk(nnb)/slfac
+ flipend(ivx) = bmlev.gt.nolev(ivx,ibm2(ivx,ibc))
+ end if
+ end if
+ multbb = multb+iadj
+c
+c Tremolo starting?
+c
+ if (btest(irest(ivx,ipb1),2)) multbb =
+ * igetbits(irest(ivx,ipb1),2,3)
+ call ntrbbb(multbb,'i',ulq(ivx,ibc),ivx,notexq,lnote)
+c
+c Put in name of start level and slope, after correcting nolev1 if xtup
+c started with a rest.
+c
+ if (ixrest(ivx).eq.2) nolev1(ivx) =
+ * nint(nolev1(ivx)+xelsk(1)*islope(ivx)/slfac)
+c
+c Add adjustment nvtrem to main beam to account for tremolo indented beams
+c
+ call notefq(noteq,lnoten,nolev1(ivx)+nvtrem,ncmid(iv,ipb1))
+ if (islope(ivx) .lt. 0) then
+ notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
+ lnote = lnote+4+lnoten
+ write(notexq(lnote-2:lnote),'(i2,a1)')islope(ivx),'}'
+ else
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+1+lnoten
+ write(notexq(lnote:lnote),'(i1)')islope(ivx)
+ end if
+c
+c Check for beam-thk fine-tuning
+c
+ if (iadj .gt. 0) then
+ do 1 imp = multb+iadj , multb+1 , -1
+ call ntrbbb(imp,'t',ulq(ivx,ibc),ivx,notexq,lnote)
+1 continue
+ end if
+c
+c If we shifted, must close with right bracket
+c
+ if (addbrack) then
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+c
+c Add in \sk's for very special case of staff-crossing xtup chords
+c Assumes we are in lower (first) voice of up-to-both beamed xtup
+c that starts with blank rests (notes in upper voice here).
+c
+ if (nbrests.gt.0 .and. writebrests) then
+ do 7 isk = 1 , nbrests
+ notexq = notexq(1:lnote)//chax(92)//'sk'
+ lnote = lnote+3
+7 continue
+ nbrests = 0
+ end if
+c
+c Get 'floor' zmin for figures
+c Note: Will not come thru here on 1st note of unbeamed xtup, so figure height
+c won't be adjusted. If anyone ever needs that, need to duplicate this
+c functionality up above, before exiting.
+c
+ if (figbass .and. (ivx.eq.1 .or. ivx.eq.ivxfig2)) then
+ if (ivx .eq. 1) then
+ ivf = 1
+ else
+ ivf = ivxfig2
+ end if
+ zmult = 1.2*(multb-1)
+ ymin = 100.
+ do 3 inb = 1, nnb
+ if (isfig(ivf,ipb(inb))) then
+ if (ulq(iv,ibc) .eq. 'u') then
+ ybot = nolev(iv,ipb(inb))
+ else
+ ybot = islope(ivx)/slfac*xelsk(inb)+nolev1(ivx)
+ * -stemlen-zmult
+ end if
+ ymin = min(ymin,ybot)
+ end if
+3 continue
+ maxdrop = ncmid(iv,ipb1)-4-ymin+5.01
+ ifigdr(ivf,iline) = max(ifigdr(ivf,iline),maxdrop)
+ end if
+c
+c Compute ornament levels if needed
+c
+ NomOrnLev = ncmid(iv,ipb1)+5
+ iorn = 0
+ do 8 inb = 1 , nnb
+ ip = ipb(inb)
+ if (.not.btest(iornq(ivx,ip),23)) go to 8
+ if (btest(irest(ivx,ip),26) .and. ulq(ivx,ibc).eq.'l') then
+c
+c letter-dynamic or hairpin ending under down-beamed
+c
+ iorn = iorn+1
+ ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
+ * -1.2*(multb-1)
+ ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
+ else if (.not.btest(ipl(ivx,ip),10)) then
+c
+c Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F
+c 15: Trill w/o "tr", was U , 16-18 Editorial s,f,n , 19-21 TBD
+c
+c Non-chord. There IS an ornament. Need ihornb only if upbeam, and if
+c ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.)
+c
+ if (ulq(ivx,ibc).eq.'u' .and.
+ * iand(iornq(ivx,ipb(inb)),4163566).gt.0) then
+ iorn = iorn+1
+ iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
+ ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
+ * +1.2*(multb-1)
+ ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
+ end if
+ else
+c
+c In a chord. Orn may be on main note or non-main or both. Set ihornb if
+c upbeam and highest note has orn, or down beam and lowest. Find 1st chord note
+c
+ do 10 icrd1 = 1 , ncrd
+ if (iand(255,icrdat(icrd1)) .eq. ip .and.
+ * iand(15,ishft(icrdat(icrd1),-8)) .eq. ivx) go to 11
+10 continue
+11 continue
+c
+c Find outermost note, min or max depending on beam direction ulq. xto is true
+c if there's an ornament on that note. Expand orn list to include ._, since if
+c on extreme chord note in beam, will move.
+c So ornaments are all except 0,4,13 (,g,)
+c
+ levx = nolev(ivx,ip)
+ xto = iand(iornq(ivx,ipb(inb)),4186094).gt.0
+ icrdx = 0
+ do 12 icrd = icrd1 , ncrd
+ if (iand(255,icrdat(icrd)) .ne. ip .or.
+ * iand(15,ishft(icrdat(icrd),-8)) .ne. ivx) go to 13
+ levc = iand(127,ishft(icrdat(icrd),-12))
+ if ((ulq(ivx,ibc).eq.'u'.and.levc.gt.levx) .or.
+ * (ulq(ivx,ibc).eq.'l'.and.levc.lt.levx)) then
+ levx = levc
+ icrdx = icrd
+ xto = iand(icrdorn(icrd),4186094).gt.0
+ end if
+12 continue
+13 continue
+c
+c If there's orn on extreme note, do stuff
+c
+ if (xto) then
+ iorn = iorn+1
+ if (ulq(ivx,ibc) .eq. 'u') then
+ ybeam = nolev1(ivx)+stemlen+islope(ivx)*xelsk(inb)/slfac-1
+ * +1.2*(multb-1)
+ ihornb(ivx,iorn) = max(nint(ybeam+3.),NomOrnLev)
+ else
+ ybeam = nolev1(ivx)-stemlen+islope(ivx)*xelsk(inb)/slfac+1
+ * -1.2*(multb-1)
+ ihornb(ivx,iorn) = min(nint(ybeam-3.),NomOrnLev-10)
+ end if
+ if (icrdx .eq. 0) then
+c
+c Affected ornament is on main note
+c
+ iornq(ivx,ip) = ibset(iornq(ivx,ip),22)
+ else
+ icrdorn(icrdx) = ibset(icrdorn(icrdx),22)
+ end if
+ end if
+ end if
+8 continue
+c
+c Henceforth nornb will be a counter.
+c
+ if (iorn .gt. 0) nornb(ivx)=1
+ if (ixrest(ivx) .eq. 2) ixrest(ivx) = 0
+ return
+ end
+ block data
+ parameter (nm=24)
+ common /comtol/ tol
+ common /comtrans/ cheadq
+ common /compage/ widthpt,ptheight,hoffpt,voffpt,
+ * nsyst,nflb,ibarflb(0:40),
+ * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
+ * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
+ * nistaff(0:40)
+ common /cblock/
+ * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
+ * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
+ common /cominbot/ inbothd
+ logical usefig
+ common /comstart/ facmtr
+ character*60 cheadq
+ character*120 instrq,titleq,compoq
+ logical headlog
+ common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
+ * inhead
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+ common /combmh/ bmhgt,clefend
+ common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
+ * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
+ * idynda2(99),levhssav(nm),listcresc,listdecresc
+ character*128 txtdynq
+ logical kbdrests
+ common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /comsize/ isize(nm)
+c
+ data tol /.001/
+ data cheadq
+ * /' '/
+ data gslfac /9./
+ data instrq,titleq,compoq,headlog /3*' ',.false./
+c
+c meter space (pts) = xb4mbr = musicsize*facmtr
+c
+ data facmtr /0.55/
+ data grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,clefend,bmhgt
+ * / 1.3333,.4 , .7 , .3 , 0.2 , 2.0 , 1.0 ,
+ * .7,.7 ,.9 ,.5 ,2.3 ,1.1 /
+ data rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,arpfac
+ * / 1.32 , 2.25 , 0.47 , 0.83 , 0.17 , 0.5 , 1.7 /
+ data rtshfac / 1.0 /
+ data isize /nm*0/
+c
+c From other
+c
+ data ptheight,widthpt,hoffpt,voffpt,
+ * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
+ * xilbn,xilbtc,xilhdr,xilfig,a,b,inbothd,inhnoh
+ * / 740. , 524. , 0., 0.,
+ * .50 , .25 , 0.4 , 0.4 , 0.2 , 12. ,21. , 12.,
+ * 4 , 1.6 ,5.,5.7,1.071,2.714,16 ,16 /
+ data fracsys /30*0./
+ data ivowg,hoh1,hoh2,hoh2h1 /0,0,0,0,0,1,1,1,1,1,1,1,
+c * 2.0,1.5,1.0,0.5,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
+ * 2.2,1.7,1.2,0.7,1.3,1.3,0.4,0.8,1.2,0.8,1.2,1.6,
+ * -2.7,-2.2,-1.7,-1.2,-2.3,-2.1,-1.0,-1.7,-2.1,-1.6,-1.9,-2.3,
+ * -0.3,0.3 /
+ data kbdrests /.false./,
+ * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/
+ data EarlyTransOn, LaterInstTrans /2*.false./
+ data iInstTrans /nm*0/
+ data iTransAmt /nm*0/
+ end
+ subroutine catspace(space,squez,nnsk)
+ parameter (nkb=3999,maxblks=9600)
+ common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
+ * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
+ * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
+ common /comtol/ tol
+ do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1
+ if (abs(space-durb(iptr)) .lt. tol) then
+ if (abs(squez-sqzb(iptr)) .lt. tol) then
+c
+c Increment pre-existing entry
+c
+ nnpd(iptr) = nnpd(iptr)+nnsk
+ return
+ end if
+ end if
+16 continue
+c
+c Didn't find current duration & squez, so add a new entry.
+c No particular reason to keep in order, so add at the end.
+c
+ nnpd(nptr(ibarcnt+1)) = nnsk
+ durb(nptr(ibarcnt+1)) = space
+ sqzb(nptr(ibarcnt+1)) = squez
+ nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
+ return
+ end
+ character*1 function chax(n)
+c
+c The only reason for this seemingly do-nothing function is to get around an
+c apparent bug in the Visual Fortran Standard Edition 5.0.A compiler!
+c
+ chax = char(n)
+ return
+ end
+ subroutine checkdyn(lineq,iccount,ibar)
+ character*128 lineq
+ character*1 durq,chax
+ character*4 dynsymq
+ logical txtdyn
+ txtdyn = .false.
+c
+c On entry, iccount is on "D"
+c
+ if (lineq(iccount+1:iccount+1) .eq. chax(34)) then
+c
+c Dynamic text
+c
+
+ istart = iccount+2 ! 1 past 1st quote
+3 continue
+ iend = index(lineq(istart:128),chax(34))
+ if (lineq(istart+iend-2:istart+iend-2) .eq. chax(92)) then
+ istart = iccount+iend+2
+ go to 3
+ end if
+ if (iend .eq. 0) then
+ call errmsg(lineq,iccount+1,ibar,
+ * 'Dynamic text must be terminated with double quote!')
+ call stop1()
+ end if
+c
+c Set iccount to character after 2nd ", and set ipm
+c
+c iccount = iccount+iend+2
+ iccount = istart+iend
+ ipm = index('- +',lineq(iccount:iccount))
+ if (ipm .eq. 0) then
+ call errmsg(lineq,iccount,ibar,
+ * 'Expected "-", "+", or blank here!')
+ call stop1()
+ end if
+ else
+c
+c Expect ordinary dynamic
+c
+ do 1 iend = iccount+2 , 128
+ ipm = index('- +',lineq(iend:iend))
+ if (ipm .gt. 0) go to 2
+1 continue
+2 continue
+ if (iend-iccount.gt.5 .or. iend-iccount.lt.2) then
+ call errmsg(lineq,iend-1,ibar,
+ * 'Wrong length for dynamic mark!')
+ call stop1()
+ end if
+ read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
+ * dynsymq
+ idno = (index(
+ * 'ppppppp pp p mp mf f fp sfz ff fff ffff< > ',
+ * dynsymq)+3)/4
+ if (idno .eq. 0) then
+ call errmsg(lineq,iccount+1,ibar,'Illegal dynamic mark!')
+ call stop1()
+ end if
+ iccount = iend
+ end if
+ if (ipm .ne. 2) then
+c
+c There is a vertical shift, have "+" or "-"
+c
+ iccount = iccount+1
+ if (index('0123456789',lineq(iccount:iccount)) .eq. 0) then
+ call errmsg(lineq,iccount,ibar,
+ * 'Expected integer here for vertical offset!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ idno = nint(fnum)
+ if (idno .gt. 63) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Vertical offset for dynamic mark must be (-63,63)!')
+ call stop1()
+ end if
+ ipm = index('- +',durq)
+ if (ipm .eq. 0) then
+ call errmsg(lineq,iccount,ibar,
+ * 'Expected "+", "-", or blank here!')
+ call stop1()
+ end if
+ if (ipm .ne. 2) then
+c
+c There is a horizontal shift
+c
+ iccount = iccount+1
+ if (index('.0123456789',lineq(iccount:iccount)) .eq. 0) then
+ call errmsg(lineq,iccount,ibar,
+ * 'Expected number here for horizontal offset!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ idno = nint(10*fnum)
+ if (idno .gt. 255) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Horizontal offset for dynamic mark must be (-25.5,25.5)!')
+ call stop1()
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibar,
+ * 'There should be a blank here!')
+ call stop1()
+ end if
+ end if
+c
+c iccount should be on the blank at the end of the entire symbol
+c
+ end if
+ return
+ end
+ subroutine chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
+c subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp,
+c * icashft)
+ logical found1,iscacc,isarp,btest
+ integer icrdat(193)
+ found1 = .false.
+c
+c icashft will be max left shift of accid's in chord notes.
+c Used only for spacing checks.
+c Will include left shift of chord note itself.
+c Rezero after use.
+c
+ do 18 icrd = 1 , ncrd
+c
+c This if block cycles thru all chord notes on ivx,ip; then returns.
+c
+ if (iand(255,icrdat(icrd)) .eq. ip .and.
+ * iand(15,ishft(icrdat(icrd),-8)) .eq. ivx) then
+ found1 = .true.
+ iscacc = iscacc .or.
+ * (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27))
+c
+c Accid on this chord note, and it's not midi-only.
+c
+c irshft = igetbits(icrdot(icrd),7,20)
+cc
+cc Include increment for notehead shift
+cc
+c if (btest(icrdat(icrd),23)) then
+c if (irshft .eq. 0) then
+c irshft = 44
+c else
+c irshft=irshft-20
+c end if
+c end if
+c if (irshft .ne. 0) then
+cc
+cc Accid on chord note is shifted. Include only left shift, in 20ths.
+cc
+c if (irshft .lt. 64) icashft = max(icashft,64-irshft)
+c end if
+c end if
+ isarp = isarp .or. btest(icrdat(icrd),25)
+ else if (found1) then
+ return
+ end if
+18 continue
+ return
+ end
+ subroutine chkimidi(icm)
+ parameter (nm=24,mv=24576)
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ if (imidi(icm) .ge. mv) then
+ print*
+ print*,'Midi file is too long! It will be corrupted or worse'
+ write(*,'(a6,2x,4i8)')
+ * 'imidi:',imidi(0),imidi(1),imidi(2),imidi(3)
+ end if
+ return
+ end
+ subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx,
+c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult)
+ * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl)
+ parameter (nm=24)
+ integer*4 nn(nm),islur(nm,200),irest(nm,200),
+ * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8),
+ * ivmx(nm,2),mult(nm,200),ipl(nm,200)
+c
+c On 130127 put this code, formerly in make2bar right before calling notex for
+c a single note/rest, into this subroutine, so the same logic could also be
+c with the calls to beamstrt/mid/end to adjust height of rests in xtups if the
+c keyboard rest option is selected
+c
+c mode=1 if called as before, 2 if for an xtup. Only affects check for
+c quarter rests, which will fix later.
+c
+c Get reference level: next following note if no intervening blank rests,
+c otherwise next prior note. Relative to bottom line.
+c
+c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then
+ if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then
+c
+c Not the last note and not "look-left" for level
+c
+ do 8 kkp = ip+1 , nn(ivx)
+ if (btest(islur(ivx,kkp),29)) go to 4
+ if (.not.btest(irest(ivx,kkp),0)) then
+ levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
+ go to 9
+ end if
+8 continue
+ end if
+4 continue
+c
+c If here, there were no following notes or came to a blank rest, or
+c "look-left" option set. So look before
+c
+c if (ip .eq. 1) go to 2 ! Get out if this is the first note.
+ if (ip .eq. 1) return ! Get out if this is the first note.
+ do 3 kkp = ip-1, 1, -1
+ if (.not.btest(irest(ivx,kkp),0)) then
+ levnext = nolev(ivx,kkp)-ncmid(iv,kkp)+4 ! Relative to bottom line
+ go to 9
+ end if
+3 continue
+c go to 2 ! Pretty odd, should never be here, but get out if so.
+ return ! Pretty odd, should never be here, but get out if so.
+9 continue
+c
+c Find note in other voice at same time
+c
+ iupdown = sign(1,ivx-nv-1)
+ ivother = ivmx(iv,(3-iupdown)/2)
+ tother = 0.
+ do 5 kkp = 1 , nib(ivother,ibar)
+ if (abs(tother-tnow) .lt. tol) go to 6
+ tother = tother+nodur(ivother,kkp)
+5 continue
+c
+c If here, then no note starts in other voice at same time, so set default
+c
+ levother = -iupdown*50
+ go to 7
+6 continue
+c
+c If here, have just identified a simultaneous note or rest in other voice
+c
+ if (.not.btest(irest(ivother,kkp),0)) then ! Not a rest, use it
+ levother = nolev(ivother,kkp)-ncmid(iv,ip)+4
+ else
+ if (nodur(ivother,kkp) .eq. nodur(ivx,ip)) then
+c
+c Rest in other voice has same duration, get out (so defualt spacing is used)
+c
+c go to 2
+ return
+ end if
+ levother = -iupdown*50
+ end if
+7 continue
+ if (mode.eq.1) then
+ indxr = log2(nodur(ivx,ip))+1
+ else
+c nodu = 2**(4-(iand(mult(ivx,ip),15)-8))
+ indxr = 4-(iand(mult(ivx,ip),15)-8)+1
+ end if
+ if (iupdown .lt. 0) then
+ levtop = levtopr(indxr)
+ iraise1 = levother-levtop-3 ! Based on other note
+ iraise2 = levnext-levtop ! Based on following note
+ if (indxr.eq.5 .and. levnext.lt.1) iraise2=iraise2+2
+ iraise = min(iraise1,iraise2)
+ if (mod(iraise+50,2).eq.1 .and.
+ * iraise+levtop.gt.-1) iraise = iraise-1
+ else
+ levbot = levbotr(indxr)
+ iraise1 = levother-levbot+3
+ iraise2 = levnext-levbot
+ if (indxr.eq.5 .and. levnext.gt.8) iraise2=iraise2-1
+ iraise = max(iraise1,iraise2)
+ if (mod(iraise+50,2).eq.1 .and.
+ * iraise+levbot.le.9) iraise = iraise-1
+ end if
+ nolev(ivx,ip) = 100+iraise
+ return
+ end
+ subroutine chklit(lineq,iccount,literr)
+ character*128 lineq
+ character*1 charq,chax
+ literr = 0
+ itype = 1
+17 call g1etchar(lineq,iccount,charq)
+ if (charq .eq. chax(92)) then
+ itype = itype+1
+ if (itype .gt. 3) then
+ literr = 1
+ return
+ end if
+ go to 17
+ end if
+ lenlit = itype
+18 call g1etchar(lineq,iccount,charq)
+ if (charq.eq.chax(92)) then
+ call g1etchar(lineq,iccount,charq)
+ if (charq .ne. ' ') then
+c
+c Starting a new tex command withing the string
+c
+ lenlit = lenlit+2
+ if (lenlit .gt. 128) then
+ literr = 2
+ return
+ end if
+ go to 18
+ end if
+ else
+ lenlit = lenlit+1
+ if (lenlit .gt. 128) then
+ literr = 2
+ return
+ end if
+ go to 18
+ end if
+ return
+ end
+ subroutine chkpm4ac(lineq,iccount,nacc,moved)
+c
+c Called after getting +/-/</> in a note (not rest). iccount is on the +-<>.
+c Sets moved=.true. and sets move parameters in nacc if necc: horiz only (bits
+c 10-16) if < or >, horiz and vert (bits 4-9) if two consecutive signed
+c numbers. If moved=.true., iccount on exit is on end of last number.
+c If moved=.false., iccount still on +/-
+c
+ logical moved,ishorz
+ character*128 lineq
+ character*1 durq
+ if (index('sfnA',lineq(iccount-1:iccount-1)).gt.0 .and.
+ * index('0123456789.',lineq(iccount+1:iccount+1)).gt.0) then
+c
+c Prior char was accid & next is #; this may be start of accidental shift.
+c Must test for "." above in case we get "<" or ">"
+c
+ ipm = index('- +< >',lineq(iccount:iccount))-2
+ if (lineq(iccount+1:iccount+1).eq.'.' .and.
+ * index('0123456789',lineq(iccount+2:iccount+2)).eq.0) then
+c
+c Rare case of [accid][+/-].[letter]. Bail out
+c
+ moved = .false.
+ return
+ end if
+ ishorz = ipm .gt. 1
+c
+c Save iccount in case it's not accid shift and we have to reset.
+c
+ icsav = iccount
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (ishorz .or. index('+-',durq).gt.0) then
+c
+c This has to be accidental shift. Set vert. shift.
+c
+ if (.not.ishorz) then
+c
+c +/- syntax, both shifts set, vertical first
+c
+ call setbits(nacc,6,4,int(ipm*fnum+32.5))
+ ipm = index('- +',durq)-2
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ else
+c
+c </> syntax, only horiz set
+c
+ ipm = ipm-3
+ end if
+c
+c Set horiz. shift
+c
+ call setbits(nacc,7,10,nint(20*(ipm*fnum+5.35)))
+ iccount = iccount-1
+ moved = .true.
+ else
+c
+c False alarm. Reset everything and flow onward
+c
+ moved = .false.
+ iccount = icsav
+ end if
+ else
+c
+c Either prior char was not 'sfn' or next was not digit, so take no action
+c
+ moved = .false.
+ end if
+ return
+ end
+ subroutine clefsym(isl,notexq,lnote,nclef)
+c
+c Returns string calling Don's TeX macro \pmxclef, for drawing small clefs.
+c
+ character*(*) notexq
+ character*1 chax
+ nclef = iand(ishft(isl,-12),7)
+ if (nclef .eq. 0) then
+c
+c treble
+c
+ nlev = 2
+ else if (nclef .gt. 6) then
+c
+c French violin
+c
+ nlev = 0
+ else if (nclef .lt. 5) then
+c
+c C-clef
+c
+ nlev = 2*nclef-2
+ else
+c
+c F-clef
+c
+ nlev = 2*nclef-6
+ end if
+ notexq = chax(92)//'pmxclef'//chax(48+min(nclef,7))
+ * //chax(48+nlev)
+ lnote = 10
+ return
+ end
+ subroutine crdacc(nacc,naccid,micrd,nolevm,rmsshift,lasttime,
+ * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
+c
+c nacc = accidental bitmap for main note
+c naccid = # of accid's in chord
+c micrd = array with icrd #'s for notes w/ acc's, 0=>main note
+c nolevm = level of main note
+c segrb(1|2,.) x|y-coord of right-bdry segment
+c ksegrb(.) internal use; tells what defined this segment
+c -2: Left-shifted notehead
+c -1: Original right boundary
+c 0: Main note accidental
+c icrd: Chord-note accidental
+c isetshft(i),i=1,naccid: what set shift for this accid, same codes
+c icrdot0 = top-down level-rank of main note among accid-notes
+c icrdot(icrd)(27-29) = level rank of chord-note among accid-notes
+c twooftwo will be true 2nd time thru; signal to store shifts w/ notes
+c
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ real*4 segar(5,2,6),segal(5,2,6),segrb(2,50),segrb0(2,50)
+ integer*4 nsegar(5),nsegal(5),micrd(10),iacctbl(6),ksegrb(50),
+ * isetshft(10),ksegrb0(50)
+ logical lasttime,mainnote,twooftwo
+ data nsegar / 3,4,3,3,2 /, nsegal / 2,4,3,3,2 /
+ data segar /
+c
+c Fancy sharp boundary. fl,sh,na,dfl,dsh
+c
+ * -0.05,-0.38,-0.34,-.05, -.15,-1.4,-2.9,-3.0, -1.4, -1.2,
+c * -0.75,-0.20,-0.80, 0. , 0. , .96,-1.04,1.6, 0. , 0. ,
+c meas value for y, natural is 1.6
+ * -0.75,-0.20,-0.80,-.75, 0. , .96,-1.04,1.48, .96, 1.2,
+ * 0.00,-0.38, 0.00, 0. , 0. ,3.15, 1.64,3.0, 3.15, 0. ,
+ * 0. , 0.00, 0. , 0. , 0. , 0. , 2.90, 0. , 0. , 0. ,
+ * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. ,
+ * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. /
+ data segal /
+c * 0.00, 0.00,-1.04, 0. , 0. ,3.15, 2.9,-1.6, 0. , 0. ,
+cc (meas. value is 3.08) ^^^^
+cc Raise top of flat so it interferes with bottom of sharp
+ * -1.00,-1.02,-0.60,-1.65, -1.2,-1.4,-2.9, -3.0, -1.4, -1.2,
+ * 0.00,-1.20,-1.04, 0. , 0. ,3.15,-1.64,-1.48,3.15, 1.2,
+ * 0. ,-1.02, 0.00, 0. , 0. , 0. , 1.04, 3.0, 0. , 0. ,
+ * 0. , 0.00, 0. , 0. , 0. , 0. , 2.9 , 0. , 0. , 0. ,
+ * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. ,
+ * 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. , 0. /
+c
+c iacctbl(i) = internal accid # (1-5) when i=extern accid # (1,2,3,5,6)
+c
+ data iacctbl / 1 , 2 , 3 , 0 , 4 , 5 /
+c
+c Set up barrier segrb(iseg,ipoint) to define coords of corner points
+c on stem+notes
+c
+ do 11 iseg = 1 , nsegrb0
+ segrb(1,iseg) = segrb0(1,iseg)
+ segrb(2,iseg) = segrb0(2,iseg)
+ ksegrb(iseg) = ksegrb0(iseg)
+11 continue
+ nsegrb = nsegrb0
+ rmsshift = 0.
+ shiftmin = 1000.
+ do 1 iwa = 1 , naccid
+c
+c Initialize shift for this note
+c
+ shift = 0.
+ mainnote = micrd(iwa).eq.0
+ isetshft(iwa) = -1
+c
+c Get note level and accidental type
+c
+ if (mainnote) then
+ nolev = nolevm
+ iacctype = iacctbl(igetbits(nacc,3,0))
+ else
+ nolev = igetbits(icrdat(micrd(iwa)),7,12)
+ iacctype = iacctbl(igetbits(icrdat(micrd(iwa)),3,20))
+ end if
+c
+c Cycle thru segments on right edge of this accidental
+c
+ do 2 isega = 1 , nsegar(iacctype)-1
+ ybotaseg = nolev+segar(iacctype,2,isega)
+ ytopaseg = nolev+segar(iacctype,2,isega+1)
+c
+c Cycle thru segments of right-hand barrier
+c
+ do 3 isegrb = 1 , nsegrb-1
+c
+c Must find all barrier segments that start below ytopseg & end above ybotseg
+c
+ if (segrb(2,isegrb) .lt. ytopaseg) then
+c
+c Barrier seg starts below top of accid
+c Check if barrier seg ends above bottom of accid
+c
+ if (segrb(2,isegrb+1) .gt. ybotaseg) then
+ if (shift .gt.
+ * segrb(1,isegrb)-segar(iacctype,1,isega)) then
+ shift = segrb(1,isegrb)-segar(iacctype,1,isega)
+c
+c Record the cause of the shift
+c
+ isetshft(iwa) = ksegrb(isegrb)
+ end if
+ end if
+c
+c Does barrier segment end above top of accid seg?
+c
+ if (segrb(2,isegrb+1) .gt. ytopaseg) go to 4
+ end if
+3 continue
+4 continue
+2 continue
+ if (.not.btest(nacc,28) .and. abs(shift).gt.0.0001
+ * .and. .not.lasttime) then
+c if (nolev .eq. levmaxacc) then
+ if (nolev.eq.levmaxacc .and. isetshft(iwa).eq.-1) then
+ rmsshift = 1000.
+ return
+ end if
+c
+c Does the following properly account for left-shifted noteheads?
+c
+c Top-down rank of this note we just shifted
+c
+ if (mainnote) then
+ irank = icrdot0
+ else
+ irank = igetbits(icrdot(micrd(iwa)),3,27)
+ end if
+c
+c Compare level-rank of this note vs. that of note that caused the shift.
+c This has effect of checking for basic interferences from top down.
+c
+c ksegrb(.) internal use; tells what defined this segment
+c -2: Left-shifted notehead
+c -1: Original right boundary
+c 0: Main note accidental
+c icrd: Chord-note accidental
+c isetshft(i),i=1,naccid: what set shift for this accid, same codes
+c
+ if (isetshft(iwa) .lt. 0) then
+ iranksetter = 0
+ else if (isetshft(iwa) .eq. 0) then
+ iranksetter = icrdot0
+ else
+ iranksetter = igetbits(icrdot(isetshft(iwa)),3,27)
+ end if
+ if (iranksetter.ne.0 .and. irank.ne.iranksetter+1) then
+ rmsshift = 1000.
+ return
+ end if
+ end if
+ rmsshift = rmsshift+shift**2
+ if (lasttime .and. abs(shift).gt..0001) then
+ if (mainnote) then
+ if (.not.btest(nacc,29)) go to 10
+ else
+ if (.not.btest(icrdat(micrd(iwa)),29)) go to 10
+ end if
+c
+c If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there
+c was a manual shift but auto-shift was zero, will not come thru here, but shift value
+c will be left intact.
+c
+ if (mainnote) then
+ shift = shift+.05*(igetbits(nacc,7,10)-107)
+ else
+ shift = shift+.05*(igetbits(icrdot(micrd(iwa)),7,20)-107)
+ end if
+10 continue
+ if (twooftwo) then
+c
+c Record the shift for this accidental
+c
+ if (shift .lt. -5.35) then
+ call printl(' ')
+ call printl('WARNING: auto-generated accidental '//
+ * 'shift too big for PMX, ignoring')
+ else
+ ishift = nint(20*(shift+5.35))
+ if (mainnote) then
+ call setbits(nacc,7,10,ishift)
+ else
+ call setbits(icrdot(micrd(iwa)),7,20,ishift)
+ end if
+ end if
+ else
+c
+c This is the earlier call to precrd, so need minimum shift
+c
+ shiftmin = min(shiftmin,shift)
+ end if
+ end if
+c
+c Bail out if this is the last accidental to check
+c
+ if (iwa .eq. naccid) go to 1
+c
+c Add this accidental to the right barrier! Count down from highest barrier segment,
+c find 1st one starting below top of accid, and first one starting below bot.
+c
+ do 5 ibelowtop = nsegrb , 1 , -1
+ if (segrb(2,ibelowtop) .lt.
+ * nolev+segal(iacctype,2,nsegal(iacctype))) then
+ do 9 ibelowbot = ibelowtop , 1 , -1
+ if (segrb(2,ibelowbot) .lt.
+ * nolev+segal(iacctype,2,1)) go to 6
+9 continue
+ print*,'Oops2!'
+ call stop1()
+ end if
+5 continue
+ print*,'Ugh0! in crdaccs'
+ call stop1()
+6 continue
+ netgain = nsegal(iacctype)-ibelowtop+ibelowbot
+c
+c Shift high segments up
+c
+ if (netgain .ge. 0) then
+ do 7 isegrb = nsegrb , ibelowtop+1 , -1
+ segrb(1,isegrb+netgain) = segrb(1,isegrb)
+ segrb(2,isegrb+netgain) = segrb(2,isegrb)
+ ksegrb(isegrb+netgain) = ksegrb(isegrb)
+7 continue
+c
+c Set up 1st segment above accid
+c
+ segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
+ segrb(2,ibelowtop+netgain) =
+ * nolev+segal(iacctype,2,nsegal(iacctype))
+ ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
+ else
+c
+c netgain<0, must remove segments. Use same coding but reverse order,
+c work from bottom up
+c
+ segrb(1,ibelowtop+netgain) = segrb(1,ibelowtop)
+ segrb(2,ibelowtop+netgain) =
+ * nolev+segal(iacctype,2,nsegal(iacctype))
+ ksegrb(ibelowtop+netgain) = ksegrb(ibelowtop)
+ do 12 isegrb = ibelowtop+1 , nsegrb
+ segrb(1,isegrb+netgain) = segrb(1,isegrb)
+ segrb(2,isegrb+netgain) = segrb(2,isegrb)
+ ksegrb(isegrb+netgain) = ksegrb(isegrb)
+12 continue
+ end if
+c
+c Insert new segments
+c
+ do 8 isega = 1 , nsegal(iacctype)-1
+ segrb(1,ibelowbot+isega) = shift+segal(iacctype,1,isega)
+ segrb(2,ibelowbot+isega) = nolev+segal(iacctype,2,isega)
+ if (mainnote) then
+ ksegrb(ibelowbot+isega) = 0
+ else
+ ksegrb(ibelowbot+isega) = micrd(iwa)
+ end if
+8 continue
+c
+c Update number of barrier segments
+c
+ nsegrb = nsegrb+netgain
+cc
+cc Temporary printout for boundary segments as built up
+cc
+c write(15,'()')
+c write(15,'(a/(2f8.2,i5))')' y x kseg',
+c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
+c write(15,'(a/(2i5))')' micrd isetshft',
+c * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa)
+cc
+1 continue ! next accidental
+ if (lasttime .and. .not.twooftwo) then
+c
+c This is the final call on the pre-ask pass, so compute left-shift rqmt.
+c
+ icashft = nint(-20*shiftmin)
+ end if
+cc
+cc Temporary printout for boundary segments
+cc
+c if (twooftwo) then
+c write(15,'()')
+c write(15,'(a/(2f8.2,i5))')' y x kseg',
+c * (segrb(2,iseg),segrb(1,iseg),ksegrb(iseg),iseg=1,nsegrb)
+c write(15,'(a/(2i5))')' micrd isetshft',
+c * (micrd(iwa),isetshft(iwa),iwa=1,naccid)
+c end if
+cc
+ return
+ end
+ subroutine crdaccs(nacc,ipl,irest,naccid,kicrd,nolevm,
+ * levmaxacc,levminacc,icrdot0,twooftwo,icashft)
+c
+c nacc = accidental bitmap for main note
+c naccid = # of accid's in chord
+c kicrd = array with icrd #'s for notes w/ acc's, 0=>main note
+c nolevm = level of main note
+c
+c This is called once per multi-accidental chord. In here, loop over all
+c permutations of the order of accidental as stored in kicrd. Each time thru
+c loop, call crdacc once, get rms shift. Only save permutation and rms value
+c if it is less than old value.
+c
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+c
+c Make consistent? 120106
+c integer*4 kicrd(7),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
+ integer*4 kicrd(10),iperm(7),micrd(10),ipermsav(7),ksegrb0(50)
+ real*4 segrb0(2,50)
+ logical btest,tagged,manual,lshift,twooftwo
+cc
+cc Temporary printout of level-rankings
+cc
+c write(15,'()')
+c do 98 iacc = 1 , naccid
+c if (kicrd(iacc) .eq. 0) then
+c write(15,'(3i5)')nolevm,icrdot0
+c else
+c write(15,'(2i5)')igetbits(icrdat(kicrd(iacc)),7,12),
+c * igetbits(icrdot(kicrd(iacc)),3,27)
+c end if
+c98 continue
+cc
+c
+c Initialize right-barrier
+c
+ segrb0(1,1) = 0.
+ segrb0(2,1) = -1000.
+ segrb0(1,2) = 0.
+ segrb0(2,2) = 1000.
+ nsegrb0 = 2
+ ksegrb0(1) = -1
+ ksegrb0(2) = -1
+c
+c Search for left-shifted notes, Make up the initial right-barrier, which
+c will be good for all permutations.
+c irest()(27) is set if any notes are left-shifted
+c Must use ALL chord notes, not just ones w/ accid's.
+c
+ if (btest(irest,27)) then
+ do 15 icrd = icrd1-1, icrd2
+ if (icrd .eq. icrd1-1) then
+c
+c Main note
+c
+c lshift = btest(ipl,8)
+ lshift = btest(ipl,8) .or. btest(nacc,31)
+ if (lshift) nolev = nolevm
+ else
+c
+c Chord note
+c
+ lshift = btest(icrdat(icrd),23)
+c if (lshift) nolev = igetbits(icrdat(icrd),7,12)
+ if (lshift) then
+ nolev = igetbits(icrdat(icrd),7,12)
+ if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
+c
+c This note is not really shifted, It is the upper of a 2nd with the main
+c note on an upstem, and Main note must be shifted.
+c nacc(31) signals the real truth.
+c
+ lshift = .false.
+ end if
+ end if
+ end if
+ if (lshift) then
+ do 16 isegrb = 1 , nsegrb0-1
+ if (segrb0(2,isegrb+1) .gt. nolev-1) then
+c
+c Add this notehead to the right boundary here. Move all higher segs up 2.
+c
+ do 17 iiseg = nsegrb0 , isegrb+1 , -1
+ segrb0(1,iiseg+2) = segrb0(1,iiseg)
+ segrb0(2,iiseg+2) = segrb0(2,iiseg)
+ ksegrb0(iiseg+2) = ksegrb0(iiseg)
+17 continue
+ go to 18
+ end if
+16 continue
+18 continue
+c
+c Insert notehead into list. Set kseg=-2 to signal notehead shift.
+c
+ iiseg = isegrb+1
+ segrb0(1,iiseg) = -1.2
+ segrb0(2,iiseg) = nolev-1.
+ ksegrb0(iiseg) = -2
+ segrb0(1,iiseg+1) = 0.
+ segrb0(2,iiseg+1) = nolev+1.
+ ksegrb0(iiseg+1) = -1
+ nsegrb0 = nsegrb0+2
+ end if
+15 continue
+ end if
+c
+c Done setting right barrier for left-shifted noteheads
+c
+ tagged = .false.
+ manual = .false.
+c
+c Preprocess to check for manual shifts.
+c If are manual main [nacc(10-16)] or chord note [icrdot(20-26)]shifts, then
+c If any manual shift is preceded by "A" [nacc(29), icrdat(29)] then
+c 1. Auto-shifting proceeds
+c 2. "A"-shifts add to autoshifts
+c 3. non-"A" shifts are ignored!
+c Else (>0 man shifts, none has "A")
+c No auto-ordering, No autoshifts, Observe all manual shifts.
+c End if
+c End if
+c
+ maxmanshft = 0
+ do 13 i = 1 , naccid
+ if (kicrd(i) .eq. 0) then
+c
+c Main note
+c
+ manshft = igetbits(nacc,7,10)
+ if (manshft .ne. 0) then
+ manual = .true.
+ if (btest(nacc,29)) then
+ tagged = .true.
+ else
+c maxmanshft = max(maxmanshft,64-manshft)
+ maxmanshft = max(maxmanshft,107-manshft)
+ end if
+ end if
+ else
+c
+c Chord note
+c
+ manshft = igetbits(icrdot(kicrd(i)),7,20)
+ if (manshft .ne. 0) then
+ manual = .true.
+ if (btest(icrdat(kicrd(i)),29)) then
+ tagged = .true.
+ else
+c maxmanshft = max(maxmanshft,64-manshft)
+ maxmanshft = max(maxmanshft,107-manshft)
+ end if
+ end if
+ end if
+13 continue
+ if (manual) then
+ if (tagged) then
+c
+c zero out all untagged shifts
+c
+ do 14 i = 1 , naccid
+ if (kicrd(i) .eq. 0) then
+ if (.not.btest(nacc,29)) call setbits (nacc,7,10,0)
+ else
+ if (.not.btest(icrdat(kicrd(i)),29))
+ * call setbits (icrdot(kicrd(i)),7,20,0)
+ end if
+14 continue
+ else
+c
+c There are manual shifts but none tagged. Only proceed if "Ao" was entered
+c
+ if (.not.btest(nacc,28)) then
+ icashft = maxmanshft
+ return
+ end if
+ end if
+ end if
+ if (btest(nacc,28)) then
+c
+c Take the accidentals in order as originally input, then exit.
+c
+ call crdacc(nacc,naccid,kicrd,nolevm,rmsshift,.true.,
+ * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
+ return
+c end if
+ else if (naccid .eq. 3) then
+c
+c Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd
+c then place in order top, bottom, middle.
+c
+ do 20 i = 1 , 3
+ if (kicrd(i) .eq. 0) then
+ irank = icrdot0
+ nolev = nolevm
+ else
+ irank = igetbits(icrdot(kicrd(i)),3,27)
+ nolev = igetbits(icrdat(kicrd(i)),7,12)
+ end if
+ if (irank .eq. 1 ) then
+ micrd(1) = kicrd(i)
+ else
+ micrd(5-irank) = kicrd(i)
+ end if
+ if (irank .eq. 2) then
+ levmidacc = nolev
+ end if
+20 continue
+ if (levmaxacc.ne.levmidacc+1 .and.
+ * levmidacc.ne.levminacc+1) then
+ call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
+ * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
+ return
+ end if
+ end if
+ rmsmin = 100000.
+c
+c Initialize permutation array
+c
+ do 7 i = 1 , naccid
+ iperm(i) = i
+7 continue
+c
+c Start looping over permutations
+c
+ do 8 ip = 1 , 5041
+ if (ip .ne. 1) then
+c
+c Work the magic algorithm to get the next permutation
+c
+ do 1 k = naccid-1 , 1 , -1
+ if (iperm(k) .le. iperm(k+1)) go to 2
+1 continue
+c
+c If here, we just got the last permutation, so exit the loop over permutations
+c
+ go to 10
+2 continue
+ do 3 j = naccid , 1 , -1
+ if (iperm(k) .le. iperm(j)) go to 4
+3 continue
+4 continue
+ it = iperm(j)
+ iperm(j) = iperm(k)
+ iperm(k) = it
+ is = k+1
+ do 5 ir = naccid , 1 , -1
+ if (ir .le. is) go to 6
+ it = iperm(ir)
+ iperm(ir) = iperm(is)
+ iperm(is) = it
+ is = is+1
+5 continue
+6 continue
+ end if
+c
+c New we have a permutation. Take icrd values out of kicrd and put them into
+c micrd in the order of the permutation
+c
+ do 9 i = 1 , naccid
+ micrd(i) = kicrd(iperm(i))
+9 continue
+cc
+cc Temporary printout
+cc
+c write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid)
+cc
+ call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.false.,
+ * levmaxacc,icrdot0,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
+cc
+cc Temporary printout
+cc
+c write(15,*)'perm done, rmsshift:',rmsshift
+cc
+ if (rmsshift .lt. rmsmin) then
+c
+c Save this permutation, reset minrms
+c
+ do 11 i = 1 , naccid
+ ipermsav(i) = iperm(i)
+ rmsmin = rmsshift
+11 continue
+ end if
+8 continue
+ print*,'Should not BEEEEEE here!'
+ call stop1()
+10 continue
+c
+c Done looping, get info for the final choice
+c
+ do 12 i = 1 , naccid
+ micrd(i) = kicrd(ipermsav(i))
+12 continue
+cc
+cc Temporary printout
+cc
+c write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid)
+cc
+ call crdacc(nacc,naccid,micrd,nolevm,rmsshift,.true.,
+ * idummy,idummy,segrb0,ksegrb0,nsegrb0,twooftwo,icashft)
+ return
+ end
+ subroutine doacc(ihshft,ivshft,notexq,lnote,nacc,nolev,ncm,caut)
+ character*1 sq,chax
+ character*3 acsymq
+ character*8 noteq
+ character*79 notexq
+ logical btest,caut
+ sq = chax(92)
+ if (ihshft .eq. -107) ihshft=0
+cc
+cc If main note shifted left, so shift accid. Terminate below, when acc. is done.
+cc
+ if (ihshft .ne. 0) then
+c
+c Accid must be shifted horizontally
+c
+ if (ihshft .lt. 0) then
+ notexq = sq//'loffset{'
+ ihshft = -ihshft
+ else
+ notexq = sq//'roffset{'
+ end if
+ hshft = .05*ihshft
+ if (hshft .lt. 1.) then
+ write(notexq(10:12),'(f3.2)')hshft
+ lnote = 12
+ else
+ write(notexq(10:13),'(f4.2)')hshft
+ lnote = 13
+ end if
+ notexq = notexq(1:lnote)//'}{'//sq
+ lnote = lnote+3
+ else
+ notexq = sq
+ lnote = 1
+ end if
+ if (btest(nacc,3)) then
+ notexq = notexq(1:lnote)//'big'
+ lnote = lnote+3
+ end if
+ if (caut) then
+c
+c Cautionary accidental. Need to define bigcna,... in pmx.tex
+c
+ notexq = notexq(1:lnote)//'c'
+ lnote = lnote+1
+ end if
+ call accsym(nacc,acsymq,lacc)
+ notexq = notexq(1:lnote)//acsymq(1:lacc)
+ lnote = lnote+lacc
+ noleva = nolev
+ if (ivshft .ne. 0) noleva = noleva+ivshft-32
+ call notefq(noteq,lnoten,noleva,ncm)
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (ihshft .ne. 0) then
+c
+c Terminate horizontal shift
+c
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ return
+ end
+ subroutine docrd(ivx,ip,nodu,ncm,iv,tnow,soutq,lsout,ulq,ibmcnt,
+ * islur,nvmx,nv,beamon,nolevm,ihornb,nornb,stemlen,
+ * dotxtup,nacc,irest)
+ parameter (nm=24,mv=24576)
+ integer*4 irest(nm,24)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+ integer*2 mmidi,iinsiv
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ logical lowdot,dotxtup
+ integer*4 ihornb(nm,24),nornb(nm)
+ character*1 ulq(nm,9),chax
+ character*7 nosymq
+ character*8 noteq
+ character*79 notexq,outq
+ character*80 soutq
+ logical btest,isleft,isright,beamon
+ character*79 inameq
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /commidisig/ midisig
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+c
+c This subr. once produced notexq for entire chord. 10/18/97 altered to write
+c chord notes as we go. 10/22/97 find range of icrd first.
+c 2/25/98 moved rangefinding to precrd so done before slurs, so now
+c on entry, icrd1, icrd2 define range of icrd for this chord.
+c
+c Set counter (for this note) for chord notes present. Set notmain=T.
+c Will test for notmain=.true. in addmidi to tell whether to save pitch.
+c
+ nmidcrd = 0
+ notmain = .true.
+ crdacc = .false.
+ do 5 icrd = icrd1 , icrd2
+ lnote = 0
+ nolev = igetbits(icrdat(icrd),7,12)
+c
+c 3/8/03 save original pitch to use in midi, in case 2nds alter things.
+c
+ nolevo = nolev
+c
+c Check for special situations with 2nds (see precrd).
+c
+ if (btest(nacc,30) .and. nolev.eq.nolevm-1) then
+c
+c Upstem, 2nd with upper as main, interchange pitches,
+c rt-shift upper (now chord note). Lower (orig chord, now main)
+c if dotted, probably had shifted dot, dot parameters must be moved
+c from chord to main
+c
+ nolev = nolevm
+ if (btest(icrdat(icrd),26)) then
+c
+c Orig. chord note dot shift, must transfer to main.
+c
+ icrdotsav = icrdot(icrd)
+ icrdatsav = icrdat(icrd)
+ if (btest(irest(ivx,ip),19)) then
+c
+c Main note (upper) had a dot shift, must move it to chord
+c
+ call setbits(icrdat(icrd),1,26,1)
+ call setbits(icrdot(icrd),7,0,
+ * nint(updot(ivx,ndotmv(ivx)+1)*10)+64)
+ call setbits(icrdot(icrd),7,7,
+ * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64)
+c
+c May need to worry about other chord params (accid shefts etc) later
+c
+ else
+ icrdat(icrd) = ibclr(icrdat(icrd),26)
+ end if
+c
+c We are adding a main note dot shift, so push any later ones back
+c
+
+ if (.not.btest(irest(ivx,ip),19)) then
+ maxdotmv(ivx) = maxdotmv(ivx)+1
+ do 1 indm = maxdotmv(ivx) , ndotmv(ivx)+2 , -1
+ updot(ivx,indm) = updot(ivx,indm-1)
+ rtdot(ivx,indm) = rtdot(ivx,indm-1)
+1 continue
+ end if
+ irest(ivx,ip) = ibset(irest(ivx,ip),19)
+ updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64)
+ rtdot(ivx,ndotmv(ivx)+1) =
+ * 0.1*(iand(127,ishft(icrdotsav,-7))-64)
+ end if
+ else if (btest(nacc,31) .and. nolev.eq.nolevm+1) then
+c
+c Downstem, 2nd with lower as main, interchange pitches,
+c left-shift lower (now chord note). Lower (orig main, now chord)
+c probably had shifted dot, dot parameters must be moved from
+c main to chord
+c
+ nolev = nolevm
+ if (btest(irest(ivx,ip),19)) then
+ icrdotsav = icrdot(icrd)
+ icrdatsav = icrdat(icrd)
+ icrdat(icrd) = ibset(icrdat(icrd),26)
+c bits in icrdot
+c 0-6 10*abs(vertical dot shift in \internote) + 64
+c 7-13 10*abs(horizontal dot shift in \internote) + 64
+c Assuming >0 for now!
+ call setbits(icrdot(icrd),7,0,
+ * nint(updot(ivx,ndotmv(ivx)+1)*10)+64)
+ call setbits(icrdot(icrd),7,7,
+ * nint(rtdot(ivx,ndotmv(ivx)+1)*10)+64)
+c
+c Must also set dot shift for (now) main note (orig. chord note).
+c
+ if (btest(icrdatsav,26)) then
+ updot(ivx,ndotmv(ivx)+1) = 0.1*(iand(127,icrdotsav)-64)
+ rtdot(ivx,ndotmv(ivx)+1) =
+ * 0.1*(iand(127,ishft(icrdotsav,-7))-64)
+ else
+c
+c No dot move on original chord (now main) note,
+c
+ updot(ivx,ndotmv(ivx)+1) = 0.
+ rtdot(ivx,ndotmv(ivx)+1) = 0.
+ end if
+ end if
+ end if
+c
+c Lower dot for lower-voice notes?. Conditions are:
+c 1. Dotted time value
+c 2. Lower voice of two
+c 3. Note is on a line
+c 4. Not a rest (cannot be a rest in a chord!)
+c. 5. Flag (lowdot) is set to true
+c
+ if (lowdot .and. nvmx.eq.2 .and. ivx.le.nv) then
+ if (2**log2(nodu).ne.nodu .and. mod(nolev-ncm,2).eq.0) then
+ if (btest(icrdat(icrd),26)) then
+c
+c Note already in movdot list. Drop by 2.
+c
+ call setbits(icrdot(icrd),7,0,
+ * igetbits(icrdot(icrd),7,0)-20)
+ else
+c
+c Not in list so just move it right now
+c
+ call dotmov(-2.,0.,soutq,lsout,igetbits(islur,1,3))
+ end if
+ end if
+ end if
+ if (btest(icrdat(icrd),26)) then
+c
+c Move the dot. Basic call for chord notes, not main note.
+c
+ updotc = 0.1*(iand(127,icrdot(icrd))-64)
+ rtdotc = 0.1*(iand(127,ishft(icrdot(icrd),-7))-64)
+ call dotmov(updotc,rtdotc,soutq,lsout,igetbits(islur,1,3))
+ end if
+ isleft = btest(icrdat(icrd),23)
+ isright = btest(icrdat(icrd),24)
+c
+c Check for ornament in chord.
+c
+ if (icrdorn(icrd) .gt. 0) then
+ call putorn(icrdorn(icrd),nolev,nolevm,nodu,nornb,ulq,
+ * ibmcnt,ivx,ncm,islur,nvmx,nv,ihornb,stemlen,outq,lout,
+ * ip,0,beamon,.true.)
+ call addstr(outq,lout,soutq,lsout)
+ end if
+c
+c Chord-note symbol. First check for breve
+c
+ if (nodu .eq. 128) then
+ nosymq = chax(92)//'zbreve'
+ lsym = 7
+ else
+c
+c Not a breve chord. Get first letters in chord-note symbol
+c
+ if (isleft) then
+ nosymq = chax(92)//'l'
+ else if (isright) then
+ nosymq = chax(92)//'r'
+ else
+ nosymq = chax(92)//'z'
+ end if
+ if (nodu .ge. 64) then
+ nosymq = nosymq(1:2)//'w'
+ else if (nodu .ge. 32) then
+ nosymq = nosymq(1:2)//'h'
+ else
+ nosymq = nosymq(1:2)//'q'
+ end if
+ if (2**log2(nodu).eq.nodu .and. .not.dotxtup) then
+ lsym = 3
+ else if (.not.btest(islur,3) .or. dotxtup) then
+c
+c Single dot
+c
+ nosymq = nosymq(1:3)//'p'
+ lsym = 4
+ else
+c
+c Double dot
+c
+ nosymq = nosymq(1:3)//'pp'
+ lsym = 5
+ end if
+ end if
+ if (btest(icrdat(icrd),19).and..not.btest(icrdat(icrd),27)) then
+c
+c Accidental and not MIDI-only. Build up bits 0-3 of nacc
+c
+ nactmp = igetbits(icrdat(icrd),3,20)
+c
+c Kluge for bigness. Only means 'As' has not been issued
+c
+ if (bacfac .ne. 1.e6) nactmp = nactmp+8
+ call doacc(igetbits(icrdot(icrd),7,20)-107,
+ * igetbits(icrdot(icrd),6,14),
+c * notexq,lnote,nactmp,nolev,ncmid(iv,ip))
+c Get original nolev, not altered to deal with 2nds
+ * notexq,lnote,nactmp,igetbits(icrdat(icrd),7,12),
+c * ncmid(iv,ip))
+ * ncmid(iv,ip),btest(icrdat(icrd),31))
+ notexq = notexq(1:lnote)//nosymq
+ crdacc = .true.
+ else
+ notexq = nosymq
+ end if
+ lnote = lnote+lsym
+c
+c Get note name (again if accid, due to possible octave jump)
+c
+ call notefq(noteq,lnoten,nolev,ncm)
+ if (lnoten.eq.1) call addblank(noteq,lnoten)
+c
+c Put in note name
+c
+ notexq = notexq(1:lnote)//noteq
+ lnote = lnote+lnoten
+ if (btest(icrdat(icrd),25)) then
+c
+c Arpeggio signal
+c
+ call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout)
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+ if (ismidi) then
+c
+c Here is where we collect MIDI pitch info for the chord note. By checking
+c notmain, addmidi(...) knows to just compute the
+c pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi()
+c for MAIN note, will put in note codes for all chord notes + main note.
+c
+ kv = 1
+ if (ivx .gt. iv) kv=2
+ nmidcrd = nmidcrd+1
+ if (nmidcrd .gt. 20) then
+ print*
+ print*,'21 chord notes is too many for midi processor'
+ call stop1()
+ end if
+c
+c Use original saved pitch level, unaltered by 2nds logic.
+c
+ call addmidi(midchan(iv,kv),nolevo+miditran(instno(iv)),
+ * igetbits(icrdat(icrd),3,20),midisig,1.,
+ * .false.,.false.)
+ end if
+5 continue
+ notmain = .false.
+ return
+ end
+ subroutine dodyn(ivx,ip,nolev,ncm,ipl,islur,irest,nvmx,nv,
+ * beamon,ihornb,nornb,ulq,ibmcnt,nostem,soutq,lsout)
+ parameter (nm=24)
+c
+c Inputs are array *elements* except ihornb,nornb,ulq
+c
+ common /commus/ musize,whead20
+ common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
+ * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
+ * idynda2(99),levhssav(nm),listcresc,listdecresc
+ character*128 txtdynq
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ logical btest,beamon,upstem,nostem
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ logical fontslur,upslur,WrotePsslurDefaults
+ character*1 udqq,chax,ulq(nm,9)
+ character*4 dynstrq
+ character*5 numpq
+ character*48 dyntablq,tempq
+ character*79 notexq
+ character*80 soutq
+ integer*4 ihornb(nm,24),nornb(nm),idynn(10)
+ common /comhair/ ihairuse,idhair(nm)
+ data dyntablq /'ppppppp pp p mp mf f fp sfz ff fff ffff'/
+ numdyn = 0
+c
+c Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values
+c in idynn(1...4)
+c
+ do 1 idyn = 1 , ndyn
+ ivxtent = iand(idyndat(idyn),15)
+ * +16*igetbits(idynda2(idyn),1,10)
+ if (ivxtent .eq. ivx) then
+ iptent = igetbits(idyndat(idyn),8,4)
+ if (iptent .eq. ip) then
+ numdyn = numdyn+1
+ idynn(numdyn) = idyn
+ else if (iptent .gt. ip) then
+c
+c I don't think there are any more possible for this ivx,ip, so exit loop
+c
+ go to 2
+ end if
+ end if
+1 continue
+2 continue
+c
+c At this point there is a list of idyn's in idynn(1...numdyn)
+c Compute level, and stem-dir'n-based horizontal tweaks
+c
+ hoffsd = 0.
+c
+c Set upstem to false as default
+c
+ upstem = .false.
+ if (btest(irest,0)) then
+c
+c It's a rest. Assume it doesn't go below the staff
+c
+ lbot = ncm-4
+ else if (.not.beamon) then
+ if (udqq(nolev,ncm,islur,nvmx,ivx,nv).eq.'u' .or. nostem) then
+ upstem = .true.
+ if (.not.btest(ipl,10)) then
+ lbot = min(nolev-1,ncm-4)
+ else
+ lbot = min(minlev-1,ncm-4)
+ end if
+ else
+ hoffsd = -.5
+ if (.not.btest(ipl,10)) then
+ lbot = min(nolev-7,ncm-4)
+ else
+ lbot = min(minlev-7,ncm-4)
+ end if
+ end if
+ else
+ if (ulq(ivx,ibmcnt) .eq. 'u') then
+ upstem = .true.
+ if (.not.btest(ipl,10)) then
+ lbot = min(nolev-1,ncm-4)
+ else
+ lbot = min(minlev-1,ncm-4)
+ end if
+ else
+ hoffsd = -.5
+c
+c 171230 Desperation
+c lbot = ihornb(ivx,nornb(ivx))+1
+ if (nornb(ivx).eq.0) then
+ lbot = 1
+ else
+ lbot = ihornb(ivx,nornb(ivx))+1
+ end if
+ if (lbot .eq. 1) then
+c
+c Kluge for non-beamed, down xtup, for which ihorb was never set.
+c Assumes stem is shortened.
+c
+ lbot = nolev-5
+ end if
+ nornb(ivx) = nornb(ivx)+1
+ end if
+ end if
+ lbot = lbot-5
+ jtxtdyn1 = 1
+c
+c Now ready to loop over current dyn's
+c
+ do 3 icntdyn = 1 , numdyn
+ idynd = idyndat(idynn(icntdyn))
+ idynd2 = idynda2(idynn(icntdyn))
+ idno = igetbits(idynd,4,12)
+c ivx = iand(15,idynd)
+ ivx = iand(15,idynd)+16*igetbits(idynd2,1,10)
+c
+c Build the command into notex in stages. Insert name & rq'd args in order:
+c
+c Command name
+c hpstrt, hpcend, hpdend, pmxdyn
+c ivx
+c X X X
+c level
+c X X X
+c hoff
+c X X X X
+c d-mark
+c X
+c
+ if (idno .eq. 0) then
+c
+c Text-dynamic
+c
+ notexq = chax(92)//'txtdyn'
+ lnote = 7
+ else if (idno .le. 12) then
+c
+c Letter-group
+c
+ notexq = chax(92)//'pmxdyn'
+ lnote = 7
+ else if (fontslur) then
+ lnote = 7
+ if (idno .eq. 13) then
+c
+c Start a font-based hairpin
+c
+ notexq = chax(92)//'hpstrt'
+ else if (idno .eq. 14) then
+c
+c End crescendo
+c
+ notexq = chax(92)//'hpcend'
+ else
+c
+c End decrescendo
+c
+ notexq = chax(92)//'hpdend'
+ end if
+c
+c Put in voice number as ID for font-based hairpin
+c
+ if (ivx .le. 9) then
+ notexq = notexq(1:lnote)//char(48+ivx)
+ lnote = lnote+1
+ else if (ivx .le. 19) then
+ notexq = notexq(1:lnote)//'{1'//char(38+ivx)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//char(28+ivx)//'}'
+ lnote = lnote+4
+ end if
+ else
+c
+c Postscript hairpins
+c
+ lnote = 7
+ if (idno .eq. 13) then
+ notexq = chax(92)//'Icresc'
+ else if (idno .eq.14) then
+ notexq = chax(92)//'Idecresc'
+ lnote = 9
+ else
+ notexq = chax(92)//'Tcresc'
+ end if
+ if (idno .le. 14) then
+c
+c Get and record ID no for start of ps hairpin
+c Find first unused ID
+c
+ do 8 idh = 1 , 24
+ if (.not.btest(ihairuse,idh)) go to 9
+8 continue
+ call printl('Bad place in putdyn, call Dr. Don')
+ call stop1()
+9 continue
+ ihairuse = ibset(ihairuse,idh)
+ idhair(ivx) = idh
+ else
+c
+c Unrecord ID no for end of ps hairpin
+c
+ call setbits(ihairuse,1,idhair(ivx),0)
+ end if
+c
+c Write ID # for start or end of ps hairpin
+c
+ idh = idhair(ivx)
+ if (idh .le. 9) then
+ notexq = notexq(1:lnote)//char(48+idh)
+ lnote = lnote+1
+ else if (idh .le. 19) then
+ notexq = notexq(1:lnote)//'{1'//char(38+idh)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//char(28+idh)//'}'
+ lnote = lnote+4
+ end if
+ end if
+c
+c Begin setting level
+c
+ lbot1 = lbot
+ if (idno.gt.0 .and. idno.le.5) then
+c
+c All letters are short so raise a bit.
+c
+ lbot1 = lbot1+1
+ else if (idno .ge. 13) then
+ lbot1 = lbot1+2
+ end if
+c
+c Convert so reference is bottom line
+c
+ lbot1 = lbot1-ncm+4
+ if ((fontslur.and.idno.eq.13) .or.
+ * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
+c
+c Hairpin start. Save level and user-tweak before applying user tweak.
+c
+ levdsav(ivx) = lbot1
+ levhssav(ivx) = 0
+ if (btest(idynd,16)) levhssav(ivx) = -64+igetbits(idynd,7,17)
+ else if ((fontslur.and.idno.ge.14) .or. idno.eq.15) then
+c
+c Hairpin end; Compare level with saved start level before user-tweaks
+c
+ lbot1 = min(lbot1,levdsav(ivx))
+c
+c Save pre-tweak level
+c
+ lpretweak = lbot1
+ end if
+c
+c Check for user-defined vertical tweak
+c
+ if (btest(idynd,16)) lbot1 = lbot1-64+igetbits(idynd,7,17)
+c
+c Now horizontal stuff
+c
+ hoff = hoffsd
+c
+c Some special horizontal tweaks
+c
+ if (upstem .and. idno.gt.0 .and.
+ * (idno.le.4 .or. idno.eq.8 .or. idno.eq.9)) hoff = hoff+.4
+c
+c User-defined tweaks
+c
+ if (btest(idynd2,0))
+ * hoff = hoff+(igetbits(idynd2,9,1)-256)*.1
+ if (numdyn .gt. 1) then
+c
+c Horizontal-interaction-based tweaks.
+c
+c Cases:
+c numdyn type1 type2 type3 data used
+c 2 wrd-grp hrpnstrt - ivowg(1...12),hoh1(1...12)
+c 2 hrpnend wrd-grp - ivowg,hoh2
+c 2 hrpnend hrpnstrt - hoh2h1(1...2)
+c 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1
+c
+ if (idno.gt.0 .and. idno.le.12) then
+c
+c Word-group, may need vertical tweak to line up.
+c
+ lbot1 = lbot1+ivowg(idno)
+c
+c Protecting against hp start-stop on same note
+c
+ else if (((fontslur.and.idno.ge.14).or.idno.eq.15)
+ * .and. icntdyn.lt.numdyn) then
+c
+c Hairpin ending, check next type
+c
+ if ((fontslur .and.
+ * igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
+ * .or. (.not.fontslur .and.
+ * ((igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.13)
+ * .or.
+ * (igetbits(idyndat(idynn(icntdyn+1)),4,12).eq.14))))
+ * then
+c
+c Hairpin end then hairpin start, no words, (remember dealing with end now)
+c
+ hoff = hoff+hoh2h1(1)
+ else
+c
+c Hairpin end then word-group, need idno for w-g to set hp offset
+c
+ hoff = hoff +
+ * hoh2(igetbits(idyndat(idynn(icntdyn+1)),4,12))
+ end if
+c
+c Protecting against hp start-stop on same note
+c
+ else if (icntdyn.gt.1 .and. idno.gt.0 .and.
+ * ((fontslur.and.idno.lt.14).or.
+ * (.not.fontslur.and.idno.lt.15))) then
+c
+c Hairpin start, check prior type
+c
+ if ((fontslur.and.
+ * igetbits(idyndat(idynn(icntdyn-1)),4,12).ge.14)
+ * .or.
+ * (.not.fontslur.and.
+ * igetbits(idyndat(idynn(icntdyn-1)),4,12).eq.15))
+ * then
+c
+c Hairpin end then hairpin start, (remember dealing with start now)
+c
+ hoff = hoff+hoh2h1(2)
+ else
+c
+c Hairpin start after word-group, need idno for w-g to set hp offset
+c
+ hoff = hoff+
+ * hoh1(igetbits(idyndat(idynn(icntdyn-1)),4,12))
+ end if
+ end if
+ end if
+c
+c End of if-block for 2- or 3-way interactions.
+c
+ if ((.not.fontslur) .and. idno.ge.13)
+c
+c Slur font and hairpin. Add hoff, and change from \interneote to \qn@width
+c
+ * hoff = (hoff+.5)*6./2.5
+c
+c Position corrections all done now. Put in the level.
+c
+ if ((fontslur.and.idno.eq.13) .or.
+ * ((.not.fontslur).and.(idno.eq.13.or.idno.eq.14))) then
+c
+c Hairpin start.
+c
+ if (.not.fontslur) then
+c
+c Postscript hairpin start...inset placeholder for start level.
+
+ notexq = notexq(1:lnote)//'{ }'
+ lnote = lnote+5
+ end if
+ else
+c
+c Insert actual level in all cases except hairpin start
+c Create string with level in it
+c
+ if (lbot1 .gt. 9) then
+ numpq = '{'
+ write(numpq(2:3),'(i2)')lbot1
+ numpq = numpq(1:3)//'}'
+ lnumpq = 4
+ else if (lbot1 .gt. -1) then
+ numpq = char(48+lbot1)
+ lnumpq = 1
+ else if (lbot1 .gt. -10) then
+ numpq = '{'
+ write(numpq(2:3),'(i2)')lbot1
+ numpq = numpq(1:3)//'}'
+ lnumpq = 4
+ else
+ numpq = '{'
+ write(numpq(2:4),'(i3)')lbot1
+ numpq = numpq(1:4)//'}'
+ lnumpq = 5
+ end if
+c
+c Level has now been computed and stored in numpq
+c Append the level
+c
+ notexq = notexq(1:lnote)//numpq(1:lnumpq)
+ lnote = lnote+lnumpq
+ end if
+ if (abs(hoff) .lt. .001) then
+c
+c No horiz offset
+c
+ notexq = notexq(1:lnote)//'0'
+ lnote = lnote+1
+ else
+c
+c Horizontal tweak
+c
+ lform = lfmt1(hoff)
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ write(notexq(lnote+1:lnote+lform),
+ * '(f'//chax(48+lform)//'.1)')hoff
+ lnote = lnote+lform
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ if (idno .eq. 0) then
+c
+c text-dynamic. Find the string and append it
+c
+ do 4 jtxtdyn = jtxtdyn1 , ntxtdyn
+c ivxip = ivx+16*ip
+ ivxip = ivx+32*ip
+ if (ivxip .eq. ivxiptxt(jtxtdyn)) go to 5
+4 continue
+ call printl('Abnormal stop in putdyn')
+ call stop1()
+5 continue
+ ltxtdyn = lenstr(txtdynq(jtxtdyn),128)
+c
+c Font size based on musicsize
+c
+c if (musize .eq. 20) then
+c notexq = notexq(1:lnote)//'{'//char(92)//'medtype'
+c * //char(92)//'it '
+c lnote = lnote+13
+c else if (musize .eq. 16) then
+c notexq = notexq(1:lnote)//'{'//char(92)//'normtype'
+c * //char(92)//'it '
+c lnote = lnote+14
+c else if (musize .eq. 24) then
+c notexq = notexq(1:lnote)//'{'//char(92)//'bigtype'
+c * //char(92)//'it '
+c lnote = lnote+13
+c else if (musize .eq. 29) then
+c notexq = notexq(1:lnote)//'{'//char(92)//'Bigtype'
+c * //char(92)//'it '
+c lnote = lnote+13
+c end if
+c
+c Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line)
+c
+ call addstr(notexq(1:lnote),lnote,soutq,lsout)
+ if (musize .eq. 20) then
+ notexq = '{'//char(92)//'medtype'//char(92)//'it '
+ lnote = 13
+ else if (musize .eq. 16) then
+ notexq = '{'//char(92)//'normtype'//char(92)//'it '
+ lnote = 14
+ else if (musize .eq. 24) then
+ notexq = '{'//char(92)//'bigtype'//char(92)//'it '
+ lnote = 13
+ else if (musize .eq. 29) then
+ notexq = '{'//char(92)//'Bigtype'//char(92)//'it '
+ lnote = 13
+ end if
+c
+ notexq = notexq(1:lnote)//txtdynq(jtxtdyn)(1:ltxtdyn)//'}'
+ lnote = lnote+ltxtdyn+1
+c
+c Reset jtxtdyn1 just in case >1 txtdyn on same note.
+c
+ jtxtdyn1 = jtxtdyn+1
+ else if (idno .le. 12) then
+c
+c Letter-group dynamic. Append the letter-group command
+c
+ id = 4*idno
+ dynstrq = dyntablq(id-3:id)
+ id = lenstr(dynstrq,4)
+ notexq = notexq(1:lnote)//chax(92)//dynstrq(1:id)
+ lnote = lnote+1+id
+ end if
+ call addstr(notexq(1:lnote),lnote,soutq,lsout)
+ if ((.not.fontslur).and.idno.eq.15) then
+c
+c PS slurs on, hairpin is ending. Go back and set height at beginning.
+c Add user-defined tweak to default level
+c
+ lbot1 = lpretweak+levhssav(ivx)
+ if (lbot1 .gt. 9) then
+ numpq = '{'
+ write(numpq(2:3),'(i2)')lbot1
+ numpq = numpq(1:3)//'}'
+ lnumpq = 4
+ else if (lbot1 .gt. -1) then
+ numpq = char(48+lbot1)
+ lnumpq = 1
+ else if (lbot1 .gt. -10) then
+ numpq = '{'
+ write(numpq(2:3),'(i2)')lbot1
+ numpq = numpq(1:3)//'}'
+ lnumpq = 4
+ else
+ numpq = '{'
+ write(numpq(2:4),'(i3)')lbot1
+ numpq = numpq(1:4)//'}'
+ lnumpq = 5
+ end if
+c
+c Construct string to search backwards for placeholder
+c
+ if (idh .le. 9) then
+ tempq = 'cresc'//char(48+idh)//'{ }'
+ ltemp = 11
+ else if (idh .le. 19) then
+ tempq = 'cresc'//'{1'//char(38+idh)//'}{ }'
+ ltemp = 14
+ else
+ tempq = 'cresc'//'{2'//char(28+idh)//'}{ }'
+ ltemp = 14
+ end if
+ write(11,'(a)')soutq(1:lsout)//'%'
+ lsout = 0
+ call backfill(11,tempq,ltemp,
+ * tempq(1:ltemp-5)//numpq(1:lnumpq),ltemp-5+lnumpq)
+ end if
+3 continue
+c
+c Shrink arrays, decrease ndyn 111109
+c
+ do 6 icntdyn = numdyn, 1 , -1
+ do 7 jdyn = idynn(icntdyn) , ndyn-1
+ idyndat(jdyn) = idyndat(jdyn+1)
+ idynda2(jdyn) = idynda2(jdyn+1)
+7 continue
+ ndyn = ndyn-1
+6 continue
+ end
+ subroutine dograce(ivx,ip,ptgr,soutq,lsout,ncm,nacc,ig,ipl,
+ * farend,
+ * beamon,nolev,ncmidx,islur,nvmx,nv,ibmcnt,tnote,ulq,instno)
+c
+c ip will be one LESS than current note, for way-after's before bar-end,
+c It is only used to find ig.
+c ig is returned to makeabar in case there's a slur that needs to be ended
+c
+ parameter (nm=24)
+ logical beamon,stemup
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /comoct/ noctup
+ logical upg,slurg,slashg,bar1syst,upslur,btest,isgaft,iswaft,
+ * normsp,farend,fontslur,WrotePsslurDefaults
+ real*4 ptgr(37)
+ character*80 soutq
+ character*128 litq
+ character*79 notexq
+ character*20 voltxtq
+ character*10 figq
+ character*8 noteq,noteqGA
+ character*3 acsymq
+ character*1 sq,chax,udqq,ulq(nm,9)
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ sq = chax(92)
+ isgaft = btest(ipl,29)
+ iswaft = btest(ipl,31)
+ normsp = .not. isgaft
+c
+c Find ig.
+c
+ do 120 ig = 1 , ngrace
+ if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 121
+120 continue
+ print*,'Problem finding grace index in dograce'
+ stop
+121 continue
+ ngs = ngstrt(ig)
+ mg = multg(ig)
+c wheadpt1 = wheadpt*fullsize(ivx)
+ wheadpt1 = wheadpt*fullsize(instno)
+c
+c For way-after-graces at end of bar, must set the octave.
+c
+ if (farend) then
+ noctup = 0
+ if (ncm .eq.23) noctup = -2
+ end if
+ if (slurg(ig) .and. .not.iswaft .and..not.isgaft) then
+ if (listslur .eq. 16777215) then
+ print*
+ print*,'You defined the twentyfifth slur, one too many!'
+ write(15,'(/,a)')
+ * 'You defined the twentyfifth slur, one too many!'
+ call stop1()
+ end if
+c
+c Slur on fore-grace. Get index of next slur not in use, from 23 down.
+c
+ ndxslur = log2(16777215-listslur)
+
+ end if
+ if (nng(ig) .eq. 1) then
+c
+c Single grace.
+c
+ if (normsp) then
+c
+c Anything but GA
+c
+ call addstr(sq//'shlft',6,soutq,lsout)
+ niptgr = nint(ptgr(ig))
+c
+c Empirical tweak for postscript.
+c
+C if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3)
+c++
+ if (niptgr .lt. 10) then
+ call addstr(chax(48+niptgr)//'{',2,soutq,lsout)
+ else if (niptgr .lt. 100) then
+ write(notexq(1:2),'(i2)')niptgr
+ call addstr('{'//notexq(1:2)//'}{',5,soutq,lsout)
+ else
+ print*,
+ * 'Call Dr. Don if you really want grace note group > 99 pt'
+ stop
+ end if
+ else
+ call addstr(sq//'gaft{1.5}{',11,soutq,lsout)
+c
+c GA. Compute aftshft, for later use.
+c
+ aftshft = grafac
+ if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+agc1fac
+ aftshft = aftshft*wheadpt
+ end if
+ if (slurg(ig) .and. .not.isgaft .and..not.iswaft) then
+c
+c Start slur on pre-grace. No accounting needed since will be ended very soon.
+c
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+ if (fontslur) then
+ if (upg(ig)) then
+ call addstr(sq//'islurd',7,soutq,lsout)
+ else
+ call addstr(sq//'isluru',7,soutq,lsout)
+ end if
+ else
+c
+c Start Postscript slur.
+c
+ if (upg(ig)) then
+ call addstr(sq//'isd',4,soutq,lsout)
+ else
+ call addstr(sq//'isu',4,soutq,lsout)
+ end if
+ end if
+c
+c Print slur number, 23-ndxslur
+c
+ lnote = 0
+ if (23-ndxslur .lt. 10) then
+c notexq = notexq(1:lnote)//chax(59-ndxslur)
+ notexq = chax(71-ndxslur)
+ lnote = 1
+ else if (23-ndxslur .lt. 20) then
+c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
+ notexq = '{1'//chax(61-ndxslur)//'}'
+ lnote = 4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = 4
+ end if
+ call addstr(notexq(1:lnote)//noteq(1:lnoten),
+ * lnote+lnoten,soutq,lsout)
+ if (.not.fontslur) then
+c
+c Horizontal tweaks for postscript slur on single grace
+c
+ stemup = .true.
+ if (upg(ig)) then
+c
+c Check for up-grace + down stem. Get stem direction
+c
+ if (.not.beamon) then
+c
+c Separate note. Get stem direction.
+c
+ stemup = udqq(nolev,ncmidx,
+ * islur,nvmx,ivx,nv) .eq. 'u'
+ else
+c
+c In a beam
+c
+ stemup = ulq(ivx,ibmcnt) .eq. 'u'
+ end if
+c
+c Stop the shift if whole note
+c
+ stemup = stemup .or. tnote.gt.63
+ end if
+ if (stemup) then
+ call addstr('{-.3}',5,soutq,lsout)
+ else
+ call addstr('{-.8}',5,soutq,lsout)
+ end if
+ end if
+ end if
+ if (naccg(ngs) .gt. 0) then
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+c
+c Save for checking octave shifts in GA
+c
+ if (isgaft) then
+ lnotenGA = lnoten
+ noteqGA = noteq
+ end if
+c
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ call accsym(naccg(ngs),acsymq,lacc)
+ call addstr(sq//'big'//acsymq(1:lacc)//
+ * noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
+ end if
+ if (slashg(ig)) then
+ notexq = sq//'grc'
+ lnote = 4
+ else if (mg .eq. 0) then
+ notexq = sq//'zq'
+ lnote = 3
+ else
+ notexq = sq//'zc'
+ do 61 i = 2 , mg
+ notexq = notexq(1:i+1)//'c'
+61 continue
+ lnote = mg+2
+ end if
+ if (upg(ig)) then
+ notexq = notexq(1:lnote)//'u'
+ else
+ notexq = notexq(1:lnote)//'l'
+ end if
+ call addstr(notexq,lnote+1,soutq,lsout)
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+c
+ if (isgaft .and. naccg(ngs).eq.0) then
+ lnotenGA = lnoten
+ noteqGA = noteq
+ end if
+c
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ call addstr(noteq,lnoten,soutq,lsout)
+ if (slashg(ig)) call addstr(sq//'off{-'//sq//
+ * 'noteskip}',16,soutq,lsout)
+c
+c Above code needed since slashg causes spacing
+c
+ if (slurg(ig) .and. (iswaft.or.isgaft)) then
+c
+c Terminate slur on single after-grace
+c
+ ndxslur = igetbits(ipl,5,23)
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+ call addstr(sq//'tslur',6,soutq,lsout)
+c
+c Print 24-ndxslur
+c
+c if (11-ndxslur .lt. 10) then
+ if (23-ndxslur .lt. 10) then
+c call addstr(chax(59-ndxslur)//noteq(1:lnoten),
+ call addstr(chax(71-ndxslur)//noteq(1:lnoten),
+ * 1+lnoten,soutq,lsout)
+ else if (23-ndxslur .lt. 20) then
+ call addstr('{2'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
+ * 4+lnoten,soutq,lsout)
+ else
+c call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten),
+ call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
+ * 4+lnoten,soutq,lsout)
+ end if
+ slurg(ig) = .false.
+ listslur = ibclr(listslur,ndxslur)
+ end if
+ call addstr('}',1,soutq,lsout)
+c
+c+++ Try to fix loss of octave with single gaft
+c
+ if (isgaft) then
+ itrans = 0
+ do 1 i = 1 , lnotenGA
+ if (noteqGA(i:i) .eq. chax(39)) then
+ itrans = itrans+7
+ else if (noteqGA(i:i) .eq. chax(96)) then
+ itrans = itrans-7
+ end if
+1 continue
+ if (itrans. eq. -14) then
+ call addstr(sq//'advance'//sq//'transpose-14',21,
+ * soutq,lsout)
+ else if (itrans .eq. -7) then
+ call addstr(sq//'advance'//sq//'transpose-7',20,
+ * soutq,lsout)
+ else if (itrans .eq. 7) then
+ call addstr(sq//'advance'//sq//'transpose7',19,
+ * soutq,lsout)
+ else if (itrans .eq. 14) then
+ call addstr(sq//'advance'//sq//'transpose14',20,
+ * soutq,lsout)
+ end if
+ end if
+ else
+c
+c Multiple grace. Put in literally. Compute beam stuff
+c
+ sumx = 0.
+ sumy = 0.
+ sumxy = 0.
+ sumxx = 0.
+ sumyy = 0.
+ x = 0.
+ do 118 ing = ngs , ngs+nng(ig)-1
+ if (ing.gt.ngs .and. naccg(ing).gt.0) x = x+acgfac
+ y = nolevg(ing)
+ sumx = sumx + x
+ sumy = sumy + y
+ sumxy = sumxy + x*y
+ sumxx = sumxx + x*x
+ sumyy = sumyy + y*y
+ x = x+emgfac
+118 continue
+ delta = nng(ig)*sumxx-sumx*sumx
+ em = (nng(ig)*sumxy-sumx*sumy)/delta
+ islope = nint(0.5*em*gslfac)
+ if (iabs(islope) .gt. 9) islope = isign(9,islope)
+ beta = (sumy-islope/gslfac*sumx)/nng(ig)
+ nolev1 = nint(beta)
+c
+c Back up
+c
+ notexq = sq//'settiny'//sq//'off{'
+ if (normsp) then
+ write(notexq(14:18),'(a1,f4.1)')'-',ptgr(ig)
+ call addstr(notexq(1:18)//'pt}',21,soutq,lsout)
+ finalshift = ptgr(ig)
+ else
+ aftshft = wheadpt*1.33
+ if (naccg(ngstrt(ig)).gt.0) aftshft = aftshft+wheadpt*0.5
+ write(notexq(14:17),'(f4.1)')aftshft
+ call addstr(notexq(1:17)//'pt}'//sq//'bsk',24,soutq,lsout)
+ end if
+c
+c Start the beam
+c
+ notexq = sq//'ib'
+ do 119 ing = 2 , mg
+ notexq = notexq(1:ing+1)//'b'
+119 continue
+ if (upg(ig)) then
+ notexq = notexq(1:mg+2)//'u'
+ else
+ notexq = notexq(1:mg+2)//'l'
+ end if
+ notexq = notexq(1:mg+3)//'0'
+c
+c Get starting note for beam
+c
+ call notefq(noteq,lnoten,nolev1,ncm)
+ call addstr(notexq(1:mg+4)//noteq(1:lnoten),
+ * mg+4+lnoten,soutq,lsout)
+c
+c Put in the slope
+c
+ if (islope .ge. 0) then
+ call addstr(chax(48+islope),1,soutq,lsout)
+ else
+ call addstr('{-'//chax(48-islope)//'}',4,soutq,lsout)
+ end if
+c
+c Start a slur on multiple fore-grace
+c
+ if (slurg(ig) .and. .not.isgaft .and. .not.iswaft) then
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+ if (fontslur) then
+ if (upg(ig)) then
+ call addstr(sq//'islurd',7,soutq,lsout)
+ else
+ call addstr(sq//'isluru',7,soutq,lsout)
+ end if
+ else
+c
+c Need a tweak for postscript slur
+c
+ if (upg(ig)) then
+ call addstr(sq//'isd',4,soutq,lsout)
+ else
+ call addstr(sq//'isu',4,soutq,lsout)
+ end if
+ end if
+c
+c Print 23-ndxslur
+c
+ if (23-ndxslur .lt. 10) then
+ call addstr(chax(71-ndxslur)//noteq(1:lnoten),1+lnoten,
+ * soutq,lsout)
+ else if (23-ndxslur .lt. 2) then
+ call addstr('{1'//chax(61-ndxslur)//'}'//noteq(1:lnoten),
+ * 4+lnoten,soutq,lsout)
+ else
+ call addstr('{1'//chax(51-ndxslur)//'}'//noteq(1:lnoten),
+ * 4+lnoten,soutq,lsout)
+ end if
+c
+c Put in tweak for postscript slur
+c
+ if (.not.fontslur) call addstr('{-.3}',5,soutq,lsout)
+ end if
+c
+c Put in first note. Call notefq again in case octave changed
+c
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+ if (naccg(ngs) .eq. 0) then
+ notexq = sq//'zqb0'//noteq(1:lnoten)
+ lnote = 5+lnoten
+ else
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ call accsym(naccg(ngs),acsymq,lacc)
+ notexq = sq//'big'//acsymq(1:lacc)//noteq(1:lnoten)
+ lnote = 4+lacc+lnoten
+ call notefq(noteq,lnoten,nolevg(ngs),ncm)
+ notexq =notexq(1:lnote)//sq//'zqb0'//noteq(1:lnoten)
+ lnote = lnote+5+lnoten
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+ do 127 ing = ngs+1 , ngs+nng(ig)-1
+c
+c Skip
+c
+ ptoff = wheadpt1*emgfac
+ if (naccg(ing).gt.0) ptoff = ptoff+wheadpt1*acgfac
+ if (isgaft .and. .not.iswaft) aftshft = aftshft+ptoff
+ notexq = sq//'off{'
+ write(notexq(6:8),'(f3.1)')ptoff
+ if (normsp) finalshift = finalshift-ptoff
+ call addstr(notexq(1:8)//'pt}',11,soutq,lsout)
+ if (ing .eq. ngs+nng(ig)-1) then
+c
+c Terminate beam if needed
+c
+ if (upg(ig)) then
+ call addstr(sq//'tbu0',5,soutq,lsout)
+ else
+ call addstr(sq//'tbl0',5,soutq,lsout)
+ end if
+c
+c Terminate after slur if needed
+c
+ if ((isgaft.or.iswaft) .and. slurg(ig)) then
+c if (iswaft) ndxslur = igetbits(ipl,4,23)
+ if (iswaft) ndxslur = igetbits(ipl,5,23)
+ call notefq(noteq,lnoten,nolevg(ing),ncm)
+ call addstr(sq//'tslur',6,soutq,lsout)
+c
+c Print 11-ndxslur
+cc Print 23-ndxslur
+c
+ if (23-ndxslur .lt. 10) then
+ call addstr(chax(71-ndxslur)//noteq(1:lnoten),
+ * 1+lnoten,soutq,lsout)
+ else if (23-ndxslur .lt. 20) then
+ call addstr('{2'//chax(61-ndxslur)//'}'
+ * //noteq(1:lnoten),4+lnoten,soutq,lsout)
+ else
+ call addstr('{1'//chax(51-ndxslur)//'}'
+ * //noteq(1:lnoten),4+lnoten,soutq,lsout)
+ end if
+c
+c Stop slur terminator after exit from this subroutine
+c
+ listslur = ibclr(listslur,ndxslur)
+ slurg(ig) = .false.
+ end if
+ end if
+c
+c Accidental if needed
+c
+ if (naccg(ing).gt.0) then
+ call notefq(noteq,lnoten,nolevg(ing),ncm)
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ call accsym(naccg(ing),acsymq,lacc)
+ call addstr(sq//'big'//acsymq(1:lacc)
+ * //noteq(1:lnoten),4+lacc+lnoten,soutq,lsout)
+ end if
+c
+c Put in the (beamed) grace note
+c
+ call notefq(noteq,lnoten,nolevg(ing),ncm)
+ call addstr(sq//'zqb0'//noteq(1:lnoten),5+lnoten,
+ * soutq,lsout)
+127 continue
+c
+c Terminate the grace
+c
+c notexq = sq//'normalnotesize'//sq//'off{'
+c lnote = 20
+c notexq = '}'//sq//'off{'
+c lnote = 6
+ notexq = sq//'off{'
+ lnote = 5
+ ptoff = wheadpt*emgfac
+ if (iand(nacc,3).gt.0 .and. .not.btest(nacc,17))
+ * ptoff = ptoff+wheadpt*accfac
+ if (isgaft .and. .not.iswaft) then
+ notexq = notexq(1:5)//'-'
+ lnote = 6
+ ptoff = aftshft
+ end if
+ if (normsp) ptoff = finalshift
+ if (ptoff .lt. 9.95) then
+ write(notexq(lnote+1:lnote+3),'(f3.1)')ptoff
+ lnote = lnote+3
+ else if (ptoff .lt. 99.95) then
+ write(notexq(lnote+1:lnote+4),'(f4.1)')ptoff
+ lnote = lnote+4
+ else
+ write(notexq(lnote+1:lnote+5),'(f5.1)')ptoff
+ lnote = lnote+5
+ end if
+ call addstr(notexq(1:lnote)//'pt}',lnote+3,soutq,lsout)
+ if (isgaft.and..not.iswaft) call addstr(sq//'sk',3,soutq,lsout)
+ call addstr(sq//'resetsize',10,soutq,lsout)
+ end if
+ return
+ end
+ subroutine dopsslur(nolev,isdat1,isdat2,isdat3,isdat4,nsdat,ip,
+ * iv,kv,nv,beamon,ncm,soutq,lsout,ulq,islur,
+ * ipl,iornq,islhgt,tno,nacc)
+c
+c Called once per main note.
+c 12 May 2002 Create this subroutine to isolate postscript slurs/ties.
+c Always set \Nosluradjust\Notieadjust
+c
+ parameter (nm=24,mv=24576)
+ integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /comsln/ is1n1,is2n1,irzbnd,isnx
+ character*1 ulq,slurudq,udfq,udqq,chax
+ character*79 notexq
+ character*8 noteq
+ character*80 soutq
+ logical upslur,beamon,btest,stemup,iscrd,
+ * settie,fontslur,pstie,WrotePsslurDefaults
+ logical slmon,dbltie
+ common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
+ * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
+ * slmon(0:nm),dbltie
+ integer*2 mmidi,iinsiv
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+c 130316
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+c
+c Bits in isdat1:
+c 13-17 iv
+c 3-10 ip
+c 11 start/stop switch
+c 12 kv-1
+c 19-25 ichar(code$)
+c 26 force direction?
+
+c 27 forced dir'n = up if on, set in sslur; also
+c final direction, set in doslur when beam is started, used on term.
+c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term.
+c 18 int(ndxslur/16), ditto. So this allows ndxslur>15.
+c 2 stem slur flag
+c 1 flag for "x" slur (voice-independent)
+c
+c Bits in isdat2
+c 0 Chord switch. Not set on main note.
+c 1-2 left/right notehead shift. Set only for chord note.
+c 3 tie positioning
+c 4 dotted flag
+c 6-11 voff1 1-63 => -31...+31
+c 12-18 hoff1 1-127 => -6.3...+6.3
+c 19-25 nolev
+c 26 \sluradjust (p+s)
+c 27 \nosluradjust (p-s)
+c 28 \tieadjust (p+t)
+c 29 \notieadjust (p-t)
+c
+c Bits in isdat3: Only used for slur endings
+c 0 set if midslur (at least one argument)
+c 1 set if curve (2 more args)
+c 2-7 32+first arg (height correction) (1st arg may be negative)
+c 8-10 second arg (initial slope)
+c 11-13 third arg (closing slope)
+c 14-21 tie level for use in LineBreakTies
+c 22-29 ncm for use in LineBreakTies
+c
+c Bits in isdat4 Only used for linebreak slurs
+c 0-5 Linebreak seg 1 voff 1-63 => -31...+31
+c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3
+c 16-21 Linebreak seg 2 voff 1-63 => -31...+31
+c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3
+c
+c In listslur bit ib is on if slur index ib is in use, ib=0-13.
+c ndxslur = slur index
+c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note,
+c s-slur is blank (idcode=32), t-slur is idcode=1.
+c ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
+c Ivoff will be set for ./_ only if no user-defined shift is specified.
+c If highest note has upslur, save slur height in islhgt in case
+c ornament must be moved.
+c
+ islhgt = 0
+ if (beamon) then
+ stemup = ulq .eq. 'u'
+ else if (nvmx(iv) .eq. 2) then
+ if (.not.btest(islur,30)) then
+c
+c Single note, 2 lines of music, stem direction not forced
+c
+ stemup = ivx .gt. nv
+ else
+ stemup = btest(islur,17)
+ end if
+ else
+ stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
+ end if
+ iscrd = btest(ipl,10)
+ if (ismidi) then
+ settie = .false.
+ dbltie = .false.
+ end if
+ do 1 isdat = 1 , nsdat
+ isdata = isdat1(isdat)
+ if (iv .eq. igetbits(isdata,5,13) .and.
+ * ip .eq. igetbits(isdata,8,3) .and.
+c * kv .eq. igetbits(isdata,1,12)+1) then
+ * (kv .eq. igetbits(isdata,1,12)+1 .or.
+ * btest(isdata,1))) then
+c
+c Since iv and kv match, ivx will be correct
+c
+ idcode = igetbits(isdata,7,19)
+ ivoff = igetbits(isdat2(isdat),6,6)-32
+ ihoff = igetbits(isdat2(isdat),7,12)-64
+ iupdn = 0
+ slurudq = 'd'
+ nolevs = igetbits(isdat2(isdat),7,19)
+ pstie = btest(isdat2(isdat),3) .or. idcode.eq.1
+ if (btest(isdata,11)) then
+c
+c Turnon
+c Get slur direction
+c
+ if (btest(isdata,26)) then
+c
+c Force slur direction
+c
+ if (btest(isdata,27)) slurudq = 'u'
+ else if (nvmx(iv) .eq. 1) then
+c
+c Only one voice per line
+c
+ if (.not.beamon) then
+c
+c Separate note.
+c
+ slurudq = udfq(nolev,ncm)
+ else
+c
+c In a beam
+c
+ if (ulq .ne. 'u') slurudq = 'u'
+ end if
+ if (iscrd) then
+ if (nolevs .gt. ncm) then
+ slurudq = 'u'
+ else
+ slurudq = 'd'
+ end if
+ end if
+ else
+c
+c Two voices per line. Get default
+c
+ if (ivx .gt. nv) slurudq = 'u'
+c
+c Upper voice of the two, so up slur
+c
+ end if
+ if (btest(isdata,2)) then
+c
+c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment.
+c
+ if (stemup) then
+ slurudq = 'u'
+ ivoff = ivoff+4
+ else
+ slurudq = 'd'
+ ivoff = ivoff-4
+ end if
+ end if
+c
+c Set level for slur starting on rest
+c
+ if (nolevs.eq.0 .or. nolevs.gt.60) then
+ if (slurudq .eq. 'u') then
+ nolevs = ncm+2
+ else
+ nolevs = ncm-2
+ end if
+ end if
+c
+c Save up/down-ness for use at termination
+c
+ if (slurudq .eq. 'u') isdata = ibset(isdata,27)
+c
+c End of section for setting slur direction, still in "Turnon" if-block.
+c
+ if (btest(iornq,11).or.btest(iornq,12)) then
+c
+c Raise or lower slur by one unit provided . or _ is on same side as slur
+c
+ ivoffinc = 0
+ if ((stemup .and. slurudq.eq.'d') .or.
+ * (.not.stemup .and. slurudq.eq.'u')) then
+c
+c Must move the slur for _ or .
+c
+ if (stemup) then
+ ivoffinc = -1
+ else
+ ivoffinc = 1
+ end if
+ if (((stemup .and. nolev.ge.ncm-2) .or.
+ * (.not.stemup .and. nolev.le.ncm+2)) .and.
+ * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
+ ivoff = ivoff+ivoffinc
+ end if
+ end if
+ if (listslur .eq. 16777215) then
+ print*
+ print*,'You1 defined the twentyfifth slur, one too many!'
+ write(15,'(/,a)')
+ * 'You defined the twentyfifth slur, one too many!'
+ call stop1()
+ end if
+c
+c Get index of next slur not in use, starting from 12 down
+c
+ ndxslur = log2(16777215-listslur)
+c
+c Record slur index
+c
+ listslur = ibset(listslur,ndxslur)
+c
+c Save for use on termination
+c
+c call setbits(isdata,4,28,ndxslur)
+c 080531 Allow >16 slurs
+ call setbits(isdata,4,28,mod(ndxslur,16))
+ call setbits(isdata,1,18,ndxslur/16)
+c
+c Shift for stem?
+c
+ if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.) then
+ if (.not.pstie) then
+ ihoff = ihoff+8
+ else
+ ihoff = ihoff+2
+ end if
+ end if
+ if (iscrd) then
+c
+c Additional horiz shifts for h-shifted noteheads?
+c
+ if (btest(isdat2(isdat),1)) then
+c
+c Slur start on left-shifted chord notehead. ASSUME downstem.
+c
+ if (nolevs.eq.minlev .and. slurudq.eq.'d') then
+ ihoff = ihoff-2
+ else
+ ihoff = ihoff-10
+ end if
+ else if (btest(isdat2(isdat),2)) then
+c
+c Right shifted chord notehead. ASSUME upstem.
+c
+ if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
+ ihoff = ihoff+2
+ else
+ ihoff = ihoff+10
+ end if
+ end if
+ end if
+ notexq = chax(92)
+ lnote = 1
+c
+c Check for local adjustment default changes
+c
+ if (btest(isdat2(isdat),26)) then
+ notexq = chax(92)//'sluradjust'//chax(92)
+ lnote = 12
+ else if (btest(isdat2(isdat),27)) then
+ notexq = chax(92)//'nosluradjust'//chax(92)
+ lnote = 14
+ else if (btest(isdat2(isdat),28)) then
+ notexq = chax(92)//'tieadjust'//chax(92)
+ lnote = 11
+ else if (btest(isdat2(isdat),29)) then
+ notexq = chax(92)//'notieadjust'//chax(92)
+ lnote = 13
+ end if
+ if (ihoff .eq. 0) then
+c
+c Write stuff for non-shifted start
+c
+ notexq = notexq(1:lnote)//'islur'//slurudq
+ lnote = lnote+6
+ else
+ notexq = notexq(1:lnote)//'is'//slurudq
+ lnote = lnote+3
+ end if
+c
+c Prepend postscript tie switch
+c
+ if (pstie) then
+ notexq = chax(92)//'tieforis'//slurudq//notexq(1:lnote)
+ lnote = lnote+10
+ end if
+ if (btest(isdat2(isdat),4)) then
+c
+c Dotted slur
+c
+c noteq = notexq
+c notexq = chax(92)//'dotted'//noteq
+ notexq = chax(92)//'dotted'//notexq(1:lnote)
+ lnote = lnote+7
+ end if
+c
+c Add slur index to string
+c Print 23-ndxslur
+c
+ if (23-ndxslur .lt. 10) then
+c
+c 5/25/08 Allow 24 slurs
+c
+ notexq = notexq(1:lnote)//chax(71-ndxslur)
+ lnote = lnote+1
+ else if (23-ndxslur .lt. 20) then
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = lnote+4
+ end if
+c
+c Add note name to string
+c
+ islhgt = nolevs+iupdn+ivoff
+ call notefq(noteq,lnoten,islhgt,ncm)
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+c
+c Store height and staff mid level for use with LineBreakTies
+c
+ call setbits(isdat3(isdat),8,14,islhgt)
+ call setbits(isdat3(isdat),8,22,ncm)
+c
+c Save height (for ornament and barnobox interference) if topmost slur is up
+c
+ if (slurudq.eq.'u' .and.
+ * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
+ islhgt = nolevs+iupdn+ivoff
+c
+c Save height & idcode if top voice and slur start
+c
+ if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
+ is1n1 = islhgt
+ is2n1 = idcode
+ end if
+ end if
+ if (ihoff .ne. 0.) then
+ shift = ihoff*0.1
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ lform = lfmt1(shift)
+ write(notexq(lnote+1:lnote+lform),'(f'//
+ * chax(48+lform)//'.1)') shift
+ lnote = lnote+lform
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+c
+c Zero out ip1 to avoid problems if slur goes to next input blk.
+c
+ call setbits(isdata,8,3,0)
+c
+c Set slur-on data for midi. Only treat null-index slurs and ps ties for now.
+c
+ if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
+c levson(midchan(iv,kv)) = nolevs
+c 130316
+ levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
+ if (settie) dbltie = .true.
+c
+c Only way settie=T is if we just set a tie ending. So there's also a slur
+c start here, so set a flag telling addmidi not to zero out levson
+c
+ end if
+ else
+c
+c Slur is ending. Back thru list to find starting slur
+c
+ do 3 j = isdat-1 , 1 , -1
+ if (iv.eq.igetbits(isdat1(j),5,13) .and.
+c * kv.eq.igetbits(isdat1(j),1,12)+1) then
+ * (kv.eq.igetbits(isdat1(j),1,12)+1
+ * .or. btest(isdat1(j),1))) then
+ if (idcode .eq. igetbits(isdat1(j),7,19)) then
+ ndxslur = igetbits(isdat1(j),4,28)
+c
+c 080531 Allow >16 slurs
+c
+ * +16*igetbits(isdat1(j),1,18)
+ if (btest(isdat1(j),27)) slurudq = 'u'
+ go to 4
+ end if
+ end if
+3 continue
+ print*,'Bad place in doslur'
+ call stop1()
+4 continue
+c
+c Bugfix 070901 for slur ending on rest in 2-voice staff
+c
+ if (nolevs.le.2 .or. nolevs.gt.60) then
+c
+c Ending is on a rest, reset nolevs to default starting height
+c
+ nolevs = igetbits(isdat2(j),7,19)
+ end if
+ if (btest(isdat3(isdat),0) .or. btest(isdat3(j),0)) then
+c
+c Deal with \curve or \midslur. isdat is ending, j is start.
+c
+ if (btest(isdat3(isdat),0)) then
+ imid = igetbits(isdat3(isdat),6,2)-32
+ else
+ imid = igetbits(isdat3(j),6,2)-32
+ end if
+c
+c Postscript slurs, and \midslur adjustment is needed. Invoke macro
+c (from pmx.tex) that redefines \tslur as r'qd. Tentative mapping:
+c Abs(imid) Postscript slur type
+c 1 f
+c 2-3 default
+c 4 h
+c 5 H
+c 6+ HH
+c
+ call addstr(chax(92)//'psforts'//
+ * chax(48+min(abs(imid),6)),9,soutq,lsout)
+ end if
+ if (btest(isdata,2)) then
+c
+c ADjust for stem slur.
+c
+ if (stemup) then
+ slurudq = 'u'
+ ivoff = ivoff+4
+ else
+ slurudq = 'd'
+ ivoff = ivoff-4
+ end if
+ end if
+c
+c Shift slur ending for stem on any note?
+c
+ if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.) then
+ if (.not.pstie) then
+ ihoff = ihoff-8
+ else
+ ihoff = ihoff-3
+ end if
+ end if
+ if (iscrd) then
+c
+c Shift termination for shifted notehead?
+c
+ if (btest(isdat2(isdat),1)) then
+c
+c Left-shifted chord notehead. ASSUME downstem.
+c
+ if (nolevs.eq.minlev .and. slurudq.eq.'d') then
+ ihoff = ihoff-2
+ else
+ ihoff = ihoff-10
+ end if
+ else if (btest(isdat2(isdat),2)) then
+c
+c Right shifted chord notehead. ASSUME upstem.
+c
+ if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
+ ihoff = ihoff+2
+ else
+ ihoff = ihoff+10
+ end if
+ end if
+ end if
+ if (ihoff .eq. 0) then
+ notexq = chax(92)//'tslur'
+ lnote = 6
+ else
+c
+c Shift needed
+c
+ notexq = chax(92)//'ts'
+ lnote = 3
+ end if
+c
+c Switch to postscript tie
+c
+ if (pstie) then
+ notexq = chax(92)//'tieforts'//notexq(1:lnote)
+ lnote = lnote+9
+ end if
+c
+c Print 13-ndxslur
+c 5/25/08 Allow 14 slurs
+c
+ if (23-ndxslur .lt. 10) then
+ notexq = notexq(1:lnote)//chax(71-ndxslur)
+ lnote = lnote+1
+ else if (23-ndxslur .lt. 20) then
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = lnote+4
+ end if
+ if (btest(iornq,11).or.btest(iornq,12)) then
+c
+c Raise or lower slur by one unit provided . or _ is on same side as slur
+c
+ ivoffinc = 0
+ if ((stemup .and. slurudq.eq.'d') .or.
+ * (.not.stemup .and. slurudq.eq.'u')) then
+ if (stemup) then
+ ivoffinc = -1
+ else
+ ivoffinc = 1
+ end if
+ if (((stemup .and. nolev.ge.ncm-2) .or.
+ * (.not.stemup .and. nolev.le.ncm+2)) .and.
+ * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
+ end if
+ ivoff = ivoff+ivoffinc
+ end if
+ call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
+ if (slurudq.eq.'u' .and.
+ * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
+ islhgt = nolevs+iupdn+ivoff
+c
+c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
+c
+ if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
+ if (idcode .eq. is2n1) is1n1=0
+ end if
+ end if
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (ihoff .ne. 0) then
+ shift = ihoff*0.1
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ lform = lfmt1(shift)
+ write(notexq(lnote+1:lnote+lform),
+ * '(f'//chax(48+lform)//'.1)')shift
+ lnote = lnote+lform
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+c
+c Clear the bit from list of slurs in use
+c
+ listslur = ibclr(listslur,ndxslur)
+c
+c Zero out the entire strings for start and stop
+c
+ isdata = 0
+ isdat2(isdat) = 0
+ isdat3(isdat) = 0
+ isdat4(isdat) = 0
+ isdat1(j) = 0
+ isdat2(j) = 0
+ isdat3(j) = 0
+ isdat4(j) = 0
+c
+c Set midi info for slur ending
+c
+ if (ismidi .and. (idcode.eq.32 .or. idcode.eq.1)) then
+ icm = midchan(iv,kv)
+ if (slmon(icm)) then
+ if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
+ * iand(7,nacc).eq.0) then
+c
+c There is a tie here. NB!!! assumed no accidental on 2nd member of tie.
+c
+ levsoff(icm) = nolevs+miditran(instno(iv))
+ settie = .true.
+ else
+ levsoff(icm) = 0
+ levson(icm) = 0
+ slmon(icm) = .false.
+ end if
+ end if
+ end if
+ end if
+ isdat1(isdat) = isdata
+ end if
+1 continue
+c
+c Clear and collapse the slur data list
+c
+ numdrop = 0
+ do 2 isdat = 1 , nsdat
+ if (isdat1(isdat) .eq. 0) then
+ numdrop = numdrop+1
+ else if (numdrop .gt. 0) then
+ isdat1(isdat-numdrop) = isdat1(isdat)
+ isdat2(isdat-numdrop) = isdat2(isdat)
+ isdat3(isdat-numdrop) = isdat3(isdat)
+ isdat4(isdat-numdrop) = isdat4(isdat)
+ isdat1(isdat) = 0
+ isdat2(isdat) = 0
+ isdat3(isdat) = 0
+ isdat4(isdat) = 0
+ end if
+2 continue
+ nsdat = nsdat-numdrop
+c call report(nsdat,isdat1,isdat2)
+ return
+ end
+ subroutine doslur(nolev,isdat1,isdat2,isdat3,nsdat,ip,iv,kv,nv,
+ * beamon,ncm,soutq,lsout,ulq,islur,ipl,iornq,islhgt,tno,nacc)
+c
+c Called once per main note. (5/26/02) for non-ps slurs only
+c
+ parameter (nm=24,mv=24576)
+ integer*4 isdat1(202),isdat2(202),isdat3(202)
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /comsln/ is1n1,is2n1,irzbnd,isnx
+ character*1 ulq,slurudq,udfq,udqq,chax
+ character*79 notexq
+ character*8 noteq
+ character*80 soutq
+ logical upslur,beamon,btest,stemup,iscrd,sfound,tfound,tmove,
+ * settie,fontslur,WrotePsslurDefaults
+ logical slmon,dbltie
+ common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
+ * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
+ * slmon(0:nm),dbltie
+ integer*2 mmidi,iinsiv
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+c 130316
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+c
+c Bits in isdat1:
+c 13-17 iv
+c 3-10 ip
+c 11 start/stop switch
+c 12 kv-1
+c 19-25 ichar(code$)
+c 26 force direction?
+c 27 forced dir'n = up if on, set in sslur; also
+c final direction, set in doslur when beam is started, used on term.
+c 28-31 ndxslur, set in doslur when beam is started, used on term.
+c
+c Bits in isdat2
+c 0 Chord switch. Not set on main note.
+c 1-2 left/right notehead shift. Set only for chord note.
+c 3 tie positioning
+c 4 dotted flag
+c 6-11 voff1 1-63 => -31...+31
+c 12-18 hoff1 1-127 => -6.3...+6.3
+c 19-25 nolev
+c
+c Bits in isdat3: Only used for slur endings
+c 0 set if midslur (at least one argument)
+c 1 set if curve (2 more args)
+c 2-7 32+first arg (height correction) (1st arg may be negative)
+c 8-10 second arg (initial slope)
+c 11-13 third arg (closing slope)
+c
+c In listslur bit ib is on if slur index ib is in use, ib=0-23.
+c ndxslur = slur index
+c Height of slur is nole+ivoff+iupdn. iupdn is +/-1 if t&s slurs on same note,
+c s-slur is blank (idcode=32), t-slur is idcode=1.
+c ivoff is user-defined shift or shift due to . or _ , or chord adjustment.
+c Ivoff will be set for ./_ only if no user-defined shift is specified.
+c If highest note has upslur, save slur height in islhgt in case
+c ornament must be moved.
+c
+ islhgt = 0
+ if (beamon) then
+ stemup = ulq .eq. 'u'
+ else if (nvmx(iv) .eq. 2) then
+ if (.not.btest(islur,30)) then
+c
+c Single note, 2 lines of music, stem direction not forced
+c
+ stemup = ivx .gt. nv
+ else
+ stemup = btest(islur,17)
+ end if
+ else
+ stemup = udqq(nolev,ncm,islur,nvmx(iv),ivx,nv) .eq. 'u'
+ end if
+ iscrd = btest(ipl,10)
+ if (btest(islur,1)) then
+c
+c 't'-slur (idcode=1) somewhere on this note. Find it, check height against
+c 's'-slur (idcode=32)
+c
+ sfound = .false.
+ tfound = .false.
+ tmove = .false.
+ do 5 isdat = 1 , nsdat
+ if (iv .eq. igetbits(isdat1(isdat),5,13) .and.
+ * ip .eq. igetbits(isdat1(isdat),8,3) .and.
+ * kv .eq. igetbits(isdat1(isdat),1,12)+1) then
+ if (.not.tfound) then
+ tfound = igetbits(isdat1(isdat),7,19).eq.1
+ if (tfound) then
+ nolevt = igetbits(isdat2(isdat),7,19)
+ isdatt = isdat
+ if (sfound) go to 6
+ end if
+ end if
+ if (.not.sfound) then
+ sfound = igetbits(isdat1(isdat),7,19).eq.32
+ if (sfound) then
+ nolevs = igetbits(isdat2(isdat),7,19)
+ isdats = isdat
+ if (tfound) go to 6
+ end if
+ end if
+ end if
+5 continue
+c
+c Will come thru here if there is a t with no s, so comment out the following
+c print*,'Did not find s+t-slurs in doslur'
+c
+6 continue
+ if (sfound .and. tfound)
+ * tmove = nolevs.eq.nolevt .and.
+c
+c Check if 2 starts or two stops
+c
+ * ((btest(isdat1(isdats),11).and.btest(isdat1(isdatt),11)) .or.
+ * (.not.btest(isdat1(isdats),11).and.
+ * .not.btest(isdat1(isdatt),11)) )
+c
+c This is a flag for later changing slur level, after we know slur dir'n.
+c
+ end if
+ if (ismidi) then
+ settie = .false.
+ dbltie = .false.
+ end if
+ do 1 isdat = 1 , nsdat
+ isdata = isdat1(isdat)
+ if (iv .eq. igetbits(isdata,5,13) .and.
+ * ip .eq. igetbits(isdata,8,3) .and.
+ * kv .eq. igetbits(isdata,1,12)+1) then
+c
+c Since iv and kv match, ivx will be correct
+c
+ idcode = igetbits(isdata,7,19)
+ ivoff = igetbits(isdat2(isdat),6,6)-32
+ ihoff = igetbits(isdat2(isdat),7,12)-64
+ iupdn = 0
+ slurudq = 'd'
+ nolevs = igetbits(isdat2(isdat),7,19)
+ if (btest(isdata,11)) then
+c
+c Turnon,
+c
+ if (nolevs.eq.0 .or. nolevs.gt.60) then
+c
+c Note was a rest, cannot start slur on rest.
+c
+ print*
+ call printl('Cannot start slur on a rest')
+ call stop1()
+ end if
+c
+c Get slur direction
+c
+ if (btest(isdata,26)) then
+c
+c Force slur direction
+c
+ if (btest(isdata,27)) slurudq = 'u'
+ else if (nvmx(iv) .eq. 1) then
+c
+c Only one voice per line
+c
+ if (.not.beamon) then
+c
+c Separate note.
+c
+ slurudq = udfq(nolev,ncm)
+ else
+c
+c In a beam
+c
+ if (ulq .ne. 'u') slurudq = 'u'
+ end if
+ if (iscrd) then
+ if (nolevs .gt. ncm) then
+ slurudq = 'u'
+ else
+ slurudq = 'd'
+ end if
+ end if
+ else
+c
+c Two voices per line. Get default
+c
+ if (ivx .gt. nv) slurudq = 'u'
+c
+c Upper voice of the two, so up slur
+c
+ end if
+c
+c Save up/down-ness for use at termination
+c
+ if (slurudq .eq. 'u') isdata = ibset(isdata,27)
+c
+c End of section for setting slur direction, still in "Turnon" if-block.
+c
+ if (idcode.eq.1 .and. tmove) then
+ iupdn = 1
+ if (slurudq .eq. 'd') iupdn = -1
+ end if
+ if (btest(iornq,11).or.btest(iornq,12)) then
+c
+c Raise or lower slur by one unit provided . or _ is on same side as slur
+c
+ ivoffinc = 0
+ if ((stemup .and. slurudq.eq.'d') .or.
+ * (.not.stemup .and. slurudq.eq.'u')) then
+c
+c Must move the slur for _ or .
+c
+ if (stemup) then
+ ivoffinc = -1
+ else
+ ivoffinc = 1
+ end if
+ if (((stemup .and. nolev.ge.ncm-2) .or.
+ * (.not.stemup .and. nolev.le.ncm+2)) .and.
+ * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
+ ivoff = ivoff+ivoffinc
+ end if
+ end if
+ if (listslur .eq. 16777215) then
+ print*
+ print*,'You1 defined the twenty-fifth slur, one too many!'
+ write(15,'(/,a)')
+ * 'You2 defined the twenty-fifth slur, one too many!'
+ call stop1()
+ end if
+c
+c Get index of next slur not in use, starting from ? down
+c
+ ndxslur = log2(16777215-listslur)
+c
+c Record slur index
+c
+ listslur = ibset(listslur,ndxslur)
+c
+c Save for use on termination
+c
+c call setbits(isdata,4,28,ndxslur)
+c 080531 Allow >16 slurs
+ call setbits(isdata,4,28,mod(ndxslur,16))
+ call setbits(isdata,1,18,ndxslur/16)
+c
+c Shift for stem?
+c
+ if (stemup .and. slurudq.eq.'u' .and. tno.lt.63.)
+ * ihoff = ihoff+8
+ if (btest(isdat2(isdat),3)) then
+c
+c Tie spacing, (slur start)
+c
+ if (slurudq.eq.'d') then
+ ivoff = ivoff+1
+ ihoff = ihoff+8
+ else if (slurudq.eq.'u') then
+ ivoff = ivoff-1
+ if (.not.(stemup.and.tno.lt.63.)) ihoff = ihoff+8
+c
+c (already shifted if (stemup.and.tno.gt.63.) and slurudq='u')
+c
+ end if
+ end if
+ if (iscrd) then
+c
+c Additional horiz shifts for h-shifted noteheads?
+c
+ if (btest(isdat2(isdat),1)) then
+c
+c Slur start on left-shifted chord notehead. ASSUME downstem.
+c
+ if (nolevs.eq.minlev .and. slurudq.eq.'d') then
+ ihoff = ihoff-2
+ else
+ ihoff = ihoff-10
+ end if
+ else if (btest(isdat2(isdat),2)) then
+c
+c Right shifted chord notehead. ASSUME upstem.
+c
+ if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
+ ihoff = ihoff+2
+ else
+ ihoff = ihoff+10
+ end if
+ end if
+ end if
+ if (ihoff .eq. 0) then
+c
+c Write stuff for non-shifted start
+c
+ notexq = chax(92)//'islur'//slurudq
+ lnote = 7
+ else
+ notexq = chax(92)//'is'//slurudq
+ lnote = 4
+ end if
+ if (btest(isdat2(isdat),4)) then
+c
+c Dotted slur
+c
+ noteq(1:8) = notexq
+ notexq = chax(92)//'dotted'//noteq
+ lnote = lnote+7
+ end if
+c
+c Add slur index to string
+cc Print 11-ndxslur
+c Print 23-ndxslur
+c
+c if (11-ndxslur .lt. 10) then
+ if (23-ndxslur .lt. 10) then
+c
+c 5/25/08 Allow 24 slurs
+c
+c notexq = notexq(1:lnote)//chax(59-ndxslur)
+ notexq = notexq(1:lnote)//chax(71-ndxslur)
+ lnote = lnote+1
+ else if (23-ndxslur .lt. 20) then
+c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = lnote+4
+ end if
+c
+c Add note name to string
+c
+ call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+c
+c Save height (for ornament and barnobox interference) if topmost slur is up
+c
+ if (slurudq.eq.'u' .and.
+ * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
+ islhgt = nolevs+iupdn+ivoff
+c
+c Save height & idcode if top voice and slur start
+c
+ if (ivx.eq.ivmx(nv,nvmx(nv)) .and. islhgt.gt.is1n1) then
+ is1n1 = islhgt
+ is2n1 = idcode
+ end if
+ end if
+ if (ihoff .ne. 0.) then
+ shift = ihoff*0.1
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ lform = lfmt1(shift)
+ write(notexq(lnote+1:lnote+lform),'(f'//
+ * chax(48+lform)//'.1)') shift
+ lnote = lnote+lform
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+c
+c Zero out ip1 to avoid problems if slur goes to next input blk.
+c
+ call setbits(isdata,8,3,0)
+c
+c Set slur-on data for midi. Only treat null-index slurs and ps ties for now.
+c
+ if (ismidi .and. idcode.eq.32) then
+ levson(midchan(iv,kv)) = nolevs+miditran(instno(iv))
+ if (settie) dbltie = .true.
+c
+c Only way settie=T is if we just set a tie ending. So there's also a slur
+c start here, so set a flag telling addmidi not to zero out levson
+c
+ end if
+ else
+c
+c Slur is ending. Back thru list to find starting slur
+c
+ do 3 j = isdat-1 , 1 , -1
+ if (iv.eq.igetbits(isdat1(j),5,13) .and.
+ * kv.eq.igetbits(isdat1(j),1,12)+1) then
+ if (idcode .eq. igetbits(isdat1(j),7,19)) then
+ ndxslur = igetbits(isdat1(j),4,28)
+c
+c 080531 Allow >16 slurs
+c
+ * +16*igetbits(isdat1(j),1,18)
+ if (btest(isdat1(j),27)) slurudq = 'u'
+ go to 4
+ end if
+ end if
+3 continue
+ print*,'Bad place in doslur'
+ call stop1()
+4 continue
+ if (nolevs.eq.0 .or. nolevs.gt.60) then
+c
+c Ending is on a rest, reset nolevs to default starting height
+c
+ nolevs = igetbits(isdat2(j),7,19)
+ end if
+ if (btest(isdat3(isdat),0)) then
+c
+c Deal with \curve or \midslur
+c
+ imid = igetbits(isdat3(isdat),6,2)-32
+c
+c Remember, only dealing with non-ps slurs
+c
+c Who knows where the following line came from. Removed it 6/30/02 to
+c restore behavior of non-ps slurs to old way
+c if (slurudq .eq. 'd') imid = -imid
+c 3/8/03 added the following
+c
+ if (slurudq .eq. 'd') imid = -abs(imid)
+c
+ if (btest(isdat3(isdat),1)) then
+ notexq = chax(92)//'curve'
+ lnote = 6
+ else
+ notexq = chax(92)//'midslur'
+ lnote = 8
+ end if
+ if (imid.lt.0 .or. imid.gt.9) then
+c
+c Need brackets
+c
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ if (imid .lt. -9) then
+ write(notexq(lnote+1:lnote+3),'(i3)')imid
+ lnote = lnote+3
+ else if (imid.lt.0 .or. imid.gt.9) then
+ write(notexq(lnote+1:lnote+2),'(i2)')imid
+ lnote = lnote+2
+ else
+ write(notexq(lnote+1:lnote+1),'(i1)')imid
+ lnote = lnote+1
+ end if
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ else
+c
+c 1=<imid=<9, no brackets
+c
+ notexq = notexq(1:lnote)//char(48+imid)
+ lnote = lnote+1
+ end if
+ if (btest(isdat3(isdat),1)) then
+c
+c \curve; 3 args
+c
+ notexq = notexq(1:lnote)
+ * //char(48+igetbits(isdat3(isdat),3,8))
+ notexq = notexq(1:lnote+1)
+ * //char(48+igetbits(isdat3(isdat),3,11))
+ lnote = lnote+2
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+c
+c Shift slur ending for stem on any note?
+c
+ if (.not.stemup .and. slurudq.eq.'d' .and. tno.lt.63.)
+ * ihoff = ihoff-8
+ if (btest(isdat2(isdat),3)) then
+c
+c Shift ending for tie spacing
+c
+ if (slurudq .eq. 'u') then
+ ihoff = ihoff-8
+ ivoff = ivoff-1
+ else if (slurudq .eq. 'd') then
+ ivoff = ivoff+1
+ if (stemup.or. tno.gt.63.) ihoff = ihoff-8
+ end if
+ end if
+ if (iscrd) then
+c
+c Shift termination for shifted notehead?
+c
+ if (btest(isdat2(isdat),1)) then
+c
+c Left-shifted chord notehead. ASSUME downstem.
+c
+ if (nolevs.eq.minlev .and. slurudq.eq.'d') then
+ ihoff = ihoff-2
+ else
+ ihoff = ihoff-10
+ end if
+ else if (btest(isdat2(isdat),2)) then
+c
+c Right shifted chord notehead. ASSUME upstem.
+c
+ if (nolevs.eq.maxlev .and. slurudq.eq.'u') then
+ ihoff = ihoff+2
+ else
+ ihoff = ihoff+10
+ end if
+ end if
+ end if
+ if (ihoff .eq. 0) then
+ notexq = chax(92)//'tslur'
+ lnote = 6
+ else
+c
+c Shift needed
+c
+ notexq = chax(92)//'ts'
+ lnote = 3
+ end if
+c
+c Print 23-ndxslur
+c 5/25/08 Allow 14 slurs (???????????)
+c
+ if (23-ndxslur .lt. 10) then
+ notexq = notexq(1:lnote)//chax(71-ndxslur)
+ lnote = lnote+1
+ else if (23-ndxslur .lt. 20) then
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = lnote+4
+ end if
+ if (btest(iornq,11).or.btest(iornq,12)) then
+c
+c Raise or lower slur by one unit provided . or _ is on same side as slur
+c
+ ivoffinc = 0
+ if ((stemup .and. slurudq.eq.'d') .or.
+ * (.not.stemup .and. slurudq.eq.'u')) then
+ if (stemup) then
+ ivoffinc = -1
+ else
+ ivoffinc = 1
+ end if
+ if (((stemup .and. nolev.ge.ncm-2) .or.
+ * (.not.stemup .and. nolev.le.ncm+2)) .and.
+ * mod(abs(ncm-nolev),2).eq.0) ivoffinc = 2*ivoffinc
+ end if
+ ivoff = ivoff+ivoffinc
+ end if
+ if (idcode.eq.1 .and. tmove) then
+c
+c t-slur height adjustment
+c
+ iupdn = 1
+ if (slurudq .eq. 'd') iupdn = -1
+ end if
+ call notefq(noteq,lnoten,nolevs+iupdn+ivoff,ncm)
+ if (slurudq.eq.'u' .and.
+ * (.not.btest(isdat2(isdat),0).or.nolevs.eq.maxlev)) then
+ islhgt = nolevs+iupdn+ivoff
+c
+c If topvoice, upslur, and idcode checks, no more need to keep hgt for barno.
+c
+ if (ivx.eq.ivmx(nv,nvmx(nv)) .and. is1n1.gt.0) then
+ if (idcode .eq. is2n1) is1n1=0
+ end if
+ end if
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (ihoff .ne. 0) then
+ shift = ihoff*0.1
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ lform = lfmt1(shift)
+ write(notexq(lnote+1:lnote+lform),
+ * '(f'//chax(48+lform)//'.1)')shift
+ lnote = lnote+lform
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+c
+c Clear the bit from list of slurs in use
+c
+ listslur = ibclr(listslur,ndxslur)
+c
+c Zero out the entire strings for start and stop
+c
+ isdata = 0
+ isdat2(isdat) = 0
+ isdat1(j) = 0
+ isdat2(j) = 0
+ isdat3(isdat) = 0
+c
+c Set midi info for slur ending
+c
+ if (ismidi .and. idcode.eq.32) then
+ icm = midchan(iv,kv)
+ if (slmon(icm)) then
+ if (nolevs+miditran(instno(iv)).eq.levson(icm) .and.
+ * iand(7,nacc).eq.0) then
+c
+c There is a tie here. NB!!! assumed no accidental on 2nd member of tie.
+c
+ levsoff(icm) = nolevs+miditran(instno(iv))
+ settie = .true.
+ else
+ levsoff(icm) = 0
+ levson(icm) = 0
+ slmon(icm) = .false.
+ end if
+ end if
+ end if
+ end if
+ isdat1(isdat) = isdata
+ end if
+1 continue
+c
+c Clear and collapse the slur data list
+c
+ numdrop = 0
+ do 2 isdat = 1 , nsdat
+ if (isdat1(isdat) .eq. 0) then
+ numdrop = numdrop+1
+ else if (numdrop .gt. 0) then
+ isdat1(isdat-numdrop) = isdat1(isdat)
+ isdat2(isdat-numdrop) = isdat2(isdat)
+ isdat3(isdat-numdrop) = isdat3(isdat)
+ isdat1(isdat) = 0
+ isdat2(isdat) = 0
+ isdat3(isdat) = 0
+ end if
+2 continue
+ nsdat = nsdat-numdrop
+c call report(nsdat,isdat1,isdat2)
+ return
+ end
+ subroutine dotmov(updot,rtdot,soutq,lsout,iddot)
+c
+c iddot = 0 for single dot, 1 for double
+c
+ character*80 soutq,notexq
+ character*1 sq,chax
+ sq = chax(92)
+ lfmtup = lfmt1(updot)
+ lfmtrt = lfmt1(rtdot)
+ write(notexq,'(a37,f'//chax(48+lfmtup)//'.1,a2,f'//chax(48+lfmtrt)
+ * //'.1,a15)')
+ * sq//'makeatletter'//sq//'def'//sq//'C@Point#1#2{'//sq//
+ * 'PMXpt{',updot,'}{',rtdot,'}'//chax(48+iddot)//'}'//sq
+ * //'makeatother'
+c
+c Example of string just created:
+c \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\
+c
+ lnote = 54+lfmtup+lfmtrt
+ call addstr(notexq(1:lnote),lnote,soutq,lsout)
+ return
+ end
+ subroutine dotrill(iv,ip,iornq,noteq,lnoten,notexq,lnote)
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ character*1 chax
+ character*8 noteq
+ character*79 notexq
+ logical tronly,btest
+ do 1 itr = 1 , ntrill
+ if (iv.eq.ivtrill(itr) .and. ip.eq.iptrill(itr)) go to 2
+1 continue
+ print*,'Problem in dotrill. Call Dr. Don'
+ stop
+2 continue
+ tronly = xnsktr(itr) .lt. 0.01
+ if (tronly) then
+ notexq = chax(92)//'zcharnote'
+ lnote = 10
+ else if (btest(iornq,7)) then
+ notexq = chax(92)//'Trille'
+ lnote = 7
+ else
+ notexq = chax(92)//'trille'
+ lnote = 7
+ end if
+ notexq = notexq(1:lnote)//noteq(1:lnoten)//'{'
+ lnote = lnote+lnoten+1
+c
+c Write trill duration to nearest tenth of a noteskip
+c
+ if (tronly) then
+ notexq = notexq(1:lnote)//chax(92)//'it tr}'
+ lnote = lnote+7
+ return
+ end if
+ if (xnsktr(itr) .lt. .95) then
+ nfmt = 2
+ else if (xnsktr(itr) .lt. 9.95) then
+ nfmt = 3
+ else
+ nfmt = 4
+ end if
+ write(notexq(lnote+1:lnote+nfmt),'(f'//chax(48+nfmt)//'.1)')
+ * xnsktr(itr)
+ lnote = lnote+nfmt
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ return
+ end
+ subroutine endslur(stemup,upslur,nolev,iupdn,ndxslur,ivoff,ncm,
+ * soutq,lsout,fontslur)
+c
+c Only called to end slur started in dograce.
+c
+ logical shift,stemup,upslur,fontslur
+ character*80 soutq
+ character*79 notexq
+ character*8 noteq
+ character*1 chax
+ shift = .not.stemup .and. .not.upslur
+ if (.not.shift) then
+c
+c No shift needed
+c
+ notexq = chax(92)//'tslur'
+ lnote = 6
+ else
+c
+c Shift needed
+c
+ notexq = chax(92)//'ts'
+ lnote = 3
+ end if
+c if (ndxslur .lt. 10) then
+c notexq = notexq(1:lnote)//chax(48+ndxslur)
+c lnote = lnote+1
+c else
+c notexq = notexq(1:lnote)//'{1'//chax(38+ndxslur)//'}'
+c lnote = lnote+4
+c end if
+c
+cc Print 11-ndxslur
+c Print 23-ndxslur
+c
+c if (11-ndxslur .lt. 10) then
+ if (23-ndxslur .lt. 10) then
+c notexq = notexq(1:lnote)//chax(59-ndxslur)
+ notexq = notexq(1:lnote)//chax(71-ndxslur)
+ lnote = lnote+1
+ else if (23-ndxslur .lt. 20) then
+c notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}'
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndxslur)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndxslur)//'}'
+ lnote = lnote+4
+ end if
+ call notefq(noteq,lnoten,nolev+iupdn+ivoff,ncm)
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ if (shift) then
+ if (fontslur) then
+ notexq = notexq(1:lnote)//'{-.6}'
+ else
+ notexq = notexq(1:lnote)//'{-.8}'
+ end if
+ lnote = lnote+5
+ end if
+ call addstr(notexq,lnote,soutq,lsout)
+ return
+ end
+ subroutine errmsg(lineq,iccount,ibarno,msgq)
+ parameter(nm=24)
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ logical lastchar,fbon,issegno,isheadr,isvolt
+ character*128 lineq
+ character*78 outq
+ character*(*) msgq
+ character*1 chax
+ common /truelinecount/ linewcom(20000)
+ if (iccount .le. 78) then
+ outq = lineq(1:78)
+ iposn = iccount
+ else
+ outq = '... '//lineq(55:128)
+ iposn = iccount-50
+ end if
+ print*
+ ibarnop = ibarno
+ if (linesinpmxmod.eq.0 .or.
+ * nline .gt. line1pmxmod+linesinpmxmod) then
+c
+c Error is in main .pmx file
+c
+c nlinep = nline-linesinpmxmod
+c Correct for comments not copied into buffer
+ nlinep = linewcom(nline)-linesinpmxmod
+ else
+c
+c Error is in include file
+c
+ ibarnop = 0
+ nlinep = nline-line1pmxmod+1
+ call printl(
+ * 'ERROR in include file named above, description given below')
+ end if
+ open(19,file='pmxaerr.dat')
+ write(19,'(i6)') nlinep
+ close(19)
+ ndigbn = max(1,int(log10(ibarnop+.1)+1))
+ ndignl = int(log10(nlinep+.1)+1)
+ lenmsg = index(msgq,'!')-1
+c
+c Split off msgq(..) since UNIX compilers don't allow concat substring!!!
+c
+ write(*,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
+ *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
+ write(*,'(1x,a)')msgq(1:lenmsg)
+ write(15,'(/,a15,i'//chax(48+ndignl)//',a6,i'//chax(48+ndigbn)//
+ *',$)')' ERROR in line ',nlinep,', bar ',ibarnop
+ write(15,'(a)')msgq(1:lenmsg)
+ i10 = iposn/10
+ i1 = iposn-10*i10
+ write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
+ write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'v'
+ print*,outq(1:78)
+ write(15,'(a)')' '//outq(1:78)
+ write(*,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
+ write(15,'('//chax(48+i10)//chax(48+i1)//'x,a)')'^'
+ return
+ end
+ subroutine eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
+c
+c Get elemskips to previous note. Called only for graces, no xtups involved.
+c
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig
+ real*4 tstart(80),space(80)
+ common /comtol/ tol
+ itnd = nint(to(in))
+ if (ip.eq.1 .or. itnd.eq.itrpt) then
+c
+c Start of bar or after rpt.
+c
+ esk = fbar
+ return
+ else
+ esk = 0.
+ itprev = itnd-nodur(ivx,ip-1)
+ do 1 iib = ib , 1 , -1
+ if (tstart(iib) .lt. itprev+tol) then
+c
+c This is the block
+c
+ nnsk = nint(float((itnd-itprev))/space(iib))
+ esk = esk+nnsk*feon(space(iib))
+ return
+ else
+ nnsk = nint((itnd-tstart(iib))/space(iib))
+ esk = esk+nnsk*feon(space(iib))
+ itnd = nint(tstart(iib))
+ end if
+1 continue
+ end if
+ print*,'Problem in eskb4. Send files to Dr. Don'
+ stop
+ end
+ function f1eon(time)
+ f1eon = sqrt(time/2)
+ return
+ end
+ function feon(time)
+ common /comeon/ eonk,ewmxk
+ feon = sqrt(time/2)**(1.-eonk)*ewmxk
+ return
+ end
+ subroutine findbeam(ibmrep,numbms,mapfb)
+c
+c Called once per voice per bar, after setting forced beams.
+c
+ parameter (nm=24)
+ dimension mask(49,3),nummask(3),eqonly(49,3)
+c integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(24),
+c * itr(48),nodue(48)
+c logical short(48),eqonly
+ integer numbms(nm),ipr(248),nip1(0:247),nip2(0:247),mapfb(24),
+ * itr(248),nodue(248)
+ logical short(248),eqonly
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ common /combeam/ ibmtyp
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtol/ tol
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,
+ * isfig,btest
+ data nip1,nip2 /496*0/
+ data nummask / 29 , 49 , 12 /
+ data mask
+ * / 65535, 4095, 65520, 255, 65280, 63,
+ * 252, 16128, 64512, 15, 240, 3840,
+ * 61440, 7, 14, 112, 224, 1792,
+ * 3584, 28672, 57344, 3, 12, 48,
+ * 192, 768, 3072, 12288, 49152, 20*0 ,
+ * 16777215, 65535, 16776960, 4095, 65520, 1048320,
+ * 16773120, 255, 65280, 16711680, 63, 252,
+ * 16128, 64512, 4128768, 16515072, 15, 60,
+ * 240, 3840, 15360, 61440, 983040, 3932160,
+ * 15728640, 7, 14, 112, 224, 1792,
+ * 3584, 28672, 57344, 458752, 917504, 7340032,
+ * 14680064, 3, 12, 48, 192, 768,
+ * 3072, 12288, 49152, 196608, 786432, 3145728,
+ * 12582912,
+ * 4095, 255, 4080, 15, 240, 3840,
+ * 3, 12, 48, 192, 768, 3072,
+ * 37*0 /
+ data eqonly /3*.true.,46*.false.,7*.true.,91*.false./
+ ip = 0
+ nreal = 0
+ itnow = 0
+1 continue
+ ip = ip+1
+ if (ip .gt. nn(ivx)) go to 9
+11 if (nodur(ivx,ip).eq.0) then
+c
+c Ignore all xtup notes except the last, the one with nodur > 0 .
+c Xtups are irrelevant here since they are already all in forced beams.
+c Will update itnow by nodur at the END of this loop
+c
+ ip = ip+1
+ go to 11
+ end if
+ nreal = nreal+1
+ nodue(nreal) = nodur(ivx,ip)
+ short(nreal) = nodue(nreal).lt.16 .and.
+ * .not.btest(irest(ivx,ip),0)
+c
+c Rule out notes that have 'alone'-flag set
+c
+ * .and..not.btest(islur(ivx,ip),18)
+ ipr(nreal) = ip
+ itr(nreal) = itnow
+ if (nodue(nreal) .eq. 1) then
+c
+c 64th gap
+c
+ if (mod(itnow,2) .eq. 0) then
+c
+c Start of 32nd gap, lump with following note
+c
+ ip = ip+1
+ nodue(nreal) = 1+nodur(ivx,ip)
+ itnow = itnow+nodue(nreal)
+ else
+c
+c End of 32nd gap, lump with preceeding note
+c
+ nreal = nreal-1
+ nodue(nreal) = 1+nodue(nreal)
+ itnow = itnow+1
+ end if
+ else
+ itnow = itnow+nodur(ivx,ip)
+ end if
+ go to 1
+9 continue
+ ir1 = 1
+ itseg = lenbar/ibmrep
+ do 13 irep = 1 , ibmrep
+c
+c Set bitmaps for all shorts neighbored by a short. Each bit represents a
+c span of 32nd note. maps, mapm, mape record start, full duration, and end
+c of consecutive span of beamable (<1/4) notes.
+c
+ maps = 0
+ mapm = 0
+ mape = 0
+ itend = itseg*irep
+ itoff = itend-itseg
+ do 2 ir = ir1 , nreal
+ it2 = itr(ir)+nodue(ir)-2
+ if (it2 .ge. itend) then
+ ir1 = ir
+ go to 14
+ end if
+c if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal
+ if (short(ir).and.((ir.gt.1.and.short(max(ir-1,1))).or.
+ * (ir.lt.nreal.and.short(ir+1)))) then
+ ib1 = (itr(ir)-itoff)/2
+ ib2 = (it2-itoff)/2
+ if (max(ib1,ib2).gt.47 .or. ir.gt.48 .or.
+ * min(ib1,ib2).lt.0) return
+c if (max(ib1,ib2).gt.247 .or. ir.gt.248 .or.
+c * min(ib1,ib2).lt.0) return
+c
+c Must have an odd number obe beats in a long bar. Auto-beam won't work
+c
+ nip1(ib1) = ipr(ir)
+ nip2(ib2) = ipr(ir)
+c
+c nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip
+c
+ maps = ibset(maps,ib1)
+ mape = ibset(mape,ib2)
+ do 3 ib = ib1 , ib2
+ mapm = ibset(mapm,ib)
+3 continue
+ end if
+2 continue
+14 continue
+ if (mapm .eq. 0) go to 13
+c
+c Zero out bits from forced beams
+c
+ maps = iand(maps,not(mapfb(irep)))
+ mapm = iand(mapm,not(mapfb(irep)))
+ mape = iand(mape,not(mapfb(irep)))
+c
+c Compare map with template.
+c
+ do 4 it = 1 , nummask(ibmtyp)
+ masknow = mask(it,ibmtyp)
+ if (iand(masknow,mapm) .eq. masknow) then
+c
+c Find least significant bit in the mask to check start time
+c
+ mtemp = masknow
+ maskm = masknow
+ do 5 is1 = 0 , 47
+c do 5 is1 = 0 , 247
+ if (iand(1,mtemp) .eq. 1) go to 6
+ mtemp = ishft(mtemp,-1)
+5 continue
+6 continue
+ if (iand(ishft(1,is1),maps) .eq. 0) go to 4
+c
+c is1 is the bit where the beam starts. Continue shifting to
+c find most significant bit in the mask to check ending time
+c
+ do 7 is2 = is1 , 47
+c do 7 is2 = is1 , 247
+ mtemp = ishft(mtemp,-1)
+ if (iand(1,not(mtemp)) .eq. 1) go to 8
+7 continue
+8 continue
+c
+c is2 is now the bit on which the beam ends.
+c
+ if (iand(ishft(1,is2),mape) .eq. 0) go to 4
+c
+c Did we pick out a single note from the middle of a longer sequence?
+c
+ if (nip1(is1) .eq. nip2(is2)) go to 4
+c
+c We almost have a beam. Check equality of notes if needed.
+c
+ if (eqonly(it,ibmtyp)) then
+ do 10 ip = nip1(is1) , nip2(is2)
+ if (nodur(ivx,ip) .ne. 8) then
+c
+c There is a non-1/8th note in this beam. Exit if not 2 quarters
+c
+ if (is2-is1 .ne. 15) go to 4
+c
+c Beam is 2 quarters long. Check if can split in half.
+c
+ ithalf = 0
+ do 20 iip = nip1(is1) , nip2(is2)
+ ithalf = ithalf+nodur(ivx,iip)
+ if (ithalf .gt. 16) go to 4
+ if (ithalf .eq. 16) go to 21
+20 continue
+ print*,'Problem in findbeam, please call Dr. Don'
+ go to 4
+21 continue
+c
+c Otherwise, split in half by keeping only the first half. Other half will
+c be picked up later, assuming masks are listed longest first.
+c
+ is2 = is1+7
+c
+c Reset maskm (since only used part of mask), used later to zero out
+c bits that contain beams
+c
+ maskm = 0
+ do 15 is = is1 , is2
+ maskm = ibset(maskm,is)
+15 continue
+ go to 16
+ end if
+10 continue
+ end if
+16 continue
+c
+c This is a beam. If last "effective" ends on odd 64th, add 1 more
+c
+c if (abs(mod(to(iand(255,ipl(ivx,nip2(is2))))
+c * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then
+ if (abs(amod(to(ipl2(ivx,nip2(is2)))
+ * +nodur(ivx,nip2(is2))+.5*tol,2.)) .gt. tol) then
+ nip2(is2) = nip2(is2)+1
+ end if
+ numbms(ivx) = numbms(ivx)+1
+ numnew = numbms(ivx)
+ call logbeam(numnew,nip1(is1),nip2(is2))
+c
+c Zero out the appropriate bits so these notes don't get used again
+c
+ mapm = iand(mapm,not(maskm))
+ if (mapm.eq.0) go to 13
+ maps = iand(maps,not(maskm))
+ mape = iand(mape,not(maskm))
+ end if
+4 continue
+13 continue
+ return
+ end
+ subroutine findeonk(nptr1,nptr2,wovera,xelsk,dtmin,dtmax,eonk0)
+ parameter (nkb=3999,maxblks=9600)
+c
+c Compute an exponent eonk for use in the "flattened" formula for elemskips
+c vs time. We must solve the eqution f = 0. Initial quess is eonk0.
+c
+ common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
+ * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
+ * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
+ common /comtol/ tol
+ common /comeon/ eonk,ewmxk
+ eonk = eonk0
+ niter = 0
+1 continue
+ ewmxk = f1eon(dtmax)**eonk
+ niter = niter+1
+ esum = 0.
+ desum = 0.
+ do 2 iptr = nptr1 , nptr2
+ targ = durb(iptr)/sqzb(iptr)
+ esum = esum+nnpd(iptr)*sqzb(iptr)*feon(targ)
+ detarg = sqrt(targ/2*(dtmax/targ)**eonk)*alog(dtmax/targ)
+ desum = desum+nnpd(iptr)*sqzb(iptr)*detarg
+2 continue
+ f = wovera*feon(dtmin)-xelsk-esum
+ fp = wovera*sqrt(dtmin/2*(dtmax/dtmin)**eonk)*alog(dtmax/dtmin)
+ * -desum
+ if (abs(fp).lt.tol .or. abs(eonk-.5).gt..5 .or. niter.gt.100) then
+ call printl(
+ * 'Error in findeonk. Please send source to Dr. Don')
+ eonk = 0.
+ ewmxk = 1.
+ return
+ end if
+ dsoln = -f/fp
+ if (abs(dsoln) .lt. .1*tol) return
+c
+c Not converged yet, try again
+c
+ eonk = eonk+dsoln
+ go to 1
+ end
+ function fnote(nodur,ivx,ip,nacc)
+c
+c This return the real duration of a note
+c
+ parameter (nm=24)
+ integer*4 nodur(nm,200),nacc(nm,200)
+ logical btest
+ ipback = ip
+ if (nodur(ivx,ip) .gt. 0) then
+ if (ip .gt. 1) then
+c
+c Check if this is last note of xtup
+c
+ if (nodur(ivx,ip-1).eq.0) then
+ ipback = ip-1
+ go to 2
+ end if
+ end if
+ fnote = nodur(ivx,ip)
+ return
+ end if
+2 continue
+c
+c Count back to prior non zero note. Start at ip to avoid neg index if ip=1.
+c Count how many doubled xtups notes there are from ip-1 to first note.
+c
+ ndoub = 0
+ do 1 ip1m1 = ipback , 1 , -1
+ if (nodur(ivx,ip1m1) .gt. 0) go to 4
+ if (ip1m1.lt.ip .and. btest(nacc(ivx,ip1m1),18)) ndoub=ndoub+1
+1 continue
+4 continue
+c
+c count forward to next non-0 nodur. Start at ip in case last note of xtup.
+c
+ do 3 iip = ip , 200
+c
+c Count doubled xtup notes from ip to end.
+c
+ if (btest(nacc(ivx,iip),18)) ndoub = ndoub+1
+ if (nodur(ivx,iip) .gt. 0) then
+c fnote = nodur(ivx,iip)/float(iip-ip1m1)
+ fnote = nodur(ivx,iip)/float(iip-ip1m1+ndoub)
+ if (btest(nacc(ivx,ip),18)) then
+ fnote = 2*fnote
+ else if (btest(nacc(ivx,ip),27)) then
+ fnote = 1.5*fnote
+ else if (ip .gt. 1) then
+ if (btest(nacc(ivx,ip-1),27)) fnote = .5*fnote
+ end if
+ return
+ end if
+3 continue
+ print*,' '
+ call printl
+ * ('Probable misplaced barline or incorrect meter, stopping')
+ print*,'ivx,ip:',ivx,ip
+ call stop1()
+ end
+ subroutine g1etchar(lineq,iccount,charq)
+ parameter(nm=24)
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ logical lastchar,issegno,isheadr,isvolt,fbon
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ logical mrecord,mplay,endmac
+ character*1 charq
+ character*128 lineq,lnholdq
+c
+c Gets the next character out of lineq*128. If pointer iccount=128 on entry,
+c then reads in a new line. Resets iccount. Ends program if no more input.
+c
+ if (iccount .eq. 128) then
+ call read10(lineq,lastchar)
+ if (lastchar) return
+ if (.not.endmac) then
+ iccount = 0
+ if (.not.mplay) nline = nline+1
+ else
+ endmac = .false.
+ iccount = icchold
+ lineq = lnholdq
+ end if
+ if (mrecord) then
+ call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
+ end if
+ end if
+ iccount = iccount+1
+ charq = lineq(iccount:iccount)
+ return
+ end
+ subroutine g1etnote(loop,ifig,optimize,fulltrans)
+ parameter (nm=24,nkb=3999,mv=24576,maxblks=9600)
+ character*1 chax
+ logical twotrem
+ common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
+ * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
+ * nbars,itsofar(nm),nib(nm,15),nn(nm),
+ * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
+ common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
+ * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
+ * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ common /compage/ widthpt,ptheight,hoffpt,voffpt,
+ * nsyst,nflb,ibarflb(0:40),
+ * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
+ * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
+ * nistaff(0:40)
+ common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
+ common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
+ * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
+ logical lastchar,firstline,rest,loop,newmeter,fbon,issegno,barend,
+ * isheadr,fulbrp,usefig,isvolt,iskchb,kchmid,plusmin,ornrpt,
+ * stickyS
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ common /commus/ musize,whead20
+ logical mrecord,mplay,endmac,shifton,optimize
+ character*128 lineq,lnholdq
+ character*1 charq,dotq,dumq,durq,charlq
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc,cdot
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ logical novshrinktop,upslur,fontslur,ztrans,
+ * WrotePsslurDefaults,cstuplet
+ common /comnvst/ novshrinktop,cstuplet
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ character*51 literq(3),lyrerq(5)
+ common /comligfont/ isligfont
+ logical isligfont
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ logical fulltrans
+ common /comsize/ isize(nm)
+ common /commidisig/ midisig
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
+ * poefa
+ real*4 poefa(125)
+ logical nocodabn
+ data literq
+ * /'Literal TeX string cannot start with 4 backslashes!',
+ * 'TeX string must have <129 char, end with backslash!',
+ * 'Type 2 or 3 TeX string can only start in column 1!'/
+ data lyrerq
+ * /'pmxlyr string must end with " followed by blank!',
+ * 'pmxlyr string cannot extend past position 120!',
+ * 'There must be "a" or "b" here!',
+ * 'There must be "+" or "-" here!',
+ * 'There must be an integer here!'/
+ cdot = .false.
+ twotrem = .false.
+1 call g1etchar(lineq,iccount,charq)
+ if (charq .ne. ' ') charlq = charq
+ if (lastchar) then
+ if (index('/%',charlq) .eq. 0) then
+ print*
+ print*,'WARNING:'
+ print*,'Last non-blank character is "',charlq,'", not "/,%"'
+ print*,'ASCII code:',ichar(charlq)
+ write(15,'(/a)')'Last non-blank character is "'//charlq//
+ * '", not "/,%"'
+ write(15,'(a11,2x,i3)')'ASCII code:',ichar(charlq)
+c
+c Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1.
+c
+ ilbuf = ilbuf-1
+ lbuf(ilbuf) = lbuf(ilbuf)+2
+ bufq = bufq(1:ipbuf)//' /'
+ write(15,*)'appending <blank>/'
+ print*,'appending <blank>/'
+ lineq = lineq(1:iccount)//' /'
+ lastchar = .false.
+ go to 1
+ end if
+ return
+ end if
+ if (charq .eq. ' ') then
+ go to 1
+ else if (charq.eq.'%' .and. iccount.eq.1) then
+ iccount = 128
+ go to 1
+c
+c Replacement 1/22/12 since gfortran 4.7 with -O was choking here!
+c
+c else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
+ else if (index('abcdefg',charq).gt.0 .or.
+ * charq.eq.'r') then
+c
+c This is a note/rest.
+c
+ if (cdot) go to 28
+ idotform = 0
+ numnum = 0
+ plusmin = .false.
+28 nnl(ivx) = nnl(ivx)+1
+ if (nnl(ivx) .gt. 200) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '>200 notes in line of music. Use smaller blocks!')
+ call stop1()
+ end if
+ dotq = 'x'
+c
+c Check if this is 'r ' and previous note was full-bar-pause
+c
+ fulbrp = charq.eq.'r' .and. lineq(iccount+1:iccount+1) .eq.' '
+ * .and. nnl(ivx).gt.1 .and. rest(ivx,max(1,nnl(ivx)-1)) .and.
+ * nodur(ivx,max(1,nnl(ivx)-1)) .eq. lenbar
+2 call g1etchar(lineq,iccount,durq)
+ ic = ichar(durq)
+ if (ic.le.57 .and. ic.ge.48) then
+c
+c Digit
+c
+ if (numnum .eq. 0) then
+ nnodur = ic-48
+ numnum = 1
+ go to 2
+ else if (numnum .eq. 1) then
+ if (charq .eq. 'r') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only one digit allowed after rest symbol "r"!')
+ call stop1()
+ end if
+ numnum = 2
+ if (plusmin) then
+ print*
+ print*,'*********WARNING*********'
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Before version 1.2, +/- was ignored if octave was!')
+ print*,
+ * 'explicitly specified. May need to edit old editions'
+ end if
+ go to 2
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '>2 digits in note symbol!')
+ call stop1()
+ end if
+ else if (durq.eq.'d') then
+ dotq = durq
+ if (lineq(iccount+1:iccount+1) .eq. 'd') then
+ iddot = 1
+ iccount = iccount+1
+c
+c Since we flow out, double dots won't work with other dot options
+c
+ end if
+ if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
+c
+c move a dot, provided a number follows.
+c
+ call g1etchar(lineq,iccount,durq)
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789-.',durq) .eq. 0) then
+c
+c Backup, exit the loop normally
+c
+ iccount = iccount-2
+ go to 2
+ end if
+ call readnum(lineq,iccount,dumq,fnum)
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift also
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789-.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected number after 2nd +/- (shift dot)!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ iccount = iccount-1
+ end if
+ go to 2
+ else if (index('<>',durq) .gt. 0) then
+c
+c Accidental shift
+c
+c if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
+ if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+c * 'Expected "f", "s", or "n" before "<" or ">"!')
+ * 'Expected "f", "s", "n" or "A" before "<" or ">"!')
+ call stop1()
+ end if
+ ipm = 1
+ if (durq .eq. '<') ipm=-1
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789.0',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected number after </> (accidental shift)!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ fnum = ipm*fnum
+ if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Horizontal accidental shift must be >-5.35 and <1.0!')
+ call stop1()
+ end if
+ iccount = iccount-1
+ go to 2
+ else if (index('+-',durq) .gt. 0) then
+ if (charq .ne. 'r') then
+ if (index('fsnA',lineq(iccount-1:iccount-1)) .gt. 0) then
+ ipm = 1
+ if (durq .eq. '-') ipm=-1
+ if (index('0123456789',lineq(iccount+1:iccount+1))
+ * .gt.0) then
+c
+c This may be start of accidental shift, but may be octave jump; then duration
+c
+ icsav = iccount
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (index('+-',durq) .gt. 0) then
+c
+c This is an accid shift since there's a 2nd consecutive signed number.
+c Check size of 1st number.
+c
+ if (fnum .gt. 30.5) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Vertical accidental shift must be less than 31!')
+ call stop1()
+ end if
+ ipm = 1
+ if (durq .eq. '-') ipm = -1
+ call g1etchar(lineq,iccount,durq)
+ if (index('1234567890.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected 2nd number of accidental shift)!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ fnum = ipm*fnum
+ if (fnum.lt.-5.35 .or. fnum.gt.1.0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Horiz. accidental shift must be >-5.35 and <1.0!')
+ call stop1()
+ end if
+ iccount = iccount-1
+ go to 2
+ else
+c
+c Not accid shift, reset, then flow out
+c
+ iccount = icsav
+ end if
+ end if
+ end if
+ plusmin = .true.
+ if (numnum .eq. 2) then
+ print*
+ print*,'*********WARNING*********'
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Before version 1.2, +/- was ignored if octave was!')
+ print*,
+ * 'explicitly specified. May need to edit old editions'
+ end if
+ go to 2
+c
+c It's a rest containing +|- . Must refer to a vertical shift. Read past.
+c
+ else
+ call g1etchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,dum)
+ if (lineq(iccount-1:iccount-1).eq.'.') iccount=iccount-1
+ iccount = iccount-1
+ go to 2
+ end if
+c else if (index('ulare',durq) .gt. 0) then
+ else if (index('ularec',durq) .gt. 0) then
+ go to 2
+ else if (index('LS',durq) .gt. 0) then
+c
+c Stemlength change
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('.0123456789:',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be a number or colon here!')
+ call stop1()
+ end if
+ if (durq .eq. ':') then
+ if (.not.stickyS) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Turned off sticky stemlegth changes without turning on!')
+ call stop1()
+ end if
+ stickyS = .false.
+ go to 2
+ end if
+ call readnum(lineq,iccount,durq,dum)
+c if (dum.lt..5 .or. dum.gt.4.) then
+ if ((durq.eq.'L'.and.dum.gt.20.).or.
+ * (durq.eq.'S'.and.dum.gt.4.)) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Stemlength change amount too big!')
+ call stop1()
+ end if
+ if (durq .ne. ':') then
+ iccount = iccount-1
+ else
+ if (stickyS) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Turned on sticky stemshrinks when already on!')
+ call stop1()
+ end if
+ stickyS = .true.
+ end if
+ go to 2
+ else if (index('fsn',durq) .gt. 0) then
+c
+c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
+c MUST come right after "f,s,n"
+c
+ if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
+ go to 2
+ else if (durq .eq. 'p') then
+ fulbrp = charq.eq.'r'
+ if (.not. fulbrp) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'The option "p" only works with "r" (rest)!')
+ call stop1()
+ end if
+ go to 2
+ else if (durq .eq. 'b') then
+ if (charq .ne. 'r') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'You entered "b"; I expected "rb"!')
+ call stop1()
+ else if (numnum .eq. 2) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'You entered "r" & "b" with two numbers!')
+ end if
+ go to 2
+ else if (durq .eq. 'x') then
+c
+c Xtuplet. Count number of doubled notes (for unequal xtups)
+c
+ if (btest(nacc(ivx,nnl(ivx)),18)) then
+ ndoub = 1
+ else
+ ndoub = 0
+ end if
+c
+c Will set all durations to 0 except last one.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789T',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'First char after "x" in xtuplet must be "1"-"9" or "T"!')
+ call stop1()
+ end if
+ if (durq .eq. 'T') then
+c
+c Set a flag for checking 2nd note inputs if dot is moved
+c
+ twotrem = .true.
+c
+c Check all x-tremolo inputs here; set fnum=2
+c
+ fnum = 2
+ call getchar(lineq,iccount,durq)
+ if (index('0123 ',durq).eq.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'First char after "T" in xtuplet must be "0"-"3" or blank!')
+ call stop1()
+ else if (durq .ne. ' ') then
+ call getchar(lineq,iccount,durq)
+ if (index('0123 ',durq).eq.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This char must be "0"-"3" or blank!')
+ call stop1()
+ else if (durq .ne. ' ') then
+ call getchar(lineq,iccount,durq)
+c
+c Probably blank unles other options entered
+c
+ end if
+ end if
+ else
+c
+c durq is digit, normal xtup
+c
+ call readnum(lineq,iccount,durq,fnum)
+c
+c Leaves durq at next char after number
+c
+ if (fnum .gt. 99) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Xtuplet cannot have more than 99 notes!')
+ call stop1()
+ else if (index(' DFnd',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only legal characters here are " ","D","F","n"!')
+ call stop1()
+ end if
+ end if
+c
+c End of mandatory xtup inputs. Check for options. Note D,F,d must precede n.
+c
+ if (index('DF',durq) .gt. 0) then
+c
+c Double xtup note to make an un= xtup. Here, number already set, but may also
+c have used this before number was set.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ ndoub = 1
+ call g1etchar(lineq,iccount,durq)
+ else if (durq .eq. 'd') then
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
+ call g1etchar(lineq,iccount,durq)
+ end if
+ if (durq .eq. 'n') then
+c
+c Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'.
+c
+ numshft = 0
+30 call g1etchar(lineq,iccount,durq)
+ if (durq .eq. 'f') then
+ go to 30
+ else if (index('+-',durq) .gt. 0) then
+ numshft = numshft+1
+ if (numshft .eq. 3) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only 2 shifts are allowed after "n" in xtup!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This character should be a digit or "."!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,snum)
+ iccount = iccount-1
+c if ((numshft.eq.1 .and. snum.gt.15.1) .or.
+ if ((numshft.eq.1 .and. snum.gt.64.) .or.
+ * (numshft.eq.2 .and. snum.gt.1.51)) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Shift number after "n" in xtup is out of range!')
+ call stop1()
+ end if
+ go to 30
+ else if (durq .eq. 's') then
+c
+c Slope alteration for bracket
+c
+ call getchar(lineq,iccount,durq)
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'For slope adjustment, this character must be "+" or "-"!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This character should be a digit!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,snum)
+ iccount = iccount-1
+ if (nint(snum) .gt. 15) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slope adjustment cannot exceed 15!')
+ call stop1()
+ end if
+ go to 30
+ else if (index('123456789',durq) .gt. 0) then
+c
+c Unsigned integer => alternate printed number
+c
+ call readnum(lineq,iccount,durq,snum)
+ if (snum .gt. 15.1) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Alternate xtup number after "n" must be <16!')
+ call stop1()
+ end if
+ iccount = iccount-1
+ go to 30
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "n" in xtup!')
+ call stop1()
+ end if
+ end if
+ ntup = nint(fnum)
+ do 6 itup = 2 , ntup
+ nodur(ivx,nnl(ivx)) = 0
+ nnl(ivx) = nnl(ivx)+1
+110 call g1etchar(lineq,iccount,durq)
+ if (durq.eq.' ') then
+ go to 110
+ else if (durq .eq. 'o') then
+c
+c Ornament in xtup. "o" symbol must come AFTER the affected note
+c
+ call g1etchar(lineq,iccount,dumq)
+ if (index('(stmx+Tup._)e:>^bc',dumq) .eq. 0 ) then
+ if (index('fg',dumq) .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Fermata or segno not allowed in xtuplet!')
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal ornament!')
+ end if
+ call stop1()
+ end if
+ if (dumq .eq. 'T') then
+c
+c Trill. may be followed by 't' and/or number. read 'til blank
+c
+29 call g1etchar(lineq,iccount,dumq)
+ if (dumq .ne. ' ') go to 29
+ else if (dumq .eq. 'e') then
+ call g1etchar(lineq,iccount,dumq)
+ if (index('sfn?',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "e" in edit. accid. symbol!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
+ else if (dumq .eq. ':') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '":" must be followed by blank in "o: "!')
+ call stop1()
+ else if (.not.ornrpt) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Turned off repeated ornaments before they were on!')
+ call stop1()
+ end if
+ ornrpt = .false.
+ else
+ call g1etchar(lineq,iccount,dumq)
+ end if
+ if (index('+- :',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in ornament symbol!')
+ call stop1()
+ end if
+ if (dumq .eq. ':') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '":" must be followed by blank in "o: "!')
+ call stop1()
+ else if (ornrpt) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Turned on repeated ornaments but already on!')
+ call stop1()
+ end if
+ ornrpt = .true.
+ end if
+ if (index('+-',dumq) .gt. 0) then
+ if (index('0123456789',lineq(iccount+1:iccount+1))
+ * .eq. 0) then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'There should be an integer here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (durq .eq. ':') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot shift AND repeat an ornament!')
+ call stop1()
+ end if
+c
+c 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas.
+c
+ if (index('+-',durq) .gt. 0) then
+ if (index('.0123456789',lineq(iccount+1:iccount+1))
+ * .eq. 0) then
+ call errmsg(lineq,iccount+1,
+ * ibarcnt-ibaroff+nbars+1,
+ * 'There should be a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ end if
+ go to 110
+ else if (index('st(){}',durq) .gt. 0) then
+c
+c Slur in xtup
+c
+ iposn = 0
+ numint = 0
+15 call g1etchar(lineq,iccount,dumq)
+ iposn = iposn+1
+ if (index('udlbfnhtv',dumq) .gt. 0) then
+ if (dumq.eq.'t' .and. durq.eq.'t') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot use "t" as an option on a tie!')
+ call stop1()
+ end if
+ go to 15
+ else if (index('+-',dumq) .gt. 0) then
+ numint = numint+1
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (numint .eq. 1) then
+ if (nint(fnum) .gt. 30) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Magnitude of slur height adjustment cannot exceed 30!')
+ call stop1()
+ end if
+ else if (numint .eq. 2) then
+ if (abs(fnum).gt.6.3) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur horiz shift must be in the range (-6.3,6.3)!')
+ call stop1()
+ end if
+ else
+c
+c Third signed integer, must be a midslur or curve spec.
+c
+ if (abs(fnum).gt.31) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur midheight must be in the range (-31,31)!')
+ call stop1()
+ end if
+ if (durq .eq. ':') then
+c
+c Expecting curve parameters. Get two numbers
+c
+ do 40 i = 1 , 2
+ iccount = iccount+1
+ fnum = ichar(lineq(iccount:iccount))-48
+ if (abs(fnum-3.5) .gt. 3.6) then
+ call errmsg(lineq,iccount,
+ * ibarcnt-ibaroff+nbars+1,
+ * 'Slur curve parameter must be in range (0,7)!')
+ call stop1()
+ end if
+40 continue
+ iccount = iccount+1
+ end if
+ end if
+ iccount = iccount-1
+ go to 15
+
+ else if (dumq .eq. 's') then
+c
+c What follows should be one or two signed numbers for adjustment of line break
+c slur, end of 1st segment or start of second.
+c
+ if (fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'May not use linebreak slur options with font-based slurs!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('+-',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This character must be "+" or "-"!')
+ call stop1()
+ end if
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (nint(fnum) .gt. 30) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Magnitude of slur height adjustment cannot exceed 30!')
+ call stop1()
+ end if
+ if (index('+-',dumq) .gt. 0) then
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (abs(fnum) .gt. 6.3) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur horiz shift must be in range (-6.3,6.3)!')
+ call stop1()
+ end if
+ end if
+ iccount = iccount-1
+ go to 15
+ else if (dumq .eq. 'H' .and. iposn.gt.1) then
+ if (lineq(iccount+1:iccount+1) .eq. 'H')
+ * iccount=iccount+1
+ go to 15
+ else if (dumq .eq. 'p') then
+c
+c local change in postscript slur/tie adjustment default
+c
+ if (fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must use postscript slurs ("Ap") to use this option!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('+-',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected "+" or "-" here!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('st',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected "s" or "t" here!')
+ call stop1()
+ end if
+ go to 15
+ else if (dumq .ne. ' ') then
+ ic = ichar(dumq)
+ if ((ic.ge.48.and.ic.le.57) .or.
+ * (ic.ge.65.and.ic.le.90)) then
+ if (iposn .eq. 1) then
+ if (durq.eq.'t' .and. fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slur ID not allowed on non-postscript tie!')
+ call stop1()
+ end if
+ if (lineq(iccount+1:iccount+1).eq.'x')
+ * iccount = iccount+1
+ go to 15
+ end if
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slur ID must be 2nd character in slur symbol!')
+ call stop1()
+ end if
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in slur symbol!')
+ call stop1()
+ end if
+ go to 110
+ else if (index('0123456789#-nx_',durq) .gt. 0) then
+c
+c We have a figure. Only allow on 1st note of xtup
+c
+ if (itup .ne. 2) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Figure in xtup only allowed on 1st note!')
+ call stop1()
+ else if (durq.eq.'x') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'No floating figures in xtuplets!')
+ call stop1()
+ end if
+ if (usefig .and. ivx.eq.1) ifig = 1
+26 call g1etchar(lineq,iccount,durq)
+c if (index('0123456789#-n_.:',durq) .gt. 0) then
+ if (index('0123456789#-n_.:v',durq) .gt. 0) then
+ go to 26
+ else if (durq .eq. 's') then
+ isligfont = .true.
+ go to 26
+ else if (durq .eq. '+') then
+c
+c vertical offset, must be integer then blank
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .ne. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Integer for vertical offset expected here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Vertical offset must terminate figure!')
+ call stop1()
+ end if
+ iccount = iccount-1
+ go to 26
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in figure in xtuplet!')
+ call stop1()
+ end if
+ go to 110
+ else if (durq .eq. 'G') then
+ ngr = 1
+79 call g1etchar(lineq,iccount,charq)
+ if (index('123456789',charq) .gt. 0) then
+ call readnum(lineq,iccount,durq,fnum)
+ ngr = nint(fnum)
+ iccount = iccount-1
+ go to 79
+ else if (index('AWulxs',charq) .gt. 0) then
+ go to 79
+ else if (charq .eq. 'm') then
+ call g1etchar(lineq,iccount,charq)
+ if (index('01234',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A digit less than 5 must follow "m" in a grace note!')
+ call stop1()
+ end if
+ go to 79
+ else if (charq .eq. 'X') then
+c
+c Space before main note
+c
+ call g1etchar(lineq,iccount,charq)
+ if (index('0123456789.',charq) .gt. 0) then
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 79
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A number must follow "X" in a grace note!')
+ call stop1()
+ end if
+ end if
+c
+c At this point, charq is first note name in rest (grace?)
+c
+ do 71 igr = 1 , ngr
+ numnum = 0
+ if (igr .gt. 1) then
+75 call g1etchar(lineq,iccount,charq)
+ if (charq .eq. ' ') go to 75
+ end if
+ if (index('abcdefg',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'In grace, expected "a"-"g"!')
+ call stop1()
+ end if
+78 call g1etchar(lineq,iccount,charq)
+ if (charq .ne. ' ') then
+ if (index('1234567',charq) .gt. 0) then
+ if (numnum .eq. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only one of "+-1234567" allowed here in grace!')
+ call stop1()
+ end if
+ numnum = 1
+ go to 78
+ else if (index('+-nfs',charq) .gt. 0) then
+ go to 78
+ end if
+c
+c Digits are possible octave numbers
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after note name in grace!')
+ call stop1()
+ end if
+71 continue
+ go to 110
+ else if (durq .eq. chax(92)) then
+ call chklit(lineq,iccount,literr)
+ if (literr .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * literq(literr))
+ call stop1()
+ end if
+ go to 110
+ else if (durq .eq. chax(34)) then
+c
+c pmx lyric
+c
+ call chkpmxlyr(lineq,iccount,lyrerr)
+ if (lyrerr .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * lyrerq(lyrerr))
+ call stop1()
+ end if
+ go to 110
+ else if (durq .eq. 'M') then
+c
+c Temporary trap until I get around putting this in pmxb
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Macros not yet allowed in xtuplets!')
+ call stop1()
+ else if (durq .eq. 'X') then
+ call g1etx(lineq,iccount,shifton,
+ * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt)
+ go to 110
+ else if (durq .eq. 'z') then
+c
+c Chord note in xtup. Read past for now.
+c
+33 call g1etchar(lineq,iccount,durq)
+ if (durq .ne. ' ') go to 33
+ go to 110
+ else if (durq .eq. 'D') then
+c
+c Dynamic mark
+c
+ call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
+ go to 110
+ else if (durq .eq. '%') then
+ if (iccount .ne. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Comment must have "%" in column 1!')
+ call stop1()
+ end if
+ iccount = 128
+ go to 110
+ else if (durq .eq. '?') then
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ' ') then
+ iccount = iccount-1
+ go to 110
+ end if
+ if (durq .ne. '-') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expecting "-"')
+ call stop1()
+ end if
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expecting number')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 110
+c
+c 140215 Allow clef change inside xtup
+c
+ else if (durq .eq. 'C') then
+ call g1etchar(lineq,iccount,durq)
+ if (.not.(index('tsmanrbf',durq).gt.0 .or.
+c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
+ * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
+ call stop1()
+ end if
+ go to 110
+c+++
+ else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'['
+ * .and. lineq(iccount+2:iccount+2).eq.' ') then
+ iccount = iccount+2
+ go to 110
+c+++
+c
+c Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo
+c
+ end if
+c
+c End of xtup options. At this point symbol can only be note or rest
+c
+ if (index('abcdefgr',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'In xtup, this character is not allowed!')
+ call stop1()
+ end if
+7 call g1etchar(lineq,iccount,durq)
+ if (index('12345678ulcb',durq) .gt. 0) then
+ go to 7
+ else if (index('sfn',durq) .gt. 0) then
+c
+c Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift.
+c
+ if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
+ go to 7
+ else if (index('+-<>',durq) .gt. 0) then
+c
+c May have either octave jump or shifted accid. on main xtup note
+c
+ if (index('+-',durq).gt.0 .and.
+ * index('01234567890',lineq(iccount+1:iccount+1)).eq.0)
+ * go to 7
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 7
+ else if (index('DF',durq) .gt. 0) then
+c
+c Double an xtup note to make an unequal xtup
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ ndoub = ndoub+1
+ go to 7
+ else if (durq .eq. 'd') then
+ if (twotrem) then
+c
+c 2-note trem, get shift
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected +/- for shifted dot on end of 2-note trem!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,dumq,fnum)
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift also
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789-.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected number after 2nd +/- (shift dot)!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ iccount = iccount-1
+ go to 7
+ else
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
+ end if
+ go to 7
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal option on xtuplet note!')
+ call stop1()
+ end if
+ if (itup .eq. ntup-ndoub) go to 3
+6 continue
+3 continue
+c
+c 6==End of loop for xtuplet input
+c
+ else if (durq .eq. 'm') then
+c
+c Multi-bar rest: next 1 or two digits are # of bars.
+c
+ if (mod(itsofar(iv),lenbar) .ne. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Multibar rest must start at beginning of bar!')
+ call stop1()
+ else if (iv.eq.1.and.ibarmbr.gt.0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Multibar rest only OK at one time per block!')
+ call stop1()
+ end if
+c
+c For some purposes, pretend its one bar only
+c
+ nodur(iv,nnl(iv)) = lenbar
+ ibarmbr = nbars+1
+ mbrest = 0
+c20 call g1etchar(lineq,iccount,durq)
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected an integer after "rm"!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ mbrest = nint(fnum)
+c iccount = iccount-1
+ if (nv .gt. 1) then
+ if (iv .eq. 1) then
+ mbrestsav = mbrest
+ else
+ if (mbrest .ne. mbrestsav) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must enter same multi-bar rest in every voice!')
+ call stop1()
+ end if
+ end if
+c
+c Zero out mbrestsav so can check at end of input block whether
+c all voices have one
+c
+ if (iv .eq. nv) mbrestsav=0
+ end if
+ if (durq .eq. 'n') then
+c
+c Get new height
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('+-123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected an integer after "rm[x]n"!')
+ call stop1()
+ end if
+ if (index('+-',durq).ne.0) iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "rm"!')
+ call stop1()
+ end if
+ else if (durq .eq. '.') then
+c
+c Dotted pattern. Close out note. Mult time by 3/4.
+c Set time for next note to 1/4. Start the note.
+c
+ idotform = 1
+ else if (durq .eq. ',') then
+ idotform = 3
+c
+c Now flow to duration setting, as if durq=' '
+c
+ else if (index('oL',durq) .gt. 0) then
+c
+c Suppress full bar rest, or look left for height
+c
+ if (charq .ne. 'r') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"o","L" options only legal for rest, not note!')
+ call stop1()
+ end if
+ go to 2
+ else if (index('DF',durq) .gt. 0) then
+c
+c Double note for xtup. Must check here in case "D" or "F" came before "x" or on
+c last note of xtup. Need to flag it in pmxa since affects horiz. spacing.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ go to 2
+ else if (durq .eq. 'A') then
+c
+c Main note accidental option
+c
+ call getchar(lineq,iccount,durq)
+ if (index('o+-<>',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"o",+","-","<",">" are the only legal options here!')
+ call stop1()
+ end if
+c
+c Need more stuff here
+c
+ if (durq .ne. "o") then
+c
+c Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will
+c proceed to number input checking
+c
+ iccount = iccount-1
+ end if
+ go to 2
+ else if (durq .eq. 'T') then
+c
+c Single stem tremolo. Only option (optional) is 1,2,3, or 4.
+c
+ call getchar(lineq,iccount,durq)
+ if (index('1234',durq) .eq. 0) iccount = iccount-1
+ go to 2
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character!')
+ print*,'ASCII code:',ichar(durq)
+ call stop1()
+ end if
+c
+c End of block for note options.
+c
+c Set the duration
+c
+ if (idotform .gt. 0) then
+ if (idotform .eq. 1) then
+ nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)*3/2
+ else if (idotform .eq. 2) then
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
+ else if (idotform .eq. 3) then
+ nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
+ else if (idotform .eq. 4) then
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
+ end if
+ else if (ibarmbr.ne.nbars+1 .and. .not.fulbrp) then
+ nodur(ivx,nnl(ivx)) = i1fnodur(nnodur,dotq)
+c
+c Check for double dot
+c
+ if (iddot .eq. 1) then
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
+ iddot = 0
+ end if
+ else if (fulbrp) then
+ nodur(ivx,nnl(ivx)) = lenbar
+c
+c Use a one-line function to set nnodur. It gives inverse of ifnodur.
+c
+ nnodur = index('62514x0x37',
+ * chax(48+int(log(.1+lenbar)/.69315)))-1
+ fulbrp = .false.
+ end if
+ rest(ivx,nnl(ivx)) = charq.eq.'r'
+c
+c If inside forced beam, check if note is beamable
+c
+ if (fbon) then
+ if (nodur(ivx,nnl(ivx)) .lt. 16) go to 120
+ if (nnl(ivx) .gt. 1) then
+ if (nodur(ivx,nnl(ivx)-1) .eq. 0) go to 120
+ end if
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Unbeamable thing in forced beam!')
+ call stop1()
+ end if
+120 continue
+c
+c Get number of prior bars for later check on whether note spans bar line
+c
+ nbb4 = itsofar(ivx)/lenbar
+ itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
+ if (mod(itsofar(ivx),lenbar) .eq. 0) then
+ nbars = nbars+1
+ if (shifton) barend = .true.
+c
+c Will check barend when 1st note of next bar is entered.
+c
+ if (nbars .gt. 15) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot have more than 15 bars in an input block!')
+ call stop1()
+ end if
+ nib(ivx,nbars) = nnl(ivx)
+ if (firstline .and. lenbar.ne.lenbr1) then
+c
+c Just finished the pickup bar for this voice.
+c
+ if (itsofar(ivx) .ne. lenbr0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Pickup bar length disagrees with mtrnum0!')
+ call stop1()
+ end if
+ lenbar = lenbr1
+ itsofar(ivx) = 0
+ end if
+ else if (barend) then
+ if (shifton) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Bar ended with user-defined shift still on!')
+ call stop1()
+ end if
+ barend = .false.
+ else if (itsofar(ivx)/lenbar .gt. nbb4) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'This note spans a bar line!')
+ call stop1()
+ end if
+ if (idotform.eq.1 .or. idotform.eq.3) then
+ call g1etchar(lineq,iccount,charq)
+ if (index('abcedfgr',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected note name or "r" here!')
+ call stop1()
+ end if
+ idotform = idotform+1
+ numnum = 1
+ go to 28
+ end if
+c
+c End of sub block for note-rest
+c
+ else if (charq .eq. 'z') then
+ call g1etchar(lineq,iccount,charq)
+ if (index('abcdefg',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected chord note name here!')
+ call stop1()
+ end if
+25 call g1etchar(lineq,iccount,durq)
+c if (index('dre12345678',durq) .gt. 0) then
+ if (index('dre12345678c',durq) .gt. 0) then
+ go to 25
+ else if (index('fsn',durq) .gt. 0) then
+c
+c Check for midi-only accid. CANNOT coesist with accidental position tweaks, so
+c MUST come right after "f,s,n"
+c
+ if (lineq(iccount+1:iccount+1) .eq. 'i') iccount=iccount+1
+ go to 25
+ else if (durq .eq. 'A') then
+ if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Must have "f,s,n" before "A" in chord note!')
+ call stop1()
+ end if
+ go to 25
+ else if (index('<>',durq) .gt. 0) then
+ if (index('fsnA',lineq(iccount-1:iccount-1)) .eq. 0) then
+c if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Must have "f,s,n,A" before "<" or ">"!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('1234567890.',durq) .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a number to start here for accidental shift!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 25
+ else if (index('+-',durq) .gt. 0) then
+ if (index('1234567890.',lineq(iccount+1:iccount+1)) .eq. 0)
+ * go to 25
+c
+c Number or '.' (durq) follows +/- . Get it.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. '.' .and. index('1234567890',
+ * lineq(iccount+1:iccount+1)) .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * '"." here must be followed by a digit!')
+ call stop1()
+ else if (index('sfndA',lineq(iccount-2:iccount-2)).eq.0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Number after +/- must follow "d,s,f,n,A"!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (index('+-',durq) .eq. 0) then
+ iccount = iccount-1
+ go to 25
+ end if
+c
+c 2nd +/-
+c
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. '.') call g1etchar(lineq,iccount,durq)
+ if (index('1234567890',durq) .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 25
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in chord note!')
+ call stop1()
+ end if
+ else if (charq .eq. 'G') then
+ ngr = 1
+9 call g1etchar(lineq,iccount,charq)
+ if (index('123456789',charq) .gt. 0) then
+ call readnum(lineq,iccount,durq,fnum)
+ ngr = nint(fnum)
+ iccount = iccount-1
+ go to 9
+ else if (index('AWulxs',charq) .gt. 0) then
+ go to 9
+ else if (charq .eq. 'm') then
+ call g1etchar(lineq,iccount,charq)
+ if (index('01234',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A digit less than 5 must follow "m" in a grace note!')
+ call stop1()
+ end if
+ go to 9
+ else if (charq .eq. 'X') then
+c
+c Space before main note
+c
+ call g1etchar(lineq,iccount,charq)
+ if (index('0123456789.',charq) .gt. 0) then
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 9
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A number must follow "X" in a grace note!')
+ call stop1()
+ end if
+ end if
+c
+c At this point, charq is first note name in rest (grace?)
+c
+ do 19 igr = 1 , ngr
+ numnum = 0
+ if (igr .gt. 1) then
+55 call g1etchar(lineq,iccount,charq)
+ if (charq .eq. ' ') go to 55
+ end if
+ if (index('abcdefg',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'In grace, expected "a"-"g"!')
+ call stop1()
+ end if
+18 call g1etchar(lineq,iccount,charq)
+ if (charq .ne. ' ') then
+ if (index('1234567',charq) .gt. 0) then
+ if (numnum .eq. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only one of "+-1234567" allowed here in grace!')
+ call stop1()
+ end if
+ numnum = 1
+ go to 18
+c else if (index('nfs',charq) .gt. 0) then
+ else if (index('+-nfs',charq) .gt. 0) then
+ go to 18
+ end if
+c
+c Digits are possible octave numbers
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after note name in grace!')
+ call stop1()
+ end if
+19 continue
+ else if (charq .eq. chax(92)) then
+ call chklit(lineq,iccount,literr)
+ if (literr .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * literq(literr))
+ call stop1()
+ end if
+ else if (charq .eq. chax(34)) then
+c
+c pmx lyric
+c
+ call chkpmxlyr(lineq,iccount,lyrerr)
+ if (lyrerr .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * lyrerq(lyrerr))
+ call stop1()
+ end if
+ else if (charq .eq. 'o') then
+c
+c Ornament on non-xtup note. "o" symbol must come AFTER the affected note
+c
+ if (nnl(ivx) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"o" must be in same input block, after affected note!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then
+ if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal ornament!')
+ call stop1()
+ end if
+ if (dumq .eq. ':') then
+ call g1etchar(lineq,iccount,dumq)
+ if (dumq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected blank after "o:"!')
+ call stop1()
+ else if (.not.ornrpt) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Turned off repeated ornaments before they were on!')
+ call stop1()
+ end if
+ ornrpt = .false.
+ else if (dumq .eq. 'g') then
+ if (issegno) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Sorry, only one "segno" per input block!')
+ call stop1()
+ else if (ivx .ne. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'segno can only be in voice 1!')
+ call stop1()
+ end if
+ issegno = .true.
+12 call g1etchar(lineq,iccount,dumq)
+ if (dumq.eq.'-' .or.
+ * (ichar(dumq).ge.48.and.ichar(dumq).le.58)) go to 12
+ if (dumq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in segno ornament symbol!')
+ call stop1()
+ end if
+ else if (dumq .eq. 'T') then
+c
+c Trill. may be followed by 't' and/or number. read 'til blank
+c
+22 call g1etchar(lineq,iccount,dumq)
+ if (dumq .eq. ':') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected blank after ":"!')
+ call stop1()
+ end if
+ go to 32
+ else if (dumq .ne. ' ') then
+ go to 22
+ end if
+ else if (dumq .eq. 'f') then
+ call g1etchar(lineq,iccount,dumq)
+ if (index(' d+-:',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "f" in fermata ornament symbol!')
+ call stop1()
+ end if
+ if (dumq .eq. 'd') call g1etchar(lineq,iccount,dumq)
+ if (dumq .eq. ':') go to 32
+ else if (dumq .eq. 'e') then
+ call g1etchar(lineq,iccount,dumq)
+ if (index('sfn?',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "e" in edit. accid. symbol!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (dumq .eq. '?') call g1etchar(lineq,iccount,dumq)
+ else
+ call g1etchar(lineq,iccount,dumq)
+ end if
+ if (index('+- :',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in ornament symbol!')
+ call stop1()
+ end if
+ if (index('+-',dumq) .gt. 0) then
+ if (index('0123456789',lineq(iccount+1:iccount+1)).eq.0) then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'There should be an integer here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (durq .eq. ':') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot shift AND repeat an ornament!')
+ call stop1()
+ end if
+c
+c 12/7/03 Allow horizontal shift on any ornament, not just breath and caes.
+c
+ if (index('+-',durq) .gt. 0) then
+ if (index('.0123456789',lineq(iccount+1:iccount+1))
+ * .eq. 0) then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'There should be a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ end if
+32 continue
+ if (dumq .eq. ':') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '":" must be followed by blank in "o: "!')
+ call stop1()
+ else if (ornrpt) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Turned on repeated ornaments but already on!')
+ call stop1()
+ end if
+ ornrpt = .true.
+ end if
+ else if (index('st(){}',charq) .gt. 0) then
+ numint = 0
+ iposn = 0
+8 call g1etchar(lineq,iccount,dumq)
+ iposn = iposn+1
+ if (charq.eq.'t' .and. dumq.eq.'t') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot use "t" as an option on a tie!')
+ call stop1()
+ end if
+ if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then
+c
+c Check for explicit ID code.
+c
+ ic = ichar(dumq)
+ if (ic.lt.48 .or. (ic.gt.57.and.ic.lt.65) .or.
+ * ic.gt.90) then
+c
+c Not 0-9 or A-Z, so exit
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in slur symbol!')
+ call stop1()
+ else
+c
+c It is a possible ID code. Right place?
+c
+ if (iposn .ne. 1) then
+c
+c Slur ID is not 2nd!
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slur ID must be second character in slur symbol!')
+ call stop1()
+ else if (charq.eq.'t' .and. fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slur ID not allowed on non-postscript tie!')
+ call stop1()
+ else if (lineq(iccount+1:iccount+1).eq.'x') then
+ iccount = iccount+1
+ end if
+ end if
+c
+c Slur ID is OK. Note it cannot be "H" at this point..
+c
+ go to 8
+ else if (dumq .eq. 'H') then
+ if (iposn .eq. 1) go to 8
+c
+c "H" is NOT an ID code.
+c
+ if (.not.fontslur .and. charq.eq.'t') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot reshape postscript ties this way!')
+ call stop1()
+ end if
+ if (lineq(iccount+1:iccount+1) .eq. 'H') then
+ iccount=iccount+1
+ iposn = iposn+1
+ end if
+ go to 8
+ else if (index('fh',dumq).gt.0 .and. .not.fontslur
+ * .and. charq.eq.'t') then
+c
+c 3/9/03 Can't reshape postscript tie.
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot reshape postscript ties this way!')
+ call stop1()
+ else if (dumq .eq. 'p') then
+c
+c local change in postscript slur/tie adjustment default
+c
+ if (fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must use postscript slurs ("Ap") to use this option!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('+-',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected "+" or "-" here!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('st',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected "s" or "t" here!')
+ call stop1()
+ end if
+ iposn = iposn+2
+ go to 8
+ end if
+ if (index('udltbfnh',dumq) .gt. 0) then
+ go to 8
+ else if (index('+-',dumq) .gt. 0) then
+ numint = numint+1
+ if (fontslur .and. charq.eq.'t') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"+|-" for slur height only allowed in "s"-slurs!')
+ call stop1()
+ end if
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (numint .eq. 1) then
+ if (nint(fnum) .gt. 30) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Magnitude of slur height adjustment cannot exceed 30!')
+ call stop1()
+ end if
+ else if (numint .eq. 2) then
+ if (abs(fnum) .gt. 6.3) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur horiz shift must be in range (-6.3,6.3)!')
+ call stop1()
+ end if
+ else
+c
+c Third signed integer, must be a midslur or curve spec.
+c
+ if (abs(fnum).gt.31) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur midheight must be in the range (-31,31)!')
+ call stop1()
+ end if
+ if (durq .eq. ':') then
+c
+c Expecting curve parameters. Get two numbers
+c
+ do 41 i = 1 , 2
+ iccount = iccount+1
+ fnum = ichar(lineq(iccount:iccount))-48
+ if (abs(fnum-3.5) .gt. 3.6) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Slur curve parameter must be in range (0,7)!')
+ call stop1()
+ end if
+41 continue
+ iccount = iccount+1
+ end if
+ end if
+ iccount = iccount-1
+ go to 8
+ else if (dumq .eq. 's') then
+c
+c What follows should be one or two signed numbers for adjustment of line break
+c slur, end of 1st segment or start of second.
+c
+ if (fontslur) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'May not use linebreak slur options with font-based slurs!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,dumq)
+ if (index('+-',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This character must be "+" or "-"!')
+ call stop1()
+ end if
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (nint(fnum) .gt. 30) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Magnitude of slur height adjustment cannot exceed 30!')
+ call stop1()
+ end if
+ if (index('+-',dumq) .gt. 0) then
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (abs(fnum) .gt. 6.3) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Slur horiz shift must be in range (-6.3,6.3)!')
+ call stop1()
+ end if
+ end if
+ iccount = iccount-1
+ go to 8
+ else if (dumq .eq. 'H' .and. iposn.gt.1) then
+ if (lineq(iccount+1:iccount+1) .eq. 'H') iccount=iccount+1
+ go to 8
+ end if
+ else if (charq .eq. '?') then
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ' ') then
+ iccount = iccount-1
+ else
+ if (durq .ne. '-') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expecting "-"!')
+ call stop1()
+ end if
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expecting number!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ end if
+ else if ((ichar(charq).ge.48.and.ichar(charq).le.57) .or.
+ * index('#-nx_',charq) .gt. 0) then
+c
+c We have a figure. Must come AFTER the note it goes under
+c
+ if (itsofar(ivx).eq.0 .and.
+ * (.not.firstline.or.lenbr0.eq.0.or.lenbar.eq.lenbr0)) then
+c
+c Figure before first note in block
+c
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot put figure before first note in block!')
+ call stop1()
+ end if
+ if (charq.eq.'x') then
+ indxb = index(lineq(iccount:128),' ')
+ if (indxb .lt. 5) then
+ call errmsg(lineq,iccount+indxb-1,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot have a blank here in floating figure!')
+ call stop1()
+ end if
+ end if
+ if (usefig) ifig = 1
+5 call g1etchar(lineq,iccount,charq)
+ if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in figure!')
+ call stop1()
+ else if (charq .eq. '+') then
+c
+c vertical offset, must be integer, then blank
+c
+ call g1etchar(lineq,iccount,charq)
+ if (index('123456789',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Integer for vertical offset expected here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,charq,fnum)
+ if (charq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Vertical offset must terminate figure!')
+ call stop1()
+ end if
+ iccount = iccount-1
+ go to 5
+ else if (charq .eq. 's') then
+ isligfont = .true.
+ end if
+ if (charq .ne. ' ') go to 5
+ else if (charq .eq. '[') then
+ if (fbon) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Started forced beam while another was open!')
+ call stop1()
+ end if
+ fbon = .true.
+17 call g1etchar(lineq,iccount,charq)
+ if (index('uljhf:',charq) .gt. 0) then
+ go to 17
+ else if (index('+-',charq) .gt. 0) then
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 17
+ else if (charq .eq. 'm') then
+c
+c Forced multiplicity, next char should be 1-4
+c
+ call g1etchar(lineq,iccount,charq)
+ if (index('1234',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Forced multiplicity for a beam must be 1, 2, 3, or 4!')
+ call stop1()
+ end if
+ go to 17
+ else if (charq .ne. ' ') then
+ if (index('0123456789',charq) .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'After "[", digits must now be preceeded by "+" or "-"!')
+ print*,'You will have to edit older sources to meet this rqmt,'
+ print*,'but it was needed to allow 2-digit height adjustments.'
+ print*,'Sorry for the inconvenience. --The Management'
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after [!')
+ end if
+ call stop1()
+ end if
+ else if (charq .eq. ']') then
+ if (.not.fbon) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Forced beam stop with no corresponding start!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,charq)
+ if (charq .eq. '-') then
+ if (lineq(iccount+1:iccount+2) .ne. '[ ') then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'Only sequence allowed here is "[ "!')
+ call stop1()
+ else
+ iccount = iccount+2
+ end if
+ else if (charq .eq. '[') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'This character must be a blank!')
+ call stop1()
+ end if
+ else
+c
+c Forced beam is really ending
+c
+ fbon = .false.
+ if (charq .eq. 'j') then
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'This character must be a blank!')
+ call stop1()
+ end if
+ else if (charq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"]" must be followed by blank, "j", "-", or "["!')
+ call stop1()
+ end if
+ end if
+ else if (charq .eq. 'D') then
+c
+c Dynamic mark
+c
+ if (nnl(ivx) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"D" must not come before any notes have been entered!')
+ call stop1()
+ end if
+ call checkdyn(lineq,iccount,ibarcnt-ibaroff+nbars+1)
+ else if (index('lhw',charq) .gt. 0) then
+c
+c Save position for later check
+c
+ icclhw = iccount
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.+- ',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "l", "w", or "h"!')
+ call stop1()
+ end if
+ isheadr = isheadr .or. charq .eq. 'h'
+ if (index(' +-',durq) .gt. 0) then
+c
+c There is a header (or lower string?)
+c
+ if (index('+-',durq) .gt. 0) then
+c
+c User-defined vert offset (\internote).
+c
+ if (charq .ne. 'h') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"+" or "-" not permitted here!')
+ call stop1()
+ end if
+c
+c Have "h" followed by +/- . Check for digit.
+c Can blow durq since not using fnum for now, but...
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be a digit here!')
+ call stop1()
+ end if
+c
+c Have "h" followed by +/- followed by a digit. No need to get the number.
+c
+c call readnum(lineq,iccount,durq,fnum)
+ end if
+ if (charq .ne. 'w') then
+c
+c Header or lower string.
+c
+ if (icclhw .ne. 1) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * '"h" or "l" must be first character in line!')
+ call stop1()
+ end if
+c
+c Read past the next line, which has the string.
+c
+ call read10(charq,lastchar)
+ nline = nline+1
+ iccount = 128
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Symbol "w" (width) must be followed by a digit!')
+ call stop1()
+ end if
+ else
+c
+c Height or width change spec. Check if at start of piece.
+c
+ if (ibarcnt .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Symbol must go at top of first input block!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,dimen)
+c
+c Check units. Convert to points
+c
+ if (durq .eq. ' ' .or. durq .eq. 'p') then
+ dimen = dimen+.5
+ else if (durq .eq. 'i') then
+ dimen = dimen*72+.5
+ else if (durq .eq. 'm') then
+ dimen = dimen/25.4*72+.5
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal unit; must be "p","i",or"m"!')
+ call stop1()
+ end if
+c
+c 151211 fix. May have extra character.
+c
+ if (index('pim',durq) .gt. 0) then
+c
+c Get another character, see if it's blank
+c
+ if (lineq(iccount+1:iccount+1) .ne. ' ') then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'This character should be a blank!')
+ call stop1()
+ end if
+ end if
+ if (charq .eq. 'h') then
+ ptheight = int(dimen)
+ else
+ widthpt = int(dimen)
+ end if
+ end if
+ else if (charq .eq. 'm') then
+c
+c Time signature change. Only allow at beginning of block.
+c mtrnuml, mtrdenl (logical) and p (printable) will be input.
+c mtrnuml=0 initially. (In common)
+c
+c Check whether at beginning of a block
+c
+ if (ivx.ne.1 .or. nnl(1).ne.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Meter change only OK in voice 1, at start of block!')
+ print*,'voice number is',ivx
+ call stop1()
+ end if
+ newmeter = .true.
+ if (index('o0123456789',lineq(iccount+1:iccount+1)).eq.0) then
+ call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in "m" command for meter change!')
+ call stop1()
+ end if
+ call readmeter(lineq,iccount,mtrnuml,mtrdenl)
+ if (mtrnuml .eq. 0) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Digit 0 not allowed here!')
+ call stop1()
+ end if
+ call readmeter(lineq,iccount,mtrnmp,mtrdnp)
+c
+c Read past printed time signature; not used in pmxa.
+c
+ lenbeat = i1fnodur(mtrdenl,'x')
+ lenmult = 1
+ if (mtrdenl .eq. 2) then
+ lenbeat = 16
+ lenmult = 2
+ end if
+ lenbar = lenmult*mtrnuml*lenbeat
+ mtrnuml = 0
+ else if (charq .eq. 'C') then
+ call g1etchar(lineq,iccount,durq)
+ if (.not.(index('tsmanrbf',durq).gt.0 .or.
+ * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!')
+ call stop1()
+ end if
+ else if (charq .eq. 'R') then
+ if (ivx .ne. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Repeats can only go in voice 1!')
+ call stop1()
+ end if
+c10 call g1etchar(lineq,iccount,durq)
+c if (index('lrdDbz',durq) .gt. 0) go to 10
+c if (durq .ne. ' ') then
+c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+c * 'Illegal character after "R" (repeat/double bar)!')
+c call stop1()
+c end if
+ call g1etchar(lineq,iccount,durq)
+ call g1etchar(lineq,iccount,dumq)
+ if (index('l Xr Xd XD Xb Xz XlrXdlX',durq//dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "R*" (repeat/double bar)!')
+ call stop1()
+ end if
+ if (dumq .ne. ' ') then
+ call g1etchar(lineq,iccount,durq)
+ if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have blank after "R**" (repeat/double bar)!')
+ call stop1()
+ end if
+ end if
+ else if (charq .eq. 'V') then
+c
+c Ending
+c
+ if (iv .ne. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Voltas are only allowed in voice #1!')
+ call stop1()
+ else if (isvolt) then
+ print*
+ print*,'*******WARNING********'
+ write(15,'(/,a)')'*******WARNING********'
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There is more than one volta in this input block.!')
+ print*,'This may work in a score, but WILL NOT work in parts.'
+ print*,
+ *'Safest to have only 1 volta per block, at the start of the block'
+ write(15,'(a)')
+ * 'This may work in a score, but WILL NOT work in parts.'
+ write(15,'(a)')
+ *'Safest to have only 1 volta per block, at the start of the block'
+ end if
+ isvolt = .true.
+ lvoltxt = 0
+11 call g1etchar(lineq,iccount,durq)
+ if (durq .ne.' ') then
+ go to 11
+ end if
+ else if (charq .eq. 'B') then
+ continue
+ else if (charq .eq. 'P') then
+ if (ivx.ne.1 .or. nnl(1).ne.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only allowed at beginning of block!')
+ call stop1()
+ end if
+16 call g1etchar(lineq,iccount,durq)
+ if (durq.eq.'l'.or.durq.eq.'r'.or.(ichar(durq).ge.48 .and.
+ * ichar(durq).le.57)) go to 16
+ if (durq .eq. 'c') then
+c
+c Expect a centered name, and it has to be last option
+c
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. chax(34)) then
+c
+c Quoted name, go to next quote mark
+c
+ do 35 iccount = iccount+1 , 127
+ if (lineq(iccount:iccount).eq.chax(34) .and.
+ * lineq(iccount-1:iccount-1).ne.chax(92)) go to 36
+35 continue
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Missing close quote after page number command (P)!')
+ call stop1()
+36 continue
+ else if (durq .ne. ' ') then
+c
+c Space-delimited name, look for next blank
+c
+ do 37 iccount = iccount+1 , 127
+ if (lineq(iccount:iccount) .eq. ' ') go to 38
+37 continue
+38 continue
+ end if
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only "l","r","c" or digit allowed after "P"!')
+ call stop1()
+ end if
+ else if (charq .eq. 'W') then
+ call g1etchar(lineq,iccount,durq)
+ if (index('.0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a number to start here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,wminnh(ibarcnt+nbars+1))
+ else if (charq .eq. 'T') then
+c
+c Titles
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('itc',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must put "i", "t", or "c" after "T"!')
+ call stop1()
+ end if
+ ihead = ihead+2**(index('itc',durq)-1)
+c
+c Maybe a number after 'Tt', but ignore here. Read past string on next line.
+c
+ call read10(charq,lastchar)
+ nline = nline+1
+ iccount = 128
+ else if (charq .eq. 'A') then
+27 call g1etchar(lineq,iccount,durq)
+ if (index('rbsdK',durq) .gt. 0) then
+ go to 27
+ else if (durq .eq. 'e') then
+c
+c Check for is4bignv. Must do here to catch first \internote, written in topfile
+c before ever calling getnote. Initialize as .false. in pmxa. Make it true only
+c if nv>7, AI not set, Ai not set.
+c
+ is4bignv = nv.gt.7 .and. .not.AIset
+ go to 27
+ else if (durq .eq. 'v') then
+ if (ibarcnt .eq. 0) novshrinktop = .true.
+ go to 27
+ else if (durq .eq. 'a') then
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'After "Aa", need decimal number!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fbar)
+ iccount = iccount-1
+ go to 27
+ else if (durq .eq. 'i') then
+ is4bignv = .false.
+ AIset = .true.
+ call g1etchar(lineq,iccount,durq)
+c
+c Local interstaff correction. Set to -1. if not specifiec, or after use,
+c or anytime except at top, since pmxb handles all times except at top.
+c
+ call readnum(lineq,iccount,durq,tintstf)
+ if (ibarcnt .eq. 0) fintstf = tintstf
+ iccount = iccount-1
+ go to 27
+ else if (durq .eq. 'I') then
+c
+c Global interstaff correction. Use in place of fintstf if fintstf<0
+c
+ is4bignv = .false.
+ AIset = .true.
+ call g1etchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,gintstf)
+ iccount = iccount-1
+ go to 27
+ else if (durq .eq. 'o') then
+ optimize = .true.
+ go to 27
+ else if (durq .eq. 'S') then
+ do 50 iiv = 1 , noinst
+ call g1etchar(lineq,iccount,durq)
+ if (index('-0st',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'After "AS", need nv instances of "s,t,-,0"!')
+ call stop1()
+ end if
+ if (durq.eq.'-'.or.durq.eq.'s') then
+ isize(iiv) = 1
+ else if (durq.eq.'t') then
+ isize(iiv) = 2
+ end if
+50 continue
+ go to 27
+ else if (durq .eq. 'p') then
+ fontslur = .false.
+42 continue
+ call g1etchar(lineq,iccount,durq)
+ if (index('+-',durq) .gt. 0) then
+c
+c Characters to change defaults for ps slurs
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('shtc',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only letters allowed here are "s","h","t","c"!')
+ call stop1()
+ end if
+c
+c Now check for another default modifier
+c
+ go to 42
+ else if (index('lh',durq) .gt. 0) then
+c
+c Flags for optional linebreak ties or header specials
+c
+ go to 42
+ else
+ iccount = iccount-1
+ end if
+ go to 27
+ else if (durq .eq. 'N') then
+c
+c Override default name for a part file. Must have part number, then
+c partname in quotes. Must be on line by itself, and start in column 1.
+c Will only be passed thru to scor2prt.
+c
+ if (iccount .ne. 2) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"AN" must start in column 1!')
+ call stop1()
+ end if
+ ndxquote = index(lineq,chax(34))
+ if (ndxquote.lt.4 .or. ndxquote.gt.5 .or.
+ * index('123456789',lineq(3:3)).eq.0 .or.
+ * (ndxquote.eq.5.and.index('012',lineq(4:4)).eq.0)) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"AN" must be followed by inst. #, then quote!')
+ call stop1()
+ end if
+ ndxquote = index(lineq(ndxquote+1:128),chax(34))
+ if (ndxquote .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'In "AN", file name must be in quotes!')
+ call stop1()
+ end if
+ iccount = 128
+ else if (durq .eq. 'T') then
+ cstuplet = .true.
+ else if (durq .eq. 'R') then
+c
+c Get full name of normal include file; must occupy remainder of line
+c
+ call getpmxmod(.false.,lineq(iccount+1:128))
+ iccount = 128
+ else if (durq .eq. 'c') then
+ call g1etchar(lineq,iccount,durq)
+ if (index('l4',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only "l" or "4" is allowed here!')
+ call stop1()
+ end if
+ if (durq .eq. 'l' ) then
+ hoffpt = -25
+ voffpt = -45
+ else if (durq .eq. '4') then
+ ptheight = 745
+ widthpt = 499
+ hoffpt = -24
+ voffpt = -24
+ end if
+ go to 27
+ else if (durq .eq. 'V') then
+ call g1etchar(lineq,iccount,durq)
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only "+" or "-" is allowed here!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A number for vert shift before \eject must start here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only "+" or "-" is allowed here!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A number for vert shift after \eject must start here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ go to 27
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+c * 'After "A" must follow one of the letters abcdeiINprRsST!')
+ * 'After "A" must follow one of abcdeiILNprRsSTvV!')
+ print*,'For AS, since ver. 2.7, must only have noinst args.'
+ write(15,'(a)')
+ * 'For AS, since ver. 2.7, must only have noinst args.'
+ call stop1()
+ end if
+ else if (charq .eq. 'K') then
+c
+c Rules and function of K command
+c
+c Only 1 K +/-n +/-m allowed per block if n.ne.0 (transposition). isig1 is
+c initial sig, and must be passed to pmxb because it is needed when topfile
+c is called, which is before the K+n+m command is read in pmxb. Also, we
+c compute and save ibrkch and newkey for each syst, accounting for key changes,
+c then adjust fbar to make poenom much more accurate.
+c Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#.
+c
+77 continue
+ call g1etchar(lineq,iccount,durq)
+c if (index('+-i',durq) .eq. 0) then
+ if (index('+-in',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"K" (transpose or key change) must be followed by "+,-,i,n"!')
+ call stop1()
+ end if
+ if (durq .eq. 'n') go to 77
+ if (durq .ne. 'i') then
+c
+c Normal key change and/or transposition)
+c
+c iccount = iccount+1
+ num1 = 44-ichar(durq)
+c
+c num1= +1 or -1
+c
+ ztrans = num1.eq.-1
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '1st +/- must be followed by a number!')
+ call stop1()
+ end if
+c iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ num1 = nint(fnum)*num1
+ ztrans = ztrans .and. num1.eq.0
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '1st number after "K" must be followed by "+,-"!')
+ call stop1()
+ end if
+ iccount = iccount+1
+ num2 = 44-ichar(durq)
+ call readnum(lineq,iccount,durq,fnum)
+ num2 = num2*int(fnum+.1)
+ if (num1.eq.0 .and. .not.ztrans) then
+c
+c Key change, only one per block allowed
+c
+ if (iskchb) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Only one key change allowed per input block!')
+ call stop1()
+ end if
+ iskchb = .true.
+ nkeys = nkeys+1
+ kchmid(nkeys) = mod(itsofar(ivx),lenbar).ne.0
+c
+c Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak.
+c
+ ibrkch(nkeys) = ibarcnt+nbars
+ if (kchmid(nkeys)) ibrkch(nkeys) = ibrkch(nkeys)+1
+ newkey(nkeys) = num2+idsig
+c 130316
+c do 43 iinst = 1 , noinst
+ midisig = newkey(nkeys)
+c43 continue
+ else
+c
+c Transposition
+c
+ fulltrans = .true.
+ if (ibarcnt .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Transposition must be at top of first input block!')
+ call stop1()
+ end if
+ isig1 = num2
+ idsig = isig1-newkey(1)
+c
+c idsig is the difference between sig after transposition, and sig in setup.
+c It may alter # of accid's in key changes if there is transposition.
+c
+ end if
+ else ! durq='i'
+c
+c 110522/110529
+c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
+c and repeat i[...] for multiple instruments. Store info here if ibarcnt=0
+c so can pass to topfile (via comInstTrans), which is called before getnote.
+c Otherwise, will store info from getnote. Initialize EarlyTransOn and
+c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from here;
+c LaterInstTrans from g1etnote. Zero both out after use. nInstTrans really
+c only needed for instrument-signatures, not transpositions. iTransAmt is
+c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
+c each staff.
+c
+ call GetiTransInfo(.true.,ibarcnt,lineq,iccount,
+ * ibaroff,nbars,noinst)
+ end if
+ else if (charq .eq. '|') then
+c
+c Optional bar symbol
+c
+ if (mod(itsofar(ivx),lenbar).ne.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Bar line marker out of place!')
+ call stop1()
+ else if (shifton) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Bar ended with user-defined shift still on!')
+ call stop1()
+ end if
+ else if (charq .eq. chax(47)) then
+ if (ornrpt) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'WARNING: Block ended with repeated ornament still on!')
+ ornrpt = .false.
+ end if
+ if (stickyS) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'WARNING: Block ended with sticky stemshrink still on!')
+ stickyS = .false.
+ end if
+ if (fbon) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Block ended with forced beam open!')
+ call stop1()
+ else if (shifton) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Bar ended with user-defined shift still on!')
+ call stop1()
+ end if
+ barend = .false.
+c
+c Perform time checks
+c
+ if (mod(itsofar(ivx),lenbar).ne.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Block duration not divisible by lenbar!')
+ print*,'lenbar, timesofar are ',lenbar,itsofar(ivx)
+ call stop1()
+ else if (ivx.gt.1 .and. itsofar(ivx).ne.itsofar(1)) then
+ print*
+ print*,'No of bars in voice 1, current voice:',
+ * itsofar(1)/lenbar,itsofar(ivx)/lenbar
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Block duration not equal to voice 1!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. ' ' .and. iv.eq.nv) then
+c
+c End of input block
+c
+ loop = .false.
+ else
+c
+c Start a new voice
+c
+ if (lenbr0.ne.0 .and. firstline) lenbar = lenbr0
+ nbars = 0
+ if (durq .eq. ' ') then
+c
+c New voice is on next staff
+c
+ iv = iv+1
+ ivx = iv
+ else
+c
+c New voice is on same staff. Set up for it
+c
+ ivx = nv+1
+ do 23 iiv = 1 , nv
+ if (nvmx(iiv) .eq. 2) ivx = ivx+1
+23 continue
+ if (ivx .gt. nm) then
+ write(*,'(1x,a21,i3,a23)')'Cannot have more than',nm,
+ * ' lines of music at once'
+ call stop1()
+ end if
+ nvmx(iv) = 2
+ ivmx(iv,2) = ivx
+ itsofar(ivx) = 0
+ nnl(ivx) = 0
+ do 24 j = 1 , 200
+ rest(ivx,j) = .false.
+ nacc(ivx,j) = 0
+24 continue
+c
+c For midi stuff, record that there is a 2nd line of music in this voice
+c
+ if (ismidi) twoline(iv) = .true.
+ end if
+ end if
+ iccount = 128
+ else if (charq .eq. 'S') then
+c
+c New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs.
+c
+ if (ibarcnt .gt. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"S" can only be in first input block!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789 ',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'A digit must follow "S"!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnsyst)
+ nsyst = nint(fnsyst)
+14 continue
+ if (durq .eq. 'P') then
+c
+c New npages for parts.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789 ',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnsyst)
+ npages = nint(fnsyst)
+ go to 14
+ else if (durq .eq. 'm') then
+c
+c Reset musize (musicsize).
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789 ',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnsyst)
+ musize = nint(fnsyst)
+ wheadpt = whead20*musize
+ go to 14
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in "S" symbol!')
+ call stop1()
+ end if
+ else if (charq .eq. 'L') then
+c
+c Force line break
+c
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. 'C') then
+c
+c Coda, no real line break, just get coda length
+c
+ if (ishort .ne. 1) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot use "LC" without first using "L[n]S"!')
+ call stop1()
+ end if
+ ishort = 0
+ call g1etchar(lineq,iccount,durq)
+ if (index('1234567890.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need number to define coda length!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,codafrac)
+ poefa(isysflb(nflb)) = poefa(isysflb(nflb))+codafrac
+ if (index(' n',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need blank or "n" here!')
+ call stop1()
+ end if
+ return
+ end if
+ nflb = nflb+1
+ ibarflb(nflb) = ibarcnt+nbars+1
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need integer to define forced line break!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,sysflb)
+ isysflb(nflb) = nint(sysflb)
+ if (isysflb(nflb) .eq. 1) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'For now, "L1" not allowed!')
+ call stop1()
+ end if
+ if (nflb .gt. 1) then
+c
+c Check if new number is > prior one
+c
+ if (isysflb(nflb) .le. isysflb(nflb-1)) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'You already forced a line break at a later line!')
+ call stop1()
+ end if
+ end if
+ if (npages .eq. 0) then
+ print*
+ print*,'WARNING! You forced a line break at line ',
+ * isysflb(nflb),' but npage = 0. Continue?'
+c read(*,'(a)') charq
+c if (index('yY',charq) .eq. 0) call stop1()
+ else if (isysflb(nflb) .gt. nsyst) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Forced line break at line num > nsyst!')
+ call stop1()
+ else if (index(' PMS',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have " ", "P", "M", or "S" here!')
+ call stop1()
+ end if
+49 continue ! Transfer up from below to allow S after M
+ if (durq .eq. 'S') then
+c
+c Shortened line, get shortening fraction
+c
+ ishort = 1
+ call g1etchar(lineq,iccount,durq)
+ if (index('1234567890.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need number to define line shortening fraction!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,shortfrac)
+ poefa(isysflb(nflb)) = shortfrac
+ if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need blank here!')
+ end if
+ end if
+ if (durq .eq. 'P') then
+c
+c Forced page break here, get page number.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Need integer to define forced page break!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ nfpb = nfpb+1
+ ipagfpb(nfpb) = nint(fnum)
+ isysfpb(nfpb) = isysflb(nflb)
+ if (ipagfpb(nfpb) .gt. npages) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Forced page break at page num > npages!')
+ call stop1()
+ else if (nfpb .gt. 1) then
+ if (ipagfpb(nfpb) .le. (ipagfpb(nfpb-1))) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Forced page break numbers must increase!')
+ call stop1()
+ end if
+ end if
+ end if
+ if (index(' M',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in linebreak symbol!')
+ call stop1()
+ else if (durq .eq. 'M') then
+ nmovbrk = nmovbrk+1
+ isysmb(nmovbrk) = isysflb(nflb)
+ call g1etchar(lineq,iccount,durq)
+31 if (durq .eq. '+') then
+c
+c Vertical spacing, read past number.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Integer required here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ go to 31
+ else if (durq .eq. 'i') then
+c
+c Change indentation,
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('.123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Decimal number required here!')
+ call stop1()
+ end if
+c
+c fracsys was initialized in block data to all 0.'s
+c
+ call readnum(lineq,iccount,durq,fracsys(nmovbrk))
+ go to 31
+ else if (durq .eq. 'c') then
+ call g1etchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'r') then
+ call g1etchar(lineq,iccount,durq)
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have "+" or "-" after "r" as movement break option!')
+ call stop1()
+ end if
+ call g1etchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'n') then
+c
+c Change # of voices. Input ninow, iorig(1...ninow). Will use names,
+c staves per inst. and clefs corr. to iorig in original list of instruments.
+c
+ nv = 0
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. ':') then
+c
+c Signals a 2-digit number, get next two characters
+c
+ call g1etchar(lineq,iccount,durq)
+ call g1etchar(lineq,iccount,dumq)
+ if (index('12',durq).eq.0
+ * .or.index('0123456789',dumq).eq.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal new number of instruments '//durq//dumq//
+ * ' at movement break!')
+ call stop1()
+ end if
+ read(lineq(iccount-1:iccount),'(i2)')ninow
+ else
+c
+c durq is a single digit number for noinow
+c
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal new number of instruments '//durq//
+ * ' at movement break!')
+ call stop1()
+ end if
+ ninow = ichar(durq)-48
+ end if
+ if (ninow.gt.noinst) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'New number of instruments must be <= original!')
+ call stop1()
+ end if
+ do 63 iinow = 1 , ninow
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. ':') then
+c
+c Signals a 2-digit number
+c
+ call g1etchar(lineq,iccount,durq)
+ call g1etchar(lineq,iccount,dumq)
+ if (index('12',durq).eq.0
+ * .or.index('0123456789',dumq).eq.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal 2-digit instrument number '//durq//dumq//
+ * ' at movement break!')
+ call stop1()
+ end if
+ read(lineq(iccount-1:iccount),'(i2)')iorig
+ else
+c
+c durq is a single digit number for iorig
+c
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal instrument number '//durq//
+ * ' at movement break!')
+ call stop1()
+ end if
+ iorig = ichar(durq)-48
+ end if
+ if (iorig .gt. noinst) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'New instrument number must be <= original noinst!')
+ call stop1()
+ end if
+ nv = nv+nsperi(iorig)
+63 continue
+ do 61 iiv = 1 , nv
+c
+c Get clef names
+c
+ call g1etchar(lineq,iccount,durq)
+ if (.not.(index('tsmanrbf',durq).gt.0 .or.
+c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then
+ * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must have t,s,m,a,n,r,b,f or 1-7 as clef symbol here!')
+ call stop1()
+ end if
+c
+c Initialize new voices
+c
+ nvmx(iiv) = 1
+ ivmx(iiv,1) = iiv
+ itsofar(iiv) = 0
+ nnl(iiv) = 0
+ do 62 j = 1 , 200
+ rest(iiv,j) = .false.
+62 continue
+61 continue
+c
+c Loop back up, this might not be last option in M
+c
+ call g1etchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'S') then
+ go to 49
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after Movement break symbol!')
+ call stop1()
+ end if
+ if (fracsys(nmovbrk) .lt. 0.001) then
+c
+c Since fracsys was not explicitly set, set it to prior value.
+c
+ if (nmovbrk .eq. 1) then
+ fracsys(nmovbrk) = fracindent
+ else
+ fracsys(nmovbrk) = fracsys(nmovbrk-1)
+ end if
+ end if
+ end if
+c
+c Just before exiting if-block for forced line breaks, set counter to use when
+c dealing with vertical space calcs
+c
+ nistaff(nflb) = nv-1
+ else if (charq .eq. 'F') then
+ usefig = .false.
+ else if (charq .eq. 'X') then
+ call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1,
+ * udsp(ibarcnt+nbars+1),wheadpt)
+ else if (charq .eq. 'I') then
+c
+c MIDI settings.
+c
+ if (ivx.ne.1 .or. nnl(1).ne.0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'MIDI stuff only allowed at start of block!')
+ call stop1()
+ end if
+ if (nv .gt. 15) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Sorry but MIDI does not work with more than 15 voices!')
+ call stop1()
+ end if
+ ismidi = .true.
+ call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
+ * mtrdenl,nv,.true.)
+ else if (charq .eq. 'M') then
+ call setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,ivx,
+ * nline)
+ else if (index(',.',charq) .gt. 0) then
+c
+c Continued rhythmic shortcut
+c
+ idotform = index('. ,',charq)
+ if (idotform .eq. 1) then
+c
+c Change duration of prior note
+c
+ itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2
+ itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
+ end if
+ idotform = idotform+1
+ numnum = 1
+ cdot = .true.
+ go to 1
+ else
+ print*,'ASCII code:',ichar(charq)
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'This character is not allowed here!')
+ print*,'ASCII code:',ichar(charq)
+ call stop1()
+ end if
+ return
+ end
+ subroutine g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
+ * xmtrnum0,newkey,npages,nsyst,musize,bottreb)
+ parameter(nm=24,maxblks=9600)
+ character*131072 bufq
+ character*1 chax
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ character*128 lineq
+ logical lastchar,issegno,isheadr,isvolt,fbon,bottreb,
+ * newway
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ common /commidisig/ midisig
+c
+c Get the first line
+c
+ iccount = 0
+ nline = 1
+9 call getbuf(lineq)
+ if (lineq(1:1) .eq. '%') then
+ nline = nline+1
+ go to 9
+ end if
+ if (lineq(1:3) .eq. '---') then
+c
+c Have TeX input until next line that starts with '---'
+c
+3 nline = nline+1
+ call getbuf(lineq)
+ if (ilbuf .gt. nlbuf) go to 1
+ go to 2
+1 print*,'You did not terminate type 0 TeX input with "---"'
+ call stop1()
+2 continue
+ if (lineq(1:3) .ne. '---') go to 3
+c
+c Force a new line read on first call to readin
+c
+ iccount = 128
+ end if
+c
+c Here, lineq and nline are first non-TeX lines.
+c
+ nv = nint(readin(lineq,iccount,nline))
+ if (nv .gt. nm) then
+ write(*,'(1x,a46,i3)')
+ * 'In setup data, number of voices cannot exceed',nm
+ call stop1()
+ end if
+ noinst = nint(readin(lineq,iccount,nline))
+ if (noinst .gt. nv) then
+ write(*,'(a)')
+ * 'In setup data, cannot have more instruments than staves'
+ call stop1()
+ end if
+ newway = noinst.le.0
+ if (newway) noinst = -noinst
+ do 10 iinst = 1 , noinst
+c
+c Seve # of staves per inst in case later drop some inst's.
+c
+ if (newway) then
+ nsperi(iinst) = nint(readin(lineq,iccount,nline))
+ else if (iinst .gt. 1 ) then
+ nsperi(iinst) = 1
+ else
+ nsperi(iinst) = nv-noinst+1
+ end if
+10 continue
+ mtrnuml = nint(readin(lineq,iccount,nline))
+ mtrdenl = nint(readin(lineq,iccount,nline))
+cc
+cc Kluge!!!
+cc
+c if (mtrdenl .eq. 1) then
+c mtrdenl = 2
+c mtrnuml = mtrnuml*2
+c end if
+ mtrnmp = nint(readin(lineq,iccount,nline))
+ mtrdnp = nint(readin(lineq,iccount,nline))
+ if (mtrnmp.eq.0 .and. mtrdnp .ge. 8) then
+ write(*,'(a)')'In setup data, with mtrnmp=0, mtrdnp must be <8'
+ call stop1()
+ end if
+ xmtrnum0 = readin(lineq,iccount,nline)
+ newkey = nint(readin(lineq,iccount,nline))
+c 130316
+c do 11 iinst = 1 , noinst
+ midisig = newkey
+c11 continue
+ npages = nint(readin(lineq,iccount,nline))
+ nsyst = nint(readin(lineq,iccount,nline))
+ musize = nint(readin(lineq,iccount,nline))
+ fracindent = readin(lineq,iccount,nline)
+ if (fracindent .ge. 1.) then
+ write(*,'(a)')'In setup data, fracindent must be <1'
+ call stop1()
+ end if
+ if (npages .gt. nsyst) then
+ print*,'Error in input file: npages > nsyst'
+ call stop1()
+ else if((musize-16)*(musize-20)*(musize-24)*(musize-29).ne.0) then
+ call printl('Musicsize must be 16, 20, 24, or 29')
+ call stop1()
+ end if
+c
+c Next noinst non-comment lines are names of instruments.
+c
+ do 4 i = 1 , abs(noinst)
+5 call getbuf(lineq)
+ nline = nline+1
+ if (lineq(1:1) .eq. '%') go to 5
+4 continue
+c
+c Mext non-comment line has nv clef names
+c
+6 call getbuf(lineq)
+ nline = nline+1
+ if (lineq(1:1) .eq. '%') go to 6
+ do 7 iv = 1 , nv
+c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then
+ if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then
+ call errmsg(lineq,iv,0,
+ * 'There should be a clef symbol here!')
+ call stop1()
+ end if
+7 continue
+ if (lineq(nv+1:nv+1) .ne. ' ') then
+ call errmsg(lineq,nv+1,0,
+ * 'There should be a blank here!')
+ call stop1()
+ end if
+c
+c Set flag if voice 1 is treble, since it affects vertical spacing
+c
+c bottreb = lineq(1:1).eq.'t'
+ bottreb = index('t08',lineq(1:1)).gt.0
+c
+c Next non-comment line has path name
+c
+8 call getbuf(lineq)
+ nline = nline+1
+ if (lineq(1:1) .eq. '%') go to 8
+ lpath = index(lineq,' ')-1
+ if (index('/:'//chax(92),lineq(lpath:lpath)) .eq. 0) then
+ call errmsg(lineq,lpath,0,
+ * 'Last character of pathname is not "/",":", or "'
+ * //chax(92)//'"!')
+ call stop1()
+ end if
+ return
+ end
+ subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt)
+c
+c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol.
+c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
+c
+ logical shifton,number,btest
+ character*128 lineq
+ character*1 charq,dumq
+ number = .false.
+ nPBSc = 0
+1 call g1etchar(lineq,iccount,charq)
+ if (index('PBS:',charq) .gt. 0) then
+c
+c Continue checking here even if "P".
+c
+ ipbsc = index('PBS:',charq)
+ if (btest(nPBSc,ipbsc)) then
+ call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!')
+ call stop1()
+ end if
+ nPBSc = ibset(nPBSc,ipbsc)
+ go to 1
+ else if (index('+-.0123456789',charq) .gt. 0) then
+ number = .true.
+ if (index('+-',charq) .gt. 0) then
+ call g1etchar(lineq,iccount,dumq)
+ if (index('.0123456789',dumq) .eq. 0) then
+ call errmsg(lineq,iccount,ibar,'Expected a number here!')
+ call stop1()
+ end if
+ end if
+ call readnum(lineq,iccount,dumq,fnum)
+ if (charq.eq.'-') fnum = -fnum
+ if (dumq .ne. 'p') then
+ iccount = iccount-1
+ fnum = fnum*wheadpt
+ end if
+ go to 1
+ else if (charq .ne. ' ') then
+ call errmsg(lineq,iccount,ibar,'Not allowed in "X" symbol!')
+ call stop1()
+ end if
+c
+c Done with parsing. Other checks
+c
+ if (iand(6,nPBSc).eq.6 .or. iand(24,nPBSc).eq.24) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Cannot have both "P" and "B" or "S" and ":"!')
+ call stop1()
+ end if
+ if (btest(nPBSc,4)) then
+ if (number) then
+ if (shifton) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Started a group shift without stopping prior one!')
+ call stop1()
+ else
+ shifton = .true.
+ end if
+ else
+ if (.not. shifton) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Ended a group shift without starting one!')
+ call stop1()
+ else
+ shifton = .false.
+ end if
+ end if
+ end if
+c
+c P off, S off, c off => normal user-defined space. Add to udsp (later fsyst)
+c
+ if (iand(nPBSc,26).eq.0) udsp = udsp+fnum
+ if (.not.number .and. .not.btest(nPBSc,4)) then
+ call errmsg(lineq,iccount-1,ibar,
+ * 'Must have either a number or a colon in "X" symbol!')
+ call stop1()
+ end if
+ return
+ end
+c integer*4 function mytime()
+c CHARACTER(10) tq
+c CALL DATE_AND_TIME(TIME=tq)
+c read(tq,'(2i2,f6.3)')ih,im,ts
+c mytime = 1000*(ts+60*(im+60*ih))
+c return
+c end
+ subroutine getbuf(lineq)
+ parameter (maxblks=9600)
+ character*(*) lineq
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ lineq = bufq(ipbuf+1:ipbuf+lbuf(ilbuf))
+ ipbuf = ipbuf+lbuf(ilbuf)
+ ilbuf = ilbuf+1
+ return
+ end
+ subroutine getchar(lineq,iccount,charq)
+ parameter (nm=24)
+c
+c Gets the next character out of lineq*128. If pointer iccount=128 on entry,
+c then reads in a new line. Resets iccount. Ends program if no more input.
+c
+ common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
+ * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
+ * rptprev,equalize,rptfq1,rptfq2
+ logical lastchar,rptnd1,sluron,fbon,rptprev,ornrpt
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ logical mrecord,mplay,endmac,equalize,stickyS
+ character*1 charq,rptfq1,rptfq2
+ character*128 lineq,lnholdq
+ if (iccount .eq. 128) then
+ call read10(lineq,lastchar)
+ if (lastchar) return
+ if (.not. endmac) then
+ iccount = 0
+ else
+ endmac = .false.
+ iccount = icchold
+ lineq = lnholdq
+ end if
+ if (mrecord) then
+ call mrec1(lineq,iccount,ndxm)
+ end if
+ end if
+ iccount = iccount+1
+ charq = lineq(iccount:iccount)
+ return
+ end
+ subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount)
+ parameter (nm=24)
+ common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
+ * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
+ * idynda2(99),levhssav(nm),listcresc,listdecresc
+ character*128 txtdynq
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ logical fontslur,upslur,WrotePsslurDefaults
+ character*1 durq,chax
+ character*4 dynsymq
+ character*128 lineq
+c
+c Get info for dynamic mark. Enter after getting "D", iccount sits on "D"
+c Bits in idyndat are as follows
+c 00-03 ivx
+c 04-11 ip
+c 12-15 code for type of mark
+c 0 => arbitrary text
+c 1-12 => pppp,ppp,pp,p,mp,mf,f,fp,sfz,ff,fff,ffff
+c If (.not. fontslur)
+c 13 => hairpin start, 14,15 => <,> (ending)
+c else
+c 13 < start, 14 > start, 15 ending
+c end if
+c 16 flag for vertical offset
+c 17-23 vertical offset + 64 , \internote
+c 31 Hairpin start (0), stop (1)
+c
+c idynda2
+c
+c 00 flag for horizontal offset
+c 01-09 (horizontal offset)/10 + 25.6 notehead widths
+c 10 5th bit for ivx (5/15/10)
+c
+ irest = ibset(irest,26)
+ ndyn = ndyn+1
+ idyn = ivx
+ idynda2(ndyn) = 0
+ if (ivx .ge. 16) call setbits(idynda2(ndyn),1,10,1)
+ call setbits(idyn,8,4,ip)
+ if (lineq(iccount+1:iccount+1) .eq. chax(34)) then
+c
+c text-dynamic
+c
+ ntxtdyn = ntxtdyn+1
+ iccountt = iccount
+3 continue
+ iend = iccountt+index(lineq(iccountt+2:128),chax(34))+2
+ if (lineq(iend-2:iend-2) .eq. chax(92)) then
+ iccountt = iend-2
+ go to 3
+ end if
+ txtdynq(ntxtdyn) = lineq(iccount+2:iend-2)
+c
+c Store ivx, ip in bits 0-12
+c
+ ivxiptxt(ntxtdyn) = ivx+32*ip
+ ipm = index('- +',lineq(iend:iend))
+ idno = 0
+ else
+c
+c Word-group or hairpin
+c
+ do 1 iend = iccount+2 , 128
+ ipm = index('- +',lineq(iend:iend))
+c
+c Exit the loop at first blank, "+", or "-"
+c
+ if (ipm .gt. 0) go to 2
+1 continue
+2 continue
+ read(lineq(iccount+1:iend-1),'(a'//chax(47+iend-iccount)//')')
+ * dynsymq
+ idno = (index(
+ * 'ppppppp pp p mp mf f fp sfz ff fff ffff < > ',
+ * dynsymq)+3)/4
+c
+c Save for later down
+c
+ idno1 = idno
+ end if
+c
+c Set flag to check level later if in beam
+c
+ iornq = ibset(iornq,23)
+ if (idno.ge.14) then
+c
+c Hairpin here. Check if opposite type from one that's already on
+c
+ if (idno.eq.14.and.btest(listdecresc,ivx) .or.
+ * idno.eq.15.and.btest(listcresc,ivx)) then
+ call printl(' ')
+ call printl('Started one kind of hairpin while other is on')
+ call stop1()
+ end if
+c
+c Start or stop?
+c
+ if (btest(listcresc,ivx) .or. btest(listdecresc,ivx)) then
+c
+c Cresc/decresc is on, this is an ending. If fontslur, leave idno as is.
+c
+ if (.not.fontslur) idno = 15
+ else if (fontslur) then
+c
+c Start of font slur
+c
+ idno = 13
+ else
+c
+c Start of postscript slur
+c
+ idno = idno-1
+ end if
+ end if
+c
+c Now that we used list[de]cresc, update
+c
+ if (idno .ge.13) then
+ if (idno.eq.15 .or. (fontslur.and.idno.eq.14)) then
+c
+c Something's ending
+c
+ if (btest(listcresc,ivx)) then
+c
+c It's a cresc!
+c
+ listcresc = ibclr(listcresc,ivx)
+ else
+ listdecresc = ibclr(listdecresc,ivx)
+ end if
+ else
+c
+c Something's starting
+c
+ if (idno1 .eq. 14) then
+c
+c It's a cresc!
+c
+ listcresc = ibset(listcresc,ivx)
+ else
+ listdecresc = ibset(listdecresc,ivx)
+ end if
+ end if
+ end if
+ call setbits(idyn,4,12,idno)
+ iccount = iend
+ if (ipm .ne. 2) then
+c
+c There is a vertical shift
+c
+ idyn = ibset(idyn,16)
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ idno = nint(fnum)
+ call setbits(idyn,7,17,(ipm-2)*idno+64)
+ ipm = index('- +',durq)
+ if (ipm .ne. 2) then
+c
+c There is a horizontal shift
+c
+c idynda2(ndyn) = ibset(idyn,23)
+ idynda2(ndyn) = ibset(idynda2(ndyn),0)
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ idno = nint(10*fnum)
+ call setbits(idynda2(ndyn),9,1,(ipm-2)*idno+256)
+ end if
+c
+c iccount should be on the blank at the end of the entire symbol
+c
+ end if
+ idyndat(ndyn) = idyn
+ return
+ end
+ subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig,
+c * itsofar,nodur,figq,ivupfig,nfigs)
+ * itsofar,nodur,figq,ivupfig,ivvfig,nfigs)
+ logical isfig
+ character*1 charq
+ character*10 figq
+ character*128 lineq
+ nfigs = nfigs+1
+ ivupfig = 0
+ ivvfig = 0
+ itoff = 0
+ if (charq .eq. 'x') then
+c
+c Floating figure.
+c
+ call getchar(lineq,iccount,charq)
+ read(charq,'(i1)')noff
+ call getchar(lineq,iccount,charq)
+ read(charq,'(i1)')loff
+ itoff = noff*ifnodur(loff,'x')
+ call getchar(lineq,iccount,charq)
+ else
+c
+c Figure on a note
+c
+ isfig = .true.
+ end if
+ itfig = itsofar+itoff-nodur
+ lfig = 1
+ figq = charq
+5 call getchar(lineq,iccount,charq)
+c if (index(' +',charq) .eq. 0) then
+ if (index(' +v',charq) .eq. 0) then
+ figq = figq(1:lfig)//charq
+ lfig = lfig+1
+ go to 5
+ else if (charq .eq. '+') then
+c
+c Get vertical offset for figure. Next character after number has to be blank.
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,charq,fnum)
+ ivupfig = nint(fnum)
+ else if (charq .eq. 'v') then
+c
+c Get vertical change in figdrop. Must be last item in figure word.
+c
+ isign = 1
+ call getchar(lineq,iccount,charq)
+ if (charq .eq. '-') then
+ isign=-1
+ call getchar(lineq,iccount,charq)
+ end if
+ ivvfig = isign*(ichar(charq)-48)
+ end if
+ return
+ end
+ subroutine getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
+ * lastlev,iv,nv)
+ parameter (nm=24)
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg
+ character*1 charq,durq
+ character*20 voltxtq
+ character*128 lineq,litq
+ integer*4 islur(nm,200),iornq(nm,0:200),ipl(nm,200),nnl(nm),
+ * ndlev(nm,2)
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+c
+c Grace, comes *before* main note:
+c UNLESS there's an 'A' or 'W' after the 'G'
+c ngrace = # of grace note groups so far in block
+c ivg(ngrace), ipg(ngrace)
+c nng(ngrace) = # of notes in this group: default = 1
+c ngstrt(ngrace) = starting position in nolevg of levels for this grace
+c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)'
+c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
+c slurg(ngrace) = logical for slur; default F, input 's'
+c slashg(ngrace) = T if slash; default is F, input 'x'
+c These data MUST precede note name of first note
+c nolevg, naccg: lists of levels and accid's, indexed as described above.
+c
+ ngrace = ngrace+1
+ ivg(ngrace) = ivx
+ ipg(ngrace) = nnl(ivx)+1
+ if (ngrace .eq. 1) then
+ ngstrt(ngrace) = 1
+ else
+ ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1)
+ end if
+ islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4)
+ nng(ngrace) = 1
+ multg(ngrace) = 1
+ upg(ngrace) = .true.
+ slurg(ngrace) = .false.
+ slashg(ngrace) = .false.
+18 call getchar(lineq,iccount,charq)
+ if (index('WA',charq) .gt. 0) then
+c
+c Grace is on note that was already done, so shift flags forward one note.
+c This puts flag on actual note with grace; later for W will go ahead one more.
+c
+ ipg(ngrace) = nnl(ivx)
+ islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4)
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4)
+ if (slurg(ngrace))
+ * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24)
+ if (charq .eq. 'A') then
+c
+c close After, clear way-after bit, to ensure priority of most recent A/W
+c
+ ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29)
+ else
+c
+c Way after; later assign to following note, and position like normal grace.
+c
+ ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31)
+ end if
+ else if (charq .eq. 'm') then
+ call getchar(lineq,iccount,charq)
+ multg(ngrace) = ichar(charq)-48
+ else if (index('123456789',charq) .gt. 0) then
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ nng(ngrace) = nint(fnum)
+ else if (charq .eq. 'l') then
+ upg(ngrace) = .false.
+ else if (charq .eq. 's') then
+ slurg(ngrace) = .true.
+ if (nnl(ivx) .gt. 0) then
+c
+c If A- or W-grace, set signal to start slur on main note.
+c
+ if(btest(ipl(ivx,nnl(ivx)),31) .or.
+ * btest(ipl(ivx,nnl(ivx)),29))
+ * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24)
+ end if
+ else if (charq .eq. 'x') then
+ slashg(ngrace) = .true.
+ else if (charq .eq. 'u') then
+ else if (charq .eq. 'X') then
+c
+c Space before main note of grace. Number will come next.
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,graspace(ngrace))
+ iccount = iccount-1
+ end if
+ if (index('abcdefg',charq) .eq. 0) go to 18
+c
+c At this point, charq is first note name in grace
+c
+ do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1
+ naccg(ing) = 0
+ ioct = 0
+ if (ing .gt. ngstrt(ngrace)) then
+55 call getchar(lineq,iccount,charq)
+ if (charq .eq. ' ') go to 55
+ endif
+ iclastlev = 0
+9 call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') then
+ if (durq.eq.'+') then
+ lastlev = lastlev+7
+ iclastlev = iclastlev+7
+ else if (durq.eq.'-') then
+ lastlev = lastlev-7
+ iclastlev = iclastlev-7
+ else if (index('fsn',durq) .gt. 0) then
+ if (naccg(ing) .eq. 0) then
+ naccg(ing) = index('fsn',durq)
+ else
+c
+c Double accidental
+c
+ naccg(ing) = ibset(naccg(ing),2)
+ end if
+ else
+ ioct = ichar(durq)-48
+ end if
+ go to 9
+ end if
+ if (ioct .gt. 0) then
+ lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
+ else
+ if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then
+ if (ivx .le. nv) then
+ kv = 1
+ else
+ kv = 2
+ end if
+ lastlev = ndlev(iv,kv)+iclastlev
+ end if
+ lastlev = lastlev-3
+ * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
+ end if
+ nolevg(ing) = lastlev
+19 continue
+c
+c Grace could come before first note of block, so reset end level.
+c
+ if (nnl(ivx).eq.0) then
+ if (ivx .le. nv) then
+ kv = 1
+ else
+ kv = 2
+ end if
+ ndlev(iv,kv) = lastlev
+ end if
+ return
+ end
+ subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount,
+ * ibaroff,nbars,noinst)
+cccccccccccccccccccccccc
+cc
+cc GetiTransInfo.for
+cc
+cccccccccccccccccccccccc
+c
+c Called from both g1etnote and getnote, after first 'i' in Ki[...]
+c On entry, iccount points to last char retrieved, which is 'i'
+c
+c From1: locgical, true if called from g1etnote
+c ibarcnt: tells whether to set EarlyTransOn to true.
+c EarlyTransOn set false in blkdata, true here, back to false in topfile.
+c
+c 110522/110529
+c Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey]
+c and repeat i[...] for multiple instruments. Store info in g1etnot if ibarcnt=0
+c so can pass to topfile (via comInstTrans), which is called before getnote.
+c Otherwise, will store info from getnote. Initialize EarlyTransOn and
+c LaterInstTrans to .false. in blockdata. Set EarlyTransOn from g1etnote;
+c LaterInstTrans from getnote. Zero both out after use. nInstTrans really
+c only needed for instrument-signatures, not transpositions. iTransAmt is
+c ALWAYS active per instrument. Set up instno(iv) so can fetch iTransAmt for
+c each staff.
+c
+c iTransAmt stored as fn of instrument #, not like iTransKey which is
+c fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This
+c simplifies use of iTransAmt for all calls to ifnolev.
+c
+ parameter (nm=24)
+ logical From1
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans,store
+ character*128 lineq
+ character*1 durq
+ durq = 'x' ! Can't initialize in declaration stmt, only works once.
+ if(.not.EarlyTransOn) EarlyTransOn = From1 .and. ibarcnt.eq.0
+ store = (EarlyTransOn.and.ibarcnt.eq.0) .or.
+ * (ibarcnt.gt.0.and..not.From1)
+ LaterInstTrans = .not.From1 .and. ibarcnt.gt.0
+ if (store) nInstTrans = 0
+1 continue
+ if (durq .eq. ' ') return
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be an instrument number here!')
+ call stop1()
+ end if
+ if (store) nInstTrans = nInstTrans+1
+ call readnum(lineq,iccount,durq,fnum)
+ instn = nint(fnum)
+ if (instn.gt.noinst) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Instrument number out of range!')
+ call stop1()
+ end if
+ if (store) iInstTrans(nInstTrans) = instn
+c
+c durq is +/- following inst # (for iTransAmt), iccount is on it.
+c
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '1st character after instrument number must be "+,-"!')
+ call stop1()
+ end if
+ itramt = 44-ichar(durq) ! +1/-1 for itramt
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be a transposition amount here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (store) iTransAmt(instn) = nint(fnum)*itramt
+c
+c durq is +/- following iTransAmt (for iTransKey), iccount is on it.
+c
+ if (index('+-',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '1st character after transposition amount must be "+,-"!')
+ call stop1()
+ end if
+ ikey = 44-ichar(durq) ! +1/-1
+ call g1etchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be a key indicator here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ if (store) iTransKey(nInstTrans) = nint(fnum)*ikey
+c
+c durq is now 1st character after iTransKey, should be either 'i' or ' '
+c
+ if (durq.ne.'i'.and.durq.ne.' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'There must be blank or "i" here!')
+ call stop1()
+ end if
+ go to 1
+ end
+ subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars,
+ * lenbar,mtrdenl,nv,first)
+c
+c Use this from both pmxa and pmxb to input and check midi data. "first" tells
+c whether pmxa or pmxb. If .not.first, then tempo and pause commands cause
+c things to be written immediately into the midi storage buffers.
+c
+ parameter (nm=24,mv=24576)
+ common /comevent/ miditime,lasttime
+ logical mmacrec,gottempo
+ common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
+ * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
+ * mmacrec,gottempo
+c
+c immac(i) is the index of i-th macro, i=1,nmac. Also make a list containing
+c nmidsec section starts and stops based on PLAYING macros (not recording).
+c
+ integer*2 mmidi,midinum(26)
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm)
+ integer*2 iinsiv
+ character*1 durq
+ character*2 instq
+ character*128 lineq
+ logical first
+ common /comdiag/ n69(0:nm),n34(0:nm)
+c
+c Instrument codes
+c
+ data midinum
+ * / 1, 5, 7, 13,20,25,33,41,42,43,44,57,58,59,61,65,66,67,
+c XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuXfrXsoXalXteX
+c
+ * 68,69,71,72,74,75, 8,55 /
+c bsXobXbaXclXflXreXctXvo
+c
+1 call getchar(lineq,iccount,durq)
+ if (durq .eq. 't') then
+c
+c Tempo in beats ber minute
+c
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected an integer here for the pause!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,qpm)
+ iccount = iccount-1
+ if (.not.first) then
+ call midievent('t',nint(qpm),0)
+ gottempo = .true.
+ end if
+ go to 1
+ else if (durq .eq. 'p') then
+c
+c Insert a pause. pausemid = pause in 1/4's
+c
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a number here for the pause!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,pausemid)
+ iccount = iccount-1
+ if (.not.first) then
+c
+c Compute a meter for the pause. This is only to keep MidiNotate on track.
+c Round pause to nearest 16th. Let denominator always be 16.
+c
+ numb16 = nint(pausemid*4)
+ call midievent('m',numb16,16)
+c
+c Put in pausemid beats of rest
+c
+ do 3 icm = 0 , numchan-1
+ call addmidi(icm,0,0,0,4.*numb16,.true.,.false.)
+3 continue
+ miditime = miditime+nint(240*pausemid)
+c
+c Restore meter
+c
+ call midievent('m',mtrdenl*lenbar/64,mtrdenl)
+ end if
+ go to 1
+ else if (durq .eq. 'i') then
+c
+c Instrument numbers or letters. Expect noinst of them.
+c
+ do 2 ivx = 1 , noinstarg
+ call getchar(lineq,iccount,durq)
+ if (ichar(durq) .gt. 96) then
+c
+c It's a lowercase letter. Get another, find corr. instrument #.
+c
+ instq(1:1) = durq
+ call getchar(lineq,iccount,durq)
+ instq = instq(1:1)//durq
+ iname = index('XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbX'//
+ * 'tuXfrXsoXalXteXbsXobXbaXclXflXreXctXvo',instq)/3
+ if (iname .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Unrecognized 2-letter midi instrument name!')
+ call stop1()
+ end if
+ midinst(ivx) = midinum(iname)-1
+ else
+c
+c Expect a number, followed by ":" if that is followed by another number.
+c I.e., if after call to readnum, durq is not ":", it must be either blank
+c or next instrument letter.
+c
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a midi instrument number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ midinst(ivx) = nint(fnum)-1
+ if (midinst(ivx).lt.0 .or. midinst(ivx).gt.255) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Midi instrument number must be in range 1-128!')
+ call stop1()
+ end if
+ if (durq .ne. ':') iccount = iccount-1
+ end if
+2 continue
+ go to 1
+ else if (durq .eq. 'v') then
+c
+c Get volumes for each instrument. Expect noinst of them.
+c Follow same pattern as for insttrument numbers above.
+c
+ do 7 ivx = 1 , noinstarg
+ call getchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a midi velocity number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ midivel(ivx) = nint(fnum)-1
+ if (midivel(ivx).lt.0 .or. midivel(ivx).gt.127) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Midi velocity must be in range 1-128!')
+ call stop1()
+ end if
+ if (durq .ne. ':') iccount = iccount-1
+7 continue
+ if (.not. first) then
+ call inst2chan(midvelc,midivel,midchan,nv,iinsiv,twoline)
+ end if
+ go to 1
+ else if (durq .eq. 'b') then
+c
+c Get balance for each instrument. Expect noinst of them.
+c Follow same pattern as for instrument numbers above.
+c
+ do 8 ivx = 1 , noinstarg
+ call getchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a balance number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ midibal(ivx) = nint(fnum)-1
+ if (midibal(ivx).lt.0 .or. midibal(ivx).gt.127) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Midi balance must be in range 1-128!')
+ call stop1()
+ end if
+ if (durq .ne. ':') iccount = iccount-1
+8 continue
+ if (.not. first) then
+ call inst2chan(midbc,midibal,midchan,nv,iinsiv,twoline)
+ end if
+ go to 1
+ else if (durq .eq. 'T') then
+c
+c Get transposition for each instrument. Expect noinst of them.
+c Follow similar pattern as above, but separator is +|-.
+c
+ do 9 ivx = 1 , noinstarg
+ call getchar(lineq,iccount,durq)
+ ipm = index('-+',durq)
+ if (ipm .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected "+" or "-" for midi transposition here!')
+ call stop1()
+ end if
+ ipm = 2*ipm-3
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected a number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ miditran(ivx) = ipm*nint(fnum)
+c if (mod(miditran(ivx),12).ne. 0) then
+c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+c * 'Midi transposition limited to multiples of 12!')
+c call stop1()
+c end if
+ iccount = iccount-1
+9 continue
+ if (.not. first) then
+ call inst2chan(midtc,miditran,midchan,nv,iinsiv,twoline)
+ end if
+ go to 1
+ else if (durq .eq. 'g') then
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected an integer here for the midi gap!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ mgap = nint(fnum)
+ iccount = iccount-1
+ go to 1
+ else if (durq .eq. 'M') then
+c
+c MidiMacros
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'R') then
+c
+c Start recording
+c
+ if (mmacrec) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'You tried to record a MidiMacro while already recording!')
+ call stop1()
+ end if
+ mmacrec = .true.
+ call getchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected MidiMacro ID number here!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ if (.not.first) then
+ immac = nint(fnum)
+ if (immac .gt. 20) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'MidiMacro ID cannot exceed 20!')
+ call stop1()
+ end if
+c
+c Save the start time
+c
+ mmactime(immac) = miditime
+ do 4 icm = 0 , numchan
+ if (icm .lt. numchan) then
+ if (restpend(icm)) then
+c
+c Adjust if there's a rest at end of prior section. Insert dummy turnoff.
+c (This causes two turn-offs in a row, which testmidi sees as an error).
+c
+c Before: section1 ------rest------- section2(to be recorded)
+c After: section1 rest1 now rest2 section2(recorded)
+c
+ call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
+ trest(icm) = 0
+ restpend(icm) = .false.
+ end if
+ else
+ if (miditime .gt. lasttime) then
+c
+c Insert a dummy turnoff in conductor track
+c
+ call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
+ * .false.,.true.)
+ lasttime = miditime
+ end if
+ end if
+ mmacstrt(icm,immac) = imidi(icm)+1
+4 continue
+ end if
+ go to 1
+ else if (index('123456789P',durq) .eq. 0) then
+c
+c End recording; close the open macro. Get immac from common.
+c
+ if (.not.mmacrec) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'You tried to end a MidiMacro before starting one!')
+ call stop1()
+ end if
+ mmacrec = .false.
+ iccount = iccount-1
+ if (.not.first) then
+c
+c Save the macro duration
+c
+ mmactime(immac) = miditime-mmactime(immac)
+ do 5 icm = 0 , numchan
+ if (icm .lt. numchan) then
+ if (restpend(icm)) then
+ call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
+ trest(icm) = 0
+ restpend(icm) = .false.
+ end if
+ else
+ if (miditime .gt. lasttime) then
+c
+c Insert a dummy turnoff in conductor track if needed.
+c
+ call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
+ * .false.,.true.)
+ lasttime = miditime
+ end if
+ end if
+ mmacend(icm,immac) = imidi(icm)
+5 continue
+ end if
+ if (durq .ne. ' ')go to 1
+ else if (durq .eq. 'P') then
+c
+c Play Back a Macro
+c
+ call getchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Expected MidiMacro ID number here!')
+ call stop1()
+ end if
+ if (mmacrec) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'You tried to play a MidiMacro before ending recording!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ if (.not.first) then
+ immac = nint(fnum)
+ if (mmactime(immac) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot play a MIDI macro before recording it!')
+ call stop1()
+ end if
+ do 6 icm = 0 , numchan
+ if (icm .lt. numchan) then
+ if (restpend(icm)) then
+ call addmidi(icm,30,0,0,trest(icm),.false.,.true.)
+ trest(icm) = 0.
+ restpend(icm) = .false.
+ end if
+ else
+ if (miditime .gt. lasttime) then
+c
+c Insert a dummy turnoff in conductor track
+c
+ call addmidi(icm,30,0,0,(miditime-lasttime)/15.,
+ * .false.,.true.)
+ end if
+ end if
+ msecend(icm,nmidsec) = imidi(icm)
+ msecstrt(icm,nmidsec+1) = mmacstrt(icm,immac)
+ msecend(icm,nmidsec+1) = mmacend(icm,immac)
+ msecstrt(icm,nmidsec+2) = imidi(icm)+1
+6 continue
+ nmidsec = nmidsec+2
+c
+c Update running time
+c
+ miditime = miditime+mmactime(immac)
+ lasttime = miditime
+ end if
+ go to 1
+ else
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in MidiMacro sub-command!')
+ call stop1()
+ end if
+ else if (durq .eq. 'd') then
+ debugmidi = .true.
+ go to 1
+ else if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character in MIDI input data!')
+ write(*,'(a)')
+ * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
+ * 'should be noinst, not nv'
+ write(15,'(a)')
+ * 'May be too many args to i,v,b, or T. As of Ver. 2.7, '//
+ * 'should be noinst, not nv'
+ call stop1()
+ end if
+ if (.not.gottempo .and. .not.first) then
+c
+c If no tempo is set on first call on the pmxb pass, then set it
+c
+ call midievent('t',96,0)
+ gottempo = .true.
+ end if
+ return
+ end
+ subroutine getnote(loop)
+ parameter (nm=24,mv=24576)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink,ignorenats,newmbrhgt
+ common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*10 figq
+ character*1 ulq,sepsymq,sq,rptfq1,rptfq2,clefq,chax
+ logical beamon,firstgulp,figbass,figchk,isfig
+ character*60 cheadq
+ character*120 instrq,titleq,compoq
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc,autofbon
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
+ * inhead
+ common /cominbot/ inbothd
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
+ * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
+ * OptLineBreakTies,HeaderSpecial
+ common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
+ * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
+ * rptprev,equalize,rptfq1,rptfq2
+ common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg,fbon,ornrpt,shifton,setis,notcrd,isbjmp,
+ * was2,nobar1,quoted,isbj2,stickyS,
+ * OptLineBreakTies,HeaderSpecial
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ character*128 litq
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ common /combc/ bcspec
+ common /comas3/ ask(2500),iask,topmods
+c
+c nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined
+c ivx is current ivmx, and is the index for all notes, acc's etc.
+c
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+ common /comtrans/ cheadq
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
+ * ic1mac(20),ilmac,iplmac
+ common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
+ * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
+ * idynda2(99),levhssav(nm),listcresc,listdecresc
+ common /comclefq/ clefq(nm)
+ common /comtol/ tol
+ common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
+ * ArpShift(20)
+ character*128 txtdynq
+ logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur,
+ * fontslur,WrotePsslurDefaults
+ character*128 lineq,lnholdq,lineqt
+ character*80 headrq, lowerq
+ character*79 inameq
+ character*59 hdlndq
+ character*20 voltxtq
+ character*1 charq,dotq,durq,ulfbq,dumq
+ logical loop,lastchar,lower,rptnd1,rptprev,bcspec,moved,
+ * topmods,headlog,btest,sluron,cdot,equalize
+ character*24 tempq
+ logical novshrinktop,cstuplet
+ common /comnvst/ novshrinktop,cstuplet
+ logical kbdrests
+ common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idumm1,isig1,
+ * mbrestsav,kchmid(18),logdumm1,logdumm2,barend,noinst,logdumm3
+ logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3
+ common /combibarcnt/ ibarcnt
+ common /commidisig/ midisig
+ common /comlyr/ inputmlyr
+ logical inputmlyr
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ logical inxtup
+ common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
+ * poefa
+ real*4 poefa(125)
+ logical nocodabn
+ cdot = .false.
+ inxtup = .false.
+1 call getchar(lineq,iccount,charq)
+ if (lastchar) return
+ if (charq .eq. ' ') go to 1
+ if (charq .eq. '%') then
+c
+c Check for a bar number format:
+c
+ if (iccount.eq.1 .and. lineq(2:2).eq.' ' .and.
+ * index('bB1234567890',lineq(3:3)).gt.0) then
+ if (islast) write(11,'(a)')lineq(1:lenstr(lineq,128))
+ end if
+ iccount = 128
+ go to 1
+ end if
+c
+c Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r'
+c
+ if (rptprev) then
+ rptnd1 = charq .eq. chax(47)
+ rptprev = .false.
+ end if
+c
+c Repeat at end of a piece
+c
+ if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or.
+ * charq.eq.'r') then
+ if (cdot) go to 28
+c
+c This is a note/rest.
+c
+ idotform = 0
+ numnum = 0
+c
+c If start of line of music, set pitch from previous
+c
+ if (ivx .le. nv) then
+ kv = 1
+ else
+ kv = 2
+ end if
+ if (nnl(ivx).eq.0) lastlev = ndlev(iv,kv)
+c
+c notcrd is used to tell if orn. goes on main note or chord note
+c
+c notcrd = .true. !Move dow. Was not observed if dotted shortcut.
+c
+c Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts.
+c
+28 continue
+c
+c Moved this from just above, 2 Feb 02
+c
+ notcrd = .true.
+ nnl(ivx) = nnl(ivx)+1
+ if (ornrpt) then
+c
+c Replicate ornament bits, also bit 23 for beam handling if chord.
+c
+ iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),iornq(ivx,0))
+ if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
+c
+c This is a trill (bit 7 or 15) so must dup the parameters
+c
+ ntrill = ntrill + 1
+ ivtrill(ntrill) = ivx
+ iptrill(ntrill) = nnl(ivx)
+ xnsktr(ntrill) = xnsktr(ntrill-1)
+ end if
+ end if
+ if (stickyS) then
+c
+c Grab stemlength shortening parameters from prior note
+c
+ mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
+c call setbits (mult(ivx,nnl(ivx)),3,28,
+c * igetbits(mult(ivx,nnl(ivx)-1),3,28))
+ call setbits (mult(ivx,nnl(ivx)),6,10,
+ * igetbits(mult(ivx,nnl(ivx)-1),6,10))
+ end if
+ if (autofbon .and. tautofb.gt.tol .and. .not.fbon) then
+c
+c Doing auto forced beams, and period has been set, so check if this note
+c starts a period.
+c
+c if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then
+ if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
+c
+c Start a forced beam here
+c
+ nfb(ivx) = nfb(ivx)+1
+ fbon = .true.
+ ulfbq(ivx,nfb(ivx)) = 'x'
+ t1fb(ivx,nfb(ivx)) = itsofar(ivx)
+ end if
+ end if
+ if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
+ dotq = 'x'
+ if (charq.eq.'r')
+ * irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
+ if (btest(irest(ivx,nnl(ivx)),0)) then
+c
+c Rest stuff. First check if previous note was full-bar-pause
+c
+ if (lineq(iccount+1:iccount+1) .eq.' '
+ * .and. nnl(ivx).gt.1) then
+ if (btest(islur(ivx,nnl(ivx)-1),19))
+ * islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
+ end if
+c
+c Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2
+c for voice a or b. Set a-types at 0 as encountered and adjust later
+c after '//'. (Override heights will be set to 100+offset)
+c
+ if (ivx .le. nv) then
+ nolev(ivx,nnl(ivx)) = 0
+ else
+ nolev(ivx,nnl(ivx)) = 2
+ end if
+ end if
+2 call getchar(lineq,iccount,durq)
+ ic = ichar(durq)
+ if (ic.le.57 .and. ic.ge.48) then
+c
+c Digit
+c
+ if (numnum .eq. 0) then
+ nnodur = ic-48
+ numnum = 1
+ go to 2
+ else if (numnum .eq. 1) then
+ ioct = ic-48
+ numnum = 2
+ go to 2
+ else
+ print*,'>2 digits in note sym., ivx,nn:',ivx,nnl(ivx)
+ call stop1()
+ end if
+ else if (durq .eq. 'd') then
+ dotq = durq
+ if (lineq(iccount+1:iccount+1) .eq. 'd') then
+c
+c Double dot.
+c
+ iccount = iccount+1
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),3)
+ end if
+ if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
+c
+c move a dot, unless next char is not part of a number
+c
+ if (index('0123456789.',lineq(iccount+2:iccount+2)) .eq. 0)
+ * go to 2
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19)
+ call getchar(lineq,iccount,durq)
+ ndotmv(ivx) = ndotmv(ivx)+1
+ iccount=iccount+1
+ call readnum(lineq,iccount,dumq,updot(ivx,ndotmv(ivx)))
+ if (durq .eq. '-')
+ * updot(ivx,ndotmv(ivx)) = -updot(ivx,ndotmv(ivx))
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift also
+c
+ iccount=iccount+1
+ call readnum(lineq,iccount,durq,rtdot(ivx,ndotmv(ivx)))
+ if (dumq .eq. '-')
+ * rtdot(ivx,ndotmv(ivx)) = -rtdot(ivx,ndotmv(ivx))
+ else
+ rtdot(ivx,ndotmv(ivx)) = 0.
+ end if
+ iccount = iccount-1
+ end if
+ go to 2
+ else if (durq .eq. 'p') then
+c
+c Full-bar rest as pause
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),19)
+ go to 2
+ else if (durq .eq. 'b') then
+c
+c Blank rest
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
+ go to 2
+ else if (index('fsn',durq) .gt. 0) then
+c
+c Accidental
+c
+c if (nacc(ivx,nnl(ivx)) .eq. 0) then
+c 171209 May have set bit 18 earlier if D or F preceded accidental
+ if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then
+c
+c No accidental has been set yet
+c
+c nacc(ivx,nnl(ivx)) = index('fsn',durq)
+ nacc(ivx,nnl(ivx)) =
+ * ior(nacc(ivx,nnl(ivx)),index('fsn',durq))
+ else
+c
+c Repeated accid, so must be double
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
+ end if
+ go to 2
+ else if (durq .eq. 'i') then
+c
+c Set flag for MIDI-only accidental.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17)
+ go to 2
+ else if (durq .eq. 'c') then
+c
+c Set flags for cautionary accidental
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
+ iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
+ go to 2
+ else if (index('+-<>',durq) .gt. 0) then
+ ipm = index('- +',durq)-2
+ if (.not.btest(irest(ivx,nnl(ivx)),0)) then
+c
+c A note, not a rest.
+c
+ call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
+ if (moved) go to 2
+c
+c Octave jump with a note
+c
+ if (numnum .lt. 2) then
+ lastlev = lastlev+ipm*7
+ else
+ ioct = ioct+ipm*1
+ end if
+ go to 2
+ else
+c
+c Override default height of a rest
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (lineq(iccount-1:iccount-1) .eq. '.') then
+c
+c Kluge in case there is a shortcut ".". It will have been sucked up by
+c readnum. (Same doesn't hold for ",")
+c
+ iccount = iccount-1
+c go to 2
+ end if
+ nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
+c
+c There may be more characters for this rest
+c
+ iccount = iccount-1
+ go to 2
+ end if
+ else if (durq .eq. 'x') then
+c
+c Xtuplet. Count number of doubled notes (for unequal xtups)
+c
+ if (btest(nacc(ivx,nnl(ivx)),18)) then
+ ndoub = 1
+ else
+ ndoub = 0
+ end if
+c
+c Initialize counter for # of non-rests, so can later unbeam if = 1.
+c
+ inxtup = .true.
+ note1xtup = nnl(ivx)
+ nnb = 0
+ if (.not.btest(irest(ivx,nnl(ivx)),0)) nnb = 1
+c
+c Will set all durations to 0 except last one. Set flag on this note.
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),28)
+c
+c Next input will be digit unless its a "T"
+c
+ iccount = iccount+1
+ if (lineq(iccount:iccount) .eq. 'T') then
+c
+c Set up tremolo
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),2)
+ ntup = 2
+c
+c Set default beaming, based on Wikipedia article
+c May be a problem here is nnodur is inherited
+c
+ if (nnodur .eq. 4) then
+ nsolid = 0
+ nindent = 3
+ else if (nnodur .eq. 2) then
+ nsolid = 3
+ nindent = 0
+ else if (nnodur .eq. 8) then
+ nsolid = 1
+ nindent = 2
+ end if
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .gt. 0) then
+ nsolid = index('0123456789',durq)-1
+ if (nsolid.eq.0 .and. nnodur.eq.2) then
+ print*,''
+ print*,'Unbeamed half-note 2-note tremolo forbidden.'
+ call stop1()
+ end if
+ call getchar(lineq,iccount,durq)
+ if (index('0123456789',durq) .gt. 0) then
+ nindent = index('0123456789',durq)-1
+ end if
+ end if
+ call setbits(irest(ivx,nnl(ivx)),2,3,nsolid)
+ call setbits(irest(ivx,nnl(ivx)),2,5,nindent)
+ if (nsolid .eq. 0) then
+ islur(ivx,nnl(ivx)) =
+ * ibset(islur(ivx,nnl(ivx)),18)
+ end if
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31)
+ islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21)
+ call setbits(islur(ivx,nnl(ivx)+1),3,22,nsolid)
+c
+c Set some force-beam parameters for the tremolo
+c
+c Need to check if there's already a forced beam explicitly set here.
+c If there was, shouldn't do any harm resetting parameters.
+c
+ if (nfb(ivx).eq.0 .or. t1fb(ivx,nfb(ivx)).ne.itsofar(ivx))
+ * nfb(ivx) = nfb(ivx)+1
+ fbon = .true.
+ ulfbq(ivx,nfb(ivx)) = 'x'
+ t1fb(ivx,nfb(ivx)) = itsofar(ivx)
+ t2fb(ivx,nfb(ivx)) = itsofar(ivx) + ifnodur(nnodur,dotq)
+ nadj = 0
+c
+c Set open beamed notehead flag for half-note tremolo
+c Just gave 2 quarters with or without flag set. Need to fix
+c
+ else
+ call readnum(lineq,iccount,durq,fnum)
+ ntup = nint(fnum)
+ end if
+ if (index('DF',durq) .gt. 0) then
+c
+c
+c Double xtup note to make an un= xtup. Here xtup number already set but may also
+c have this command before.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
+ * ibset(nacc(ivx,nnl(ivx)),19)
+ ndoub = 1
+ call getchar(lineq,iccount,durq)
+ else if (durq .eq. 'd') then
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
+ call getchar(lineq,iccount,durq)
+ end if
+c
+c Only other possibilities here are ' ' or 'n'
+c
+ if (durq .eq. 'n') then
+c
+c Alter xtup number
+c
+ if (lineq(iccount+1:iccount+1) .eq. ' ') then
+c
+c If the only modifier is 'n', cancel the number
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),31)
+ else
+ numshft = 0
+30 call getchar(lineq,iccount,durq)
+ if (durq .eq. 'f') then
+c
+c Flip up-down-ness
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),14)
+ go to 30
+ else if (index('+-',durq) .gt. 0) then
+c
+c Vertical or horiz shift
+c
+ numshft = numshft+1
+ iofforn = 1
+ if (durq .eq. '-') iofforn = -1
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,xofforn)
+ iccount = iccount-1
+ if (numshft .eq. 1) then
+c
+c Vertical shift
+c 160214 Allow (-64,64)
+c iofforn = iofforn*nint(xofforn) + 16
+ iofforn = iofforn*nint(xofforn) + 64
+c
+cc Turn on bit 1; set bits 2-6 to iofforn
+c Turn on bit 1 of irest; set bits 16-22 of mult to iofforn
+c
+c irest(ivx,nnl(ivx)) =
+c * ior(irest(ivx,nnl(ivx)),2+4*iofforn)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),1)
+ call setbits(mult(ivx,nnl(ivx)),8,16,iofforn)
+ else
+c
+c Horizontal shift
+c
+ iofforn = iofforn*nint(xofforn*10)+16
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),7)
+ call setbits(irest(ivx,nnl(ivx)),5,9,iofforn)
+ end if
+ go to 30
+ else if (durq .eq. 's') then
+c
+c Slope adjustment for bracket
+c
+ mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),4)
+ call getchar(lineq,iccount,durq)
+ iofforn = index('- +',durq)-2
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,xofforn)
+ iccount = iccount-1
+ iofforn = nint(iofforn*xofforn+16)
+ call setbits(mult(ivx,nnl(ivx)),5,5,iofforn)
+ else if (index('123456789',durq) .gt. 0) then
+c
+c Replacement printed number
+c
+ call readnum(lineq,iccount,durq,xofforn)
+ call setbits(nacc(ivx,nnl(ivx)),5,22,nint(xofforn))
+ iccount = iccount-1
+ go to 30
+ end if
+ end if
+ end if
+c
+c Set note level of 1st note of xtup, provided not a rest
+c
+ if (.not.btest(irest(ivx,nnl(ivx)),0)) then
+ if (numnum .eq. 2) then
+ lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
+ nolev(ivx,nnl(ivx)) = lastlev
+ else
+ lastlev = lastlev-3
+ * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
+ nolev(ivx,nnl(ivx)) = lastlev
+ end if
+ end if
+ do 40 npreslur = npreslur , 1 , -1
+c
+c Set note level for preslur on starting note of xtuplet
+c
+ call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
+40 continue
+ numnum = 0
+ nodur(ivx,nnl(ivx)) = 0
+ do 6 itup = 2 , ntup
+ if (ornrpt) then
+ iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
+ * iand(iornq(ivx,nnl(ivx)-1),10026991))
+ if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
+c
+c This is a trill (bit 7 or 15) so must dup the parameters
+c
+ ntrill = ntrill + 1
+ ivtrill(ntrill) = ivx
+ iptrill(ntrill) = nnl(ivx)
+ xnsktr(ntrill) = xnsktr(ntrill-1)
+ end if
+ end if
+ nnl(ivx) = nnl(ivx)+1
+ if (fbon) ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),30)
+7 call getchar(lineq,iccount,charq)
+ if (charq .eq. ' ') then
+ go to 7
+ else if (charq .eq. '%') then
+ iccount = 128
+ go to 7
+ else if (charq .eq. 'o') then
+c
+c Ornament in xtuplet. "o" symbol must come AFTER the affected note
+c
+ if (notcrd) then
+ nole = nolev(ivx,nnl(ivx)-1)
+ else
+ nole = iand(127,ishft(icrdat(ncrd),-12))
+ end if
+ call getorn(lineq,iccount,iornq(ivx,nnl(ivx)-1),
+ * iornq(ivx,0),ornrpt,noffseg,
+ * nnl(ivx)-1,ivx,.false.,notcrd,nole)
+ go to 7
+ else if (index('st(){}',charq) .gt. 0) then
+ nnlivx = nnl(ivx)-1
+ if (charq.eq.'(' .or. charq.eq.'{') then
+c
+c Detected preslur in xtuplet loop, non-chord note
+c
+ nnlivx = nnlivx+1
+ npreslur = npreslur+1
+ end if
+ islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
+ if (charq.eq.'t') islur(ivx,nnlivx) =
+ * ibset(islur(ivx,nnlivx),1)
+ if (ivx .le. nv) then
+ kv = 1
+ else
+ kv = 2
+ end if
+ if (fontslur) then
+ call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
+ * isdat3,nsdat,notcrd,nolev(ivx,nnlivx),charq)
+ else
+ call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,
+ * isdat3,isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
+ end if
+ go to 7
+ else if (charq .eq. 'G') then
+c
+c Kluge to get grace in xtup at right location
+c
+ nnl(ivx) = nnl(ivx)-1
+ call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
+ * lastlev,iv,nv)
+ nnl(ivx) = nnl(ivx)+1
+ go to 7
+ else if (charq .eq. sq) then
+ call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
+ go to 7
+ else if (charq .eq. chax(34)) then
+c
+c pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\
+c
+ if (.not. inputmlyr) then
+ ictemp = 0
+ lineqt = sq//sq//sq//'input musixlyr '//sq
+ call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp)
+ inputmlyr = .true.
+ end if
+ call dopmxlyr(lineq,iccount)
+ charq = sq
+ call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount)
+ go to 7
+ else if (index('0123456789#-nx_',charq) .gt. 0) then
+c
+c Figure. Must come AFTER the first note of xtup
+c
+ ivf = 1
+ if (ivx .gt. 1) then
+ if (ivxfig2 .eq. 0) then
+ ivxfig2 = ivx
+ else if (ivx .ne. ivxfig2) then
+ print*
+ print*,'Figures not allowed in >1 voice above first'
+ stop
+ end if
+ ivf = 2
+ end if
+ nfig1 = nfigs(ivf)+1
+ call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
+ * isfig(ivf,nnl(ivx)-1),itfig(ivf,nfig1),itsofar(ivx),
+c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf))
+ * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),
+ * nfigs(ivf))
+ go to 7
+ else if (charq .eq. 'X') then
+ call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)),
+ * shifton,wheadpt,iornq(ivx,nnl(ivx)),ivx,
+ * irest(ivx,nnl(ivx)),itsofar(ivx),ntup,itup,nnodur,
+ * dotq,ndoub)
+ go to 7
+ else if (charq .eq. 'z') then
+c
+c Chord note in xtup. Goes with *prior* note.
+c
+ notcrd = .false.
+ ncrd = ncrd+1
+ ipl(ivx,nnl(ivx)-1) = ibset(ipl(ivx,nnl(ivx)-1),10)
+ numnum = 0
+c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
+ icrdat(ncrd) = nnl(ivx)-1
+ call setbits(icrdat(ncrd),4,8,mod(ivx,16))
+ if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
+ icrdorn(ncrd) = 0
+c
+c Get note name
+c
+ call getchar(lineq,iccount,charq)
+c
+c Get optional inputs
+c
+34 call getchar(lineq,iccount,durq)
+c
+c When chord note is done, will get ' ', making ndx=0, so go past this block
+c
+ ndx = index('fsn+-<>12345678reicd',durq)
+ if (ndx .gt. 0) then
+ if (ndx .le. 3) then
+ if (.not.btest(icrdat(ncrd),19)) then
+ icrdat(ncrd) = ibset(icrdat(ncrd),19)
+ icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
+ else
+ icrdat(ncrd) = ibset(icrdat(ncrd),22)
+ end if
+ else if (durq .eq. 'd') then
+c
+c Get dot on chord note in xtup. Assume +n+n
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),26)
+ call getchar(lineq,iccount,durq)
+ iccount=iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (durq .eq. '+') then
+ icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64)
+ else
+ icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64)
+ end if
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift specified also
+c
+ iccount=iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (dumq .eq. '+') then
+ ifnum = nint(fnum*10)+64
+ else
+ ifnum = -nint(fnum*10)+64
+ end if
+ else
+ ifnum = 64
+ end if
+ icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7))
+ iccount = iccount-1
+c iccount = iccount+4
+c
+c
+c
+ else if (ndx .eq. 19) then
+c
+c Set flags for cautionary accidental
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),31)
+ iornq(ivx,nnl(ivx)-1) =
+ * ibset(iornq(ivx,nnl(ivx)-1),31)
+ else if (ndx .le. 7) then
+c
+c +/-/</> Check whether octave or accidental shift
+c
+ nactmp = 0
+ call chkpm4ac(lineq,iccount,nactmp,moved)
+ if (moved) then
+c
+c Transfer accidental shift values
+c
+ call setbits(icrdot(ncrd),6,14,
+ * igetbits(nactmp,6,4))
+ call setbits(icrdot(ncrd),7,20,
+ * igetbits(nactmp,7,10))
+ else
+ if (durq .eq. '+') then
+ lastlev = lastlev+7
+ else if (durq .eq. '-') then
+ lastlev = lastlev-7
+ end if
+ end if
+ else if (durq .eq. 'e') then
+ icrdat(ncrd) = ibset(icrdat(ncrd),23)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
+ else if (durq .eq. 'r') then
+ icrdat(ncrd) = ibset(icrdat(ncrd),24)
+ irest(ivx,nnl(ivx)-1) =
+ * ibset(irest(ivx,nnl(ivx)-1),20)
+ else if (durq .eq. 'i') then
+c
+c Midi-only accidental
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),27)
+ else
+c
+c must be a number, save it in ioct
+c
+ numnum = 1
+ ioct = ndx-7
+ end if
+ go to 34
+ end if
+ if (numnum .eq. 1) then
+ lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
+ else
+ lastlev = lastlev-3
+ * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
+ end if
+ icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
+ do 41 npreslur = npreslur , 1 , -1
+c
+c Set note level for preslur on chord note in xtup
+c
+ call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
+c
+c Following lines copied from loop for non-xtup, chord note, preslur
+c Initially I assigned the slur(s) to next note, so fix.
+c
+ islur(ivx,nnl(ivx)) = ibclr(islur(ivx,nnl(ivx)),0)
+ islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),0)
+ isdat2(nsdat-npreslur+1) =
+ * ibset(isdat2(nsdat-npreslur+1),0)
+ call setbits(isdat1(nsdat-npreslur+1),8,3,
+ * igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
+41 continue
+ go to 7
+ else if (charq .eq. '?') then
+c
+c Arpeggio
+c
+ if (btest(ipl(ivx,nnl(ivx)-1),10)) then
+c
+c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note
+c of chord, will not set icrdat(25), but iornq(27)
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),25)
+ else
+ iornq(ivx,nnl(ivx)-1) = ibset(iornq(ivx,nnl(ivx)-1),27)
+ end if
+c
+c Check for shift
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ' ') then
+ iccount = iccount-1
+ else
+c
+c durq must be "-"
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+c
+c record the shift
+c
+ NumArpShift = NumArpShift+1
+ IvArpShift(NumArpShift) = ivx
+ IpArpShift(NumArpShift) = nnl(ivx)-1
+ ArpShift(NumArpShift) = fnum
+ end if
+ go to 7
+ else if (charq .eq. 'D') then
+ call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1),
+ * iornq(ivx,nnl(ivx)-1),lineq,iccount)
+ go to 7
+c
+c 140215 Allow clef change inside xtuplet. With normal code, came out one
+c note too late, so try making it come earlier.
+c
+ else if (charq .eq. 'C') then
+c
+c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music.
+c
+ if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1
+c
+c 140218 Need to get time differently inside xtup, since itsofar doesn't get
+c updated until after xtup is done
+c
+ nodurt = ifnodur(nnodur,dotq)
+ tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1))
+ isl = ibset(islur(iv,nnl(iv)),11)
+ call getchar(lineq,iccount,durq)
+c
+c Store clef number, or 7 if clef number = 9 (French violin clef)
+c
+ isl = ior(isl,ishft(min(numclef(durq),7),12))
+ ncmidcc(iv,ncc(iv)) = ncmidf(durq)
+ if (durq .eq. '8') then
+ ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2)
+ iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
+ end if
+c
+c Set marker on note with lowest voice # starting at same time.
+c
+ if (iv .eq. 1) then
+ isl = ibset(isl,15)
+ else
+ do 70 iiv = 1 , iv
+c nnliiv = nnl(iiv)
+ nnliiv = nnl(iiv)-1
+ if (iiv .eq. iv) nnliiv = nnliiv+1
+ itother = 0
+ do 71 iip = 1 , nnliiv
+ if (itother .lt. itsofar(iv)) then
+ itother = itother+nodur(iiv,iip)
+ go to 71
+ else if (itother .eq. itsofar(iv)) then
+ islur(iiv,iip) = ibset(islur(iiv,iip),15)
+ go to 72
+ end if
+71 continue
+70 continue
+72 continue
+ end if
+c
+c Need 'or' since may have set bit 15 in the above loop
+c
+c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
+ islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv)))
+ go to 7
+c+++
+ else if (charq .eq. ']') then
+c
+c Multiplicity up-down, must have '][ '
+c
+ islur(ivx,nnl(ivx)-1) = ibset(islur(ivx,nnl(ivx)-1),20)
+ iccount = iccount+2
+ go to 7
+cc+++
+ end if
+c
+c End of loop for xtup options. If here, charq must be a (non-crd) note name.
+c or rest
+c
+ if (charq .eq. 'r') then
+c
+c Rest in xtup
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),0)
+ if (index('+-b',lineq(iccount+1:iccount+1)) .gt. 0) then
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'b') then
+c
+c Blank rest in middle of xtup
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),29)
+ else
+c
+c Override height of embedded xtup rest
+c
+ ipm = index('- +',durq)-2
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ nolev(ivx,nnl(ivx)) = 100+ipm*nint(fnum)
+ iccount = iccount-1
+ end if
+ else if (ivx .le. nv) then
+ nolev(ivx,nnl(ivx)) = 0
+ else
+ nolev(ivx,nnl(ivx)) = 2
+ end if
+ else
+c
+c Counter for non-rests
+c
+ nnb = nnb+1
+ end if
+ notcrd = .true.
+8 call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') then
+ if (index('+-<>',durq) .gt. 0) then
+c
+c Accidental horizontal shift
+c
+ call chkpm4ac(lineq,iccount,nacc(ivx,nnl(ivx)),moved)
+ if (.not.moved) then
+ if (durq.eq.'+') then
+ lastlev = lastlev+7
+ else if (durq.eq.'-') then
+ lastlev = lastlev-7
+ end if
+ end if
+ else if (index('fsn',durq) .gt. 0) then
+c
+c if (nacc(ivx,nnl(ivx)) .eq. 0) then
+c May have set other bits earlier
+ if (igetbits(nacc(ivx,nnl(ivx)),2,0) .eq. 0) then
+c
+c No accid set yet
+c
+c nacc(ivx,nnl(ivx)) = index('fsn',durq)
+ nacc(ivx,nnl(ivx)) =
+ * ior(nacc(ivx,nnl(ivx)),index('fsn',durq))
+ else
+c
+c Symbol must be repeated, so it's a double
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),2)
+ end if
+ else if (durq .eq. 'i') then
+c
+c Set flag for midi-only accidental
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),17)
+
+ else if (durq .eq. 'c') then
+c
+c Set flags for cautionary accidental
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),31)
+ iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
+ else if (index('ul',durq) .gt. 0) then
+c
+c Force stem direction for non-beamed xtup note
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
+ if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
+ * ibset(islur(ivx,nnl(ivx)),17)
+ else if (durq .eq. 'e') then
+c
+c Left-shift main xtup note
+c
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
+ else if (durq .eq. 'r') then
+c
+c Right-shift main xtup note
+c
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
+ else if (index('DF',durq) .gt. 0) then
+c
+c Double an xtup note to make an unequal xtup
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
+ * ibset(nacc(ivx,nnl(ivx)),19)
+ ndoub = ndoub+1
+ else if (durq .eq. 'd') then
+c
+c Dotted xtup note
+c
+c if (btest(irest(ivx,nnl(ivx))-1,2)) then
+ if (btest(irest(ivx,nnl(ivx)-1),2)) then
+c
+c Move dot on 2nd note of 2-note tremolo
+c
+ ndotmv(ivx) = ndotmv(ivx)+1
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),19)
+ call g1etchar(lineq,iccount,durq) ! Will be + or -
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,
+ * updot(ivx,ndotmv(ivx)))
+ if (durq .eq. '-') updot(ivx,ndotmv(ivx)) =
+ * -updot(ivx,ndotmv(ivx))
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift also
+c
+ call readnum(lineq,iccount,durq,
+ * rtdot(ivx,ndotmv(ivx)))
+ if (durq .eq. '-') rtdot(ivx,ndotmv(ivx))
+ * = -rtdot(ivx,ndotmv(ivx))
+ end if
+ iccount = iccount-1
+ else
+c
+c Dot for 3:1 pair of xtup notes
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),27)
+ end if
+ else
+c
+c Must be an octave number
+c
+ lastlev = ifnolev(charq,ichar(durq)-48
+ * ,iTransAmt(instno(iv)))
+ end if
+ go to 8
+ end if
+ if (itup .lt. ntup) then
+c
+c Last note is handled *after* flowing out of the xtup if block, but still
+c within block for a note-rest. Set note level now (rest already done).
+c Could have problem here if rests & doubled notes are combined in xtup,
+c since might exit the loop at the wrong place. Worry about it later.
+c
+ if (.not.btest(irest(ivx,nnl(ivx)),0)) then
+ lastlev = lastlev-3+mod(ifnolev(charq,10,
+ * iTransAmt(instno(iv)))-lastlev+3,7)
+ nolev(ivx,nnl(ivx)) = lastlev
+ end if
+ nodur(ivx,nnl(ivx)) = 0
+ do 42 npreslur = npreslur , 1 , -1
+c
+c Set note level for preslur on internal xtup note
+c
+ call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
+42 continue
+ end if
+ if (itup .eq. ntup-ndoub) go to 12
+6 continue
+12 continue
+ if (ornrpt) then
+ iornq(ivx,nnl(ivx)) = ior(iornq(ivx,nnl(ivx)),
+ * iand(iornq(ivx,nnl(ivx)-1),10026991))
+ if (iand(iornq(ivx,nnl(ivx)),32896) .gt. 0) then
+c
+c This is a trill (bit 7 or 15) so must dup the parameters
+c
+ ntrill = ntrill + 1
+ ivtrill(ntrill) = ivx
+ iptrill(ntrill) = nnl(ivx)
+ xnsktr(ntrill) = xnsktr(ntrill-1)
+ end if
+ end if
+c
+c End of if-block for xtuplet input
+c
+ else if (durq .eq. 'm') then
+c
+c Multi-bar rest: next 1 or two digits are # of bars.
+c For some purposes, pretend its one bar only
+c
+ nodur(ivx,nnl(ivx)) = lenbar
+ ibarmbr = nbars+1
+ mbrest = 0
+ xb4mbr = 0.
+20 call getchar(lineq,iccount,durq)
+ if (ichar(durq).ge.48.and.ichar(durq).le.57) then
+ mbrest = 10*mbrest+ichar(durq)-48
+ go to 20
+ end if
+c
+c durq will either be blank or 'n'
+ if (durq .eq. 'n') then
+c
+c Get new height
+c
+ iplmi = 1
+ call g1etchar(lineq,iccount,durq)
+ if (durq .eq. '-') then
+ iplmi = -1
+ iccount = iccount+1
+ end if
+ call readnum(lineq,iccount,durq,hgt)
+ mbrhgt = nint(iplmi*hgt)
+ newmbrhgt = .true.
+ end if
+ else if (index('ul',durq) .gt. 0) then
+c
+c Set stem flipper
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),30)
+ if (durq .eq. 'u') islur(ivx,nnl(ivx)) =
+ * ibset(islur(ivx,nnl(ivx)),17)
+ go to 2
+ else if (durq .eq. 'a') then
+c
+c "Alone", i.e., prohibit beam
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),18)
+ go to 2
+ else if (durq .eq. 'r') then
+c
+c Right offset by one notehead
+c
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),9)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
+ go to 2
+ else if (durq .eq. 'e') then
+c
+c Left offset by one notehead
+c
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),8)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
+ go to 2
+ else if (index('LS',durq) .gt. 0) then
+c
+c Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5
+c Set mult(27). Map value to 0 to 63, store in mult(10-15). Later convert to
+c interbeams = internotes*2/3.
+c
+c
+ isign = 1
+ if (durq .eq. 'S') isign = -1
+ mult(ivx,nnl(ivx)) = ibset(mult(ivx,nnl(ivx)),27)
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ':') then
+c
+c End stickyS. Grab data now from prior note, since we have to shut off stickyS.
+c
+ call setbits (mult(ivx,nnl(ivx)),6,10,
+ * igetbits(mult(ivx,nnl(ivx)-1),6,10))
+ stickyS = .false.
+ go to 2
+ end if
+c
+c If durq .ne. ':' then iccount is now on the start of the number
+c
+ call readnum(lineq,iccount,durq,dum)
+ dum = isign*dum
+ call setbits (mult(ivx,nnl(ivx)),6,10,nint((dum+4.)*2))
+ if (durq .eq. ':') then
+ stickyS = .true.
+ else
+ iccount = iccount-1
+ end if
+ go to 2
+ else if (durq .eq. ',') then
+c
+c 2:1 pattern
+c
+ idotform = 3
+c
+c Now flow to duration setting, as if durq=' '
+c
+ else if (durq .eq. '.') then
+c
+c Dotted pattern. Close out note. Mult time by 3/4.
+c Set time for next note to 1/4. Start the note.
+c
+ idotform = 1
+ else if (durq .eq. 'o') then
+c
+c Suppress rest centering
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),25)
+ go to 2
+ else if (durq .eq.'L') then
+c
+c With keyboard rest option, look left
+c
+c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30)
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1)
+ go to 2
+ else if (index('DF',durq) .gt. 0) then
+c
+c Double note for xtup. Must check here in case "D" came before "x" or on
+c last note of xtup. Need to flag it in pmxa since affects horiz. spacing.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),18)
+ if (durq .eq. 'F') nacc(ivx,nnl(ivx)) =
+ * ibset(nacc(ivx,nnl(ivx)),19)
+ go to 2
+ else if (durq .eq. 'A') then
+c
+c Accidental option
+c
+ call getchar(lineq,iccount,durq)
+c
+ if (durq .eq. 'o') then
+c
+c Ordered accidentals in a chord. Mark the main note.
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),28)
+ else
+c
+c Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),29)
+ iccount = iccount-1
+ end if
+ go to 2
+ else if (durq .eq. 'T') then
+ call getchar(lineq,iccount,durq)
+ multtrem = index('1234',durq)
+ if (multtrem .eq. 0) then
+ iccount = iccount-1
+ multtrem = 1
+ end if
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),4)
+ call setbits(ipl(ivx,nnl(ivx)),2,5,multtrem-1)
+ go to 2
+ else if (durq .ne. ' ') then
+ print*,'Illegal character in note: ',durq,', ivx,nn:',
+ * ivx,nnl(ivx)
+ call stop1()
+ end if
+c
+c Done with note/rest options. Set level and duration.
+c
+ if (.not.btest(irest(ivx,nnl(ivx)),0)) then
+ if (numnum .eq. 2) then
+ lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
+ nolev(ivx,nnl(ivx)) = lastlev
+ else
+ lastlev = lastlev-3
+ * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
+ nolev(ivx,nnl(ivx)) = lastlev
+ end if
+ do 43 npreslur = npreslur , 1 , -1
+c
+c Set level for preslur on normal note, non-chord
+c
+ call setbits(isdat2(nsdat-npreslur+1),7,19,lastlev)
+43 continue
+c
+c Only matters if last note, non-rest of xtuplet
+c
+ nnb = nnb+1
+ end if
+c
+c Set flag for unbeamed xtup if it just has 1 note
+c
+ if (inxtup .and. nnb.eq.1) then
+ islur(ivx,note1xtup) = ibset(islur(ivx,note1xtup),18)
+ end if
+ if (idotform .gt. 0) then
+ if (idotform .eq. 1) then
+ nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)*3/2
+ else if (idotform .eq. 2) then
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/3
+ else if (idotform .eq. 3) then
+ nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
+ else if (idotform .eq. 4) then
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx)-1)/2
+ end if
+ else if (btest(islur(ivx,nnl(ivx)),19)) then
+c
+c Set duration of full-bar rest as pause
+c
+ nodur(ivx,nnl(ivx)) = lenbar
+c
+c Use a one-line function to set nnodur. It gives inverse of ifnodur.
+c
+ nnodur = index('62514x0x37',
+ * chax(48+int(log(.1+lenbar)/.69315)))-1
+ else if (ibarmbr.ne.nbars+1) then
+ nodur(ivx,nnl(ivx)) = ifnodur(nnodur,dotq)
+ if (btest(islur(ivx,nnl(ivx)),3))
+ * nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*7/6
+ end if
+ if (shifton .and. .not.btest(irest(ivx,nnl(ivx)),16)) then
+c
+c Shift is on, and this is not first shifted note. Check for duration change
+c
+ if (nodur(ivx,nnl(ivx)) .ne. nodur(ivx,nnl(ivx)-1)) then
+c
+c Must stop and restart the offset.
+c
+ irest(ivx,nnl(ivx)-1) = ibset(irest(ivx,nnl(ivx)-1),17)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),16)
+ nudoff(ivx) = nudoff(ivx)+1
+ udoff(ivx,nudoff(ivx)) = udoff(ivx,nudoff(ivx)-1)
+ end if
+ end if
+ itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
+ if (autofbon .and. tautofb.gt.tol .and. fbon) then
+c
+c Check to see if need to terminate auto forced beam
+c
+ if (mod(itsofar(ivx)-t1autofb,tautofb) .lt. tol) then
+c
+c Terminate autofb
+c
+ t2fb(ivx,nfb(ivx)) = itsofar(ivx)
+ fbon = .false.
+ end if
+ end if
+ if (mod(itsofar(ivx)-lenb0,lenbar) .eq. 0) then
+c
+c Finished a bar
+c
+ nbars = nbars+1
+ nib(ivx,nbars) = nnl(ivx)
+ if (firstgulp.and.lenb0.ne.0.and.nbars.eq.1) then
+c
+c Just finished the pickup bar for this voice.
+c
+ lenbar = lenb1
+ end if
+ end if
+ if (idotform .eq. 1) then
+ call getchar(lineq,iccount,charq)
+ idotform = 2
+ numnum = 1
+ go to 28
+ else if (idotform .eq. 3) then
+ call getchar(lineq,iccount,charq)
+ idotform = 4
+ numnum = 1
+ go to 28
+ end if
+c
+c End of sub block for note-rest
+c
+ else if (charq .eq. 'z') then
+c
+c Chord note. Must have note name, may have octave#,+,-,s,f,n,d
+c Actually the 'd' is not used, since time value comes from
+c basic note. Unless dot is to be shifted!
+c Doesn't increase # of notes, so must handle separately
+c ncrd: index of crd
+c Set bit 10 of ipl on main note as flag
+c Bits in icrdat:
+c 0-7 ip within voice
+c 8-11 ivx
+c 12-18 note level
+c 19 accidental?
+c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
+c 23 shift left
+c 24 shift right
+c 25 arpeggio start or stop
+c 26 flag for moved dot (here, not icrdot, since this is always reset!)
+c 27 Midi-only accidental
+c 29 Tag for accidental shift...means add to autoshifts.
+c 31 Cautionary accidental
+c
+c Bits in icrdot:
+c 0-6 10*abs(vertical dot shift in \internote) + 64
+c 7-13 10*abs(horizontal dot shift in \internote) + 64
+c 14-19 vert accidental shift-32
+c 20-26 20*(horiz accidental shift+3.2)
+c 27-29 top-down level rank of chord note w/accid. Set in crdaccs.
+c
+c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
+c
+ ncrd = ncrd+1
+ ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),10)
+ numnum = 0
+c icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8))
+ icrdat(ncrd) = nnl(ivx)
+ call setbits(icrdat(ncrd),4,8,mod(ivx,16))
+ if (ivx .ge. 16) icrdat(ncrd) = ibset(icrdat(ncrd),28)
+ icrdot(ncrd) = 0
+ icrdorn(ncrd) = 0
+c
+c Get note name
+c
+ call getchar(lineq,iccount,charq)
+c
+c Get optional inputs
+c
+25 call getchar(lineq,iccount,durq)
+c ndx = index('fsn+-<>12345678rediA',durq)
+ ndx = index('fsn+-<>12345678rediAc',durq)
+ if (ndx .eq. 20) then
+c
+c Expect +|-|<|> , set tag, loop
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),29)
+ go to 25
+ else if (ndx .gt. 0) then
+ if (ndx .le. 3) then
+ if (.not.btest(icrdat(ncrd),19)) then
+ icrdat(ncrd) = ibset(icrdat(ncrd),19)
+ icrdat(ncrd) = ior(icrdat(ncrd),ishft(ndx,20))
+ else
+ icrdat(ncrd) = ibset(icrdat(ncrd),22)
+ end if
+ else if (ndx .eq. 21) then
+c
+c Set flags for cautionary accidental
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),31)
+ iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),31)
+ else if (ndx .le. 7) then
+c
+c +/-/</> Check whether octave or accidental shift
+c
+ nactmp = 0
+ call chkpm4ac(lineq,iccount,nactmp,moved)
+ if (moved) then
+c
+c Transfer accidental shift values
+c
+ call setbits(icrdot(ncrd),6,14,igetbits(nactmp,6,4))
+ call setbits(icrdot(ncrd),7,20,igetbits(nactmp,7,10))
+ else
+ if (durq .eq. '+') then
+ lastlev = lastlev+7
+ else if (durq .eq. '-') then
+ lastlev = lastlev-7
+ end if
+ end if
+ else if (durq .eq. 'e') then
+ icrdat(ncrd) = ibset(icrdat(ncrd),23)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),27)
+ else if (durq .eq. 'r') then
+ icrdat(ncrd) = ibset(icrdat(ncrd),24)
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),20)
+ else if (durq .eq. 'i') then
+c
+c Midi-only accidental on chord note
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),27)
+ else if (durq .eq. 'd') then
+c
+c Must keep 'd' optional (backward compatibility), unless it is moved!
+c
+ if (index('+-',lineq(iccount+1:iccount+1)) .gt. 0) then
+c
+c move a dot, unless next char is not part of a number
+c
+ if (index('0123456789.',lineq(iccount+2:iccount+2))
+ * .eq. 0) go to 25
+ icrdat(ncrd) = ibset(icrdat(ncrd),26)
+ call getchar(lineq,iccount,durq)
+ iccount=iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (durq .eq. '+') then
+ icrdot(ncrd) = ior(icrdot(ncrd),nint(fnum*10)+64)
+ else
+ icrdot(ncrd) = ior(icrdot(ncrd),-nint(fnum*10)+64)
+ end if
+ if (index('+-',dumq) .gt. 0) then
+c
+c Vertical shift specified also
+c
+ iccount=iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (dumq .eq. '+') then
+ ifnum = nint(fnum*10)+64
+ else
+ ifnum = -nint(fnum*10)+64
+ end if
+ else
+ ifnum = 64
+ end if
+ icrdot(ncrd) = ior(icrdot(ncrd),ishft(ifnum,7))
+ iccount = iccount-1
+ end if
+ else
+c
+c must be a single digit, save it in ioct
+c
+ numnum = 1
+ ioct = ndx-7
+ end if
+ go to 25
+ end if
+ if (numnum .eq. 1) then
+ lastlev = ifnolev(charq,ioct,iTransAmt(instno(iv)))
+ else
+ lastlev = lastlev-3
+ * +mod(ifnolev(charq,10,iTransAmt(instno(iv)))-lastlev+3,7)
+ end if
+ icrdat(ncrd) = ior(icrdat(ncrd),ishft(lastlev,12))
+ do 44 npreslur = npreslur , 1 , -1
+ call setbits (isdat2(nsdat-npreslur+1),7,19,lastlev)
+c
+c Set level for chord note.
+c Initially I assigned the slur(s) to next note, so fix.
+c
+ islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),0)
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),0)
+ isdat2(nsdat-npreslur+1) = ibset(isdat2(nsdat-npreslur+1),0)
+ call setbits(isdat1(nsdat-npreslur+1),8,3,
+ * igetbits(isdat1(nsdat-npreslur+1),8,3)-1)
+44 continue
+ if (notcrd) then
+c
+c This is the first chord note in this chord.
+c
+ minlev = min(nolev(ivx,nnl(ivx)),lastlev)
+ maxlev = max(nolev(ivx,nnl(ivx)),lastlev)
+ else
+ minlev = min(minlev,lastlev)
+ maxlev = max(maxlev,lastlev)
+ end if
+ notcrd = .false.
+ else if (charq .eq. 'G') then
+ call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev,
+ * lastlev,iv,nv)
+c
+c Grace, comes *before* main note:
+c UNLESS there's an 'A' or 'W' after the 'G'
+c ngrace = # of grace note groups so far in block
+c ivg(ngrace), ipg(ngrace)
+c nng(ngrace) = # of notes in this group: default = 1
+c ngstrt(ngrace) = starting position in nolevg of levels for this grace
+c multg(ngrace) = multiplicity: default = 1; input as 'm(digit)'
+c upg(ngrace) = logical for beam or stem dirn: default T, input'u,l'
+c slurg(ngrace) = logical for slur; default F, input 's'
+c slashg(ngrace) = T if slash; default is F, input 'x'
+c These data MUST precede note name of first note
+c nolevg, naccg: lists of levels and accid's, indexed as described above.
+c
+ else if (charq .eq. sq) then
+c
+c Literal TeX string
+c
+ call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
+ else if (charq .eq. chax(34)) then
+c
+c pmxlyr string. Expand "..." to \pmxlyr{...}\
+c
+ if (.not. inputmlyr) then
+ ictemp = 0
+ lineqt = sq//sq//sq//'input musixlyr '//sq
+ call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp)
+ inputmlyr = .true.
+ end if
+ call dopmxlyr(lineq,iccount)
+ charq = sq
+ call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount)
+ else if (charq .eq. 'o') then
+c
+c Ornament on non-xtup note. Symbol must come AFTER the affected note
+c
+ if (notcrd) then
+ nole = nolev(ivx,nnl(ivx))
+ else
+ nole = iand(127,ishft(icrdat(ncrd),-12))
+ end if
+ call getorn(lineq,iccount,iornq(ivx,nnl(ivx)),
+ * iornq(ivx,0),ornrpt,noffseg,nnl(ivx),ivx,
+ * .true.,notcrd,nole)
+ else if (index('st(){}',charq) .gt. 0) then
+ nnlivx = nnl(ivx)
+ if (charq.eq.'(' .or. charq.eq.'{') then
+c
+c Detect preslur on normal non-chord note
+c
+ nnlivx = nnlivx+1
+ npreslur = npreslur+1
+ end if
+ islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),0)
+ if (charq.eq.'t')
+ * islur(ivx,nnlivx) = ibset(islur(ivx,nnlivx),1)
+ if (ivx .le. nv) then
+ kv = 1
+ else
+ kv = 2
+ end if
+ if (fontslur) then
+ call sslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
+ * nsdat,notcrd,nolev(ivx,nnlivx),charq)
+ else
+ call spsslur(lineq,iccount,iv,kv,nnlivx,isdat1,isdat2,isdat3,
+ * isdat4,nsdat,notcrd,nolev(ivx,nnlivx),charq)
+ end if
+ else if (charq .eq. '?') then
+c
+c Arpeggio
+c
+ if (btest(ipl(ivx,nnl(ivx)),10)) then
+c
+c This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note
+c of chord, will not set icrdat(25), but iornq(27)
+c
+ icrdat(ncrd) = ibset(icrdat(ncrd),25)
+ else
+ iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),27)
+ end if
+c
+c Check for shift
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ' ') then
+ iccount = iccount-1
+ else
+c
+c durq must be "-"
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+c
+c record the shift
+c
+ NumArpShift = NumArpShift+1
+ IvArpShift(NumArpShift) = ivx
+ IpArpShift(NumArpShift) = nnl(ivx)
+ ArpShift(NumArpShift) = fnum
+ end if
+ else if (index('0123456789#-nx_',charq) .gt. 0) then
+c
+c We have a figure. Must come AFTER the note it goes under
+c
+
+ ivf = 1
+ if (ivx .gt. 1) then
+ if (ivxfig2 .eq. 0) then
+ ivxfig2 = ivx
+ else if (ivx .ne. ivxfig2) then
+ print*
+ print*,'Figures not allowed in >1 voice above first'
+ stop
+ end if
+ ivf = 2
+ end if
+ nfig1 = nfigs(ivf)+1
+ call getfig(itoff(ivf,nfig1),charq,lineq,iccount,
+ * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx),
+ * nodur(ivx,nnl(ivx)),figq(ivf,nfig1),
+c * ivupfig(ivf,nfig1),nfigs(ivf))
+ * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf))
+ else if (charq .eq. '[') then
+c
+c Start forced beam. Record barno & time since start of inp. blk. Set signal
+c
+ nfb(ivx) = nfb(ivx)+1
+ fbon = .true.
+ ulfbq(ivx,nfb(ivx)) = 'x'
+ t1fb(ivx,nfb(ivx)) = itsofar(ivx)
+ nadj = 0
+ if (autofbon) then
+ autofbon = .false.
+ end if
+17 call getchar(lineq,iccount,charq)
+ if (index('ulf',charq) .gt. 0) then
+ ulfbq(ivx,nfb(ivx)) = charq
+ go to 17
+ else if (charq .eq. 'j') then
+c
+c Continuing a jumped beam here
+c
+ irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),24)
+c
+c Set flag to watch for END of this forced beam, so can set flag rest(30) on
+c NEXT note as signal to start a new notes group there.
+c
+ isbj2 = .true.
+ go to 17
+ else if (charq .eq. 'h') then
+ islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),2)
+ go to 17
+ else if (charq .eq. 'm') then
+c
+c Force multiplicity. Next input is digit
+c
+ call getchar(lineq,iccount,charq)
+ islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),21)
+ call setbits(islur(ivx,nnl(ivx)+1),3,22,ichar(charq)-48)
+ go to 17
+ else if (charq .eq. ':') then
+c
+c Start auto forced beam pattern
+c
+ autofbon = .true.
+c
+c When forced later beam ends, check whether tautofv <=0; if so set it.
+c
+ tautofb = -itsofar(ivx)
+ t1autofb = itsofar(ivx)
+ go to 17
+ else if (charq .ne. ' ') then
+c
+c Must be '+/-' for height or slope shift
+c
+ nadj = nadj+1
+c
+c nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level.
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ iadj = nint(fnum)
+ if (charq .eq. '-') iadj = -iadj
+ if (nadj .eq. 1) then
+c
+c This is a level shift. Note if 0 was entered, iadj = 30
+c
+ call setbits(ipl(ivx,nnl(ivx)+1),6,11,iadj+30)
+ else if (nadj .eq. 2) then
+c
+c Must be a slope shift
+c
+ call setbits(ipl(ivx,nnl(ivx)+1),6,17,iadj+30)
+ else
+c
+c Beam-thk fine tune
+c
+ call setbits(islur(ivx,nnl(ivx)+1),2,27,iadj)
+ end if
+ go to 17
+ end if
+ else if (charq .eq. ']') then
+ if (autofbon .and. tautofb.lt.tol) then
+ tautofb=itsofar(ivx)+tautofb
+ end if
+ call getchar(lineq,iccount,charq)
+ if (index('j ',charq) .gt. 0) then
+c
+c Since ']' comes AFTER note, itsofar has been updated. Set ending signal.
+c
+ t2fb(ivx,nfb(ivx)) = itsofar(ivx)
+ fbon = .false.
+ if (charq .eq. 'j') then
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),23)
+ end if
+ if (isbj2) then
+c
+c This is the end of a fb segment of a jump beam. Set flag on NEXT note to
+c force start of new notes group, provided this is not last note in bar.
+c
+ if (mod(itsofar(ivx),lenbar) .ne. 0)
+ * irest(ivx,nnl(ivx)+1) = ibset(irest(ivx,nnl(ivx)+1),30)
+ isbj2 = .false.
+ end if
+ else if (charq .eq. '[') then
+c
+c Multiplicity down-up signal
+c
+ islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),20)
+ else if (charq .eq. '-') then
+c
+c Set signals for gap in single-slope beam [...]-[...]
+c
+ nacc(ivx,nnl(ivx)) = ibset(nacc(ivx,nnl(ivx)),20)
+ nacc(ivx,nnl(ivx)+1) = ibset(nacc(ivx,nnl(ivx)+1),21)
+c
+c Next two characters must be "[ ". Skip over them.
+c
+ iccount = iccount+2
+ end if
+ else if (charq .eq. 'D') then
+ call getdyn(ivx,nnl(ivx),irest(ivx,nnl(ivx)),
+ * iornq(ivx,nnl(ivx)),lineq,iccount)
+ else if (charq .eq. 'h') then
+c
+c Heading or height. For heading, only OK if at start of block
+c Check whether at beginning of a block
+c
+ if (iv.ne.1 .or. nnl(1).ne.0) then
+ print*,'You entered "h" not at beginning of block'
+ call stop1()
+ end if
+ call getchar(lineq,iccount,durq)
+ ihdvrt = 0
+ if (index('+-',durq) .gt. 0) then
+c
+c Vertical offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,charq,fnum)
+ ihdvrt = fnum+.1
+ if (durq .eq. '-') ihdvrt = -ihdvrt
+ durq = charq
+ end if
+ if (durq .ne. ' ') then
+c
+c Height symbol. Read past (until next blank)
+c
+3 call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') go to 3
+ else
+c
+c Set flag for header & read it in
+c
+ ihdht = 16
+ call getbuf(headrq)
+ iccount = 128
+ end if
+ else if (charq .eq. 'L') then
+c
+c Linebreak, already handled some in pmxa, but need to get data for
+c shortened line or coda lengths
+c
+ iccount = iccount+1
+ if (lineq(iccount:iccount) .eq. 'C') then
+c
+c Coda, get length
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,codafrac)
+ ishort = 3
+ if (durq .eq. 'n') nocodabn = .true.
+ return
+ end if
+c
+c Get line number
+c
+ call readnum(lineq,iccount,durq,fmovbrk)
+48 continue ! Allow transfer up from below if S follows M
+ if (durq .eq. 'S') then
+c
+c Shortened line, get shortening fraction
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,shortfrac)
+ ishort = 1
+ codafrac = 0.
+ end if
+c
+c Begin check for movement break
+c
+ if (durq .eq. 'P') then
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ end if
+ if (durq .eq. 'M') then
+ movbrk = nint(fmovbrk)
+ movgap = 0
+ parmov = -1.
+ call getchar(lineq,iccount,durq)
+31 if (durq .eq. '+') then
+c
+c Get vertical space (\internotes)
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ movgap = nint(fnum)
+ go to 31
+ else if (durq .eq. 'i') then
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,parmov)
+ go to 31
+ else if (durq .eq. 'c') then
+ nobar1 = .true.
+ call getchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'r') then
+c
+c "rename" can be set on or off.
+c
+ call getchar(lineq,iccount,durq)
+ rename = durq.eq.'+'
+ call getchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'n') then
+c
+c Change # of voices. Input ninow, iiorig(1...ninow). Will use names,
+c staves per inst. and clefs corr. to iiorig in original list of instruments.
+c
+ nvold = nv
+ nv = 0
+ rename = .true.
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ':') then
+ iccount = iccount+2
+ read(lineq(iccount-1:iccount),'(i2)')ninow
+ else
+ ninow = ichar(durq)-48
+ end if
+ iiv = 0
+ do 63 iinow = 1 , ninow
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ':') then
+ iccount = iccount+2
+ read(lineq(iccount-1:iccount),'(i2)')iiorig(iinow)
+ else
+ iiorig(iinow) = ichar(durq)-48
+ end if
+ nspern(iinow) = nsperi(iiorig(iinow))
+ nv = nv+nspern(iinow)
+ sepsymq(iiv+nspern(iinow)) = '&'
+ if (nspern(iinow) .gt. 1) then
+ do 64 iis = 1 , nspern(iinow)-1
+ sepsymq(iiv+iis) = '|'
+64 continue
+ end if
+ iiv = iiv+nspern(iinow)
+63 continue
+c
+c 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement
+c
+c if (islast) then
+c if (ninow .lt. 10) then
+c write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%'
+c else
+c write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%'
+c end if
+c end if
+ if (nv.eq.1 .and. nvold.gt.1) then
+ if (islast) write(11,'(a)')sq//'nostartrule'
+ else if (nv.gt.1 .and. nvold.eq.1) then
+ if (islast) write(11,'(a)')sq//'startrule'
+ end if
+ iiv = 0
+ do 60 iinow = 1 , ninow
+ do 61 iis = 1 , nspern(iinow)
+ iiv = iiv+1
+c
+c May not really need to re-enter clefs, but it's easier to program since
+c clef names are not saved but are needed in newvoice to set ncmidcc.
+c
+ call getchar(lineq,iccount,clefq(iiv))
+ call newvoice(iiv,clefq(iiv),.true.)
+ if (nspern(iinow) .eq. 1) then
+ hdlndq = chax(48+numclef(clefq(iiv)))
+ lclf = 1
+ else if (iis .eq. 1) then
+ hdlndq = '{'//chax(48+numclef(clefq(iiv)))
+ lclf = 2
+ else if (iis .lt. nspern(iinow)) then
+ hdlndq = hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))
+ lclf = lclf+1
+ else
+ hdlndq =
+ * hdlndq(1:lclf)//chax(48+numclef(clefq(iiv)))//'}'
+ lclf = lclf+2
+ end if
+61 continue
+c
+c setstaffs & setclef go by instrument, not voice
+c
+ if (islast) then
+ if (iinow .lt. 10) then
+ write(11,'(a)')sq//'setstaffs'
+ * //chax(48+iinow)//chax(48+nspern(iinow))//'%'
+ write(11,'(a)')sq//'setclef'//chax(48+iinow)
+ * //hdlndq(1:lclf)//'%'
+ if (fullsize(iiorig(iinow)).gt.0.9) then
+ write(11,'(a)')sq//'setsize'//chax(48+iinow)
+ * //sq//'normalvalue%'
+c
+c 140526 Account for staff size specs when noinst changes. May be confusion
+c here if more than one staff per instrument
+c
+ else if (fullsize(iiorig(iinow)).gt..7) then
+ write(11,'(a)')sq//'setsize'//chax(48+iinow)
+ * //sq//'smallvalue%'
+ else
+ write(11,'(a)')sq//'setsize'//chax(48+iinow)
+ * //sq//'tinyvalue%'
+ end if
+ else
+ write(11,'(a11,i2,a)')sq//'setstaffs{',iinow,
+ * '}'//chax(48+nspern(iinow))//'%'
+ write(11,'(a9,i2,a)')sq//'setclef{',iinow,
+ * '}'//hdlndq(1:lclf)//'%'
+ end if
+ end if
+60 continue
+c
+c Loop back up, this may not be last option in M. Note flow out if durq=' '
+c
+ call getchar(lineq,iccount,durq)
+ go to 31
+ else if (durq .eq. 'S') then
+ go to 48
+ end if
+c
+c Write instrument names
+c
+ if (.not.rename) then
+ do 62 iinst = 1 , ninow
+ if (islast) then
+ if (iinst .lt. 10) then
+ write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%'
+ else
+ write(11,'(a9,i2,a4)')sq//'setname{',iinst,'}{}%'
+ end if
+ end if
+62 continue
+ else
+ do 65 iinst = 1 , ninow
+ if (islast) then
+ if (iinst .lt. 10) then
+ write(11,'(a8,i1,a)')sq//'setname',iinst,'{'//
+ * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
+ else
+ write(11,'(a9,i2,a)')sq//'setname{',iinst,'}{'//
+ * inameq(iiorig(iinst))(1:lnam(iiorig(iinst)))//'}%'
+ end if
+ end if
+65 continue
+ if (ishort.ne.4.and.ishort.ne.2) rename = .false.
+c
+c Reset later and rewrite setname{} in shortening case mcm, since if
+c written here it will be inside {{...}} and will be ignored
+c
+ end if
+ end if
+ else if (charq .eq.'|' ) then
+c
+c End of bar symbol. Check about end of bar hardspace.
+c
+ if (btest(iornq(ivx,nnl(ivx)+1),26)) then
+c
+c There was a hardspace followed by a bar line. Remove it from the hardspace
+c list, store with shifts instead, set special bit. Need to repeat this code
+c at '/'.
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
+ nudoff(ivx) = nudoff(ivx)+1
+ udoff(ivx,nudoff(ivx)) = udsp(nudsp)
+ nudsp = nudsp-1
+ iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
+ end if
+ else if (index('wS',charq) .gt. 0) then
+c
+c Width symbol or new nsyst. Read past (until blank)
+c
+4 call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') go to 4
+ else if (charq .eq. 'l') then
+c
+c Lower string. Only OK if at start of block
+c Check whether at beginning of a block
+c
+ if (iv.ne.1 .or. nnl(1).ne.0) then
+ print*,'You entered "l" not at beginning of block'
+ call stop1()
+ end if
+c
+c Set flag for lower string & read it in
+c
+ lower = .true.
+ call getbuf(lowerq)
+ iccount = 128
+ else if (charq .eq. 'm') then
+c
+c Meter change. Only allow at beginning of block.
+c mtrnuml, mtrdenl (logical) and p (printable) will be input.
+c mtrnuml=0 initially. (In common)
+c
+c Check whether at beginning of a block
+c
+ if (iv.ne.1 .or. nnl(1).ne.0) then
+ print*,'You entered "m" not at beginning of block'
+ call stop1()
+ end if
+ call readmeter(lineq,iccount,mtrnuml,mtrdenl)
+ call readmeter(lineq,iccount,mtrnmp,mtrdnp)
+ lenbeat = ifnodur(mtrdenl,'x')
+ if (mtrdenl .eq. 2) lenbeat = 16
+ lenbar = mtrnuml*lenbeat
+ if (mtrdenl .eq. 2) lenbar = lenbar*2
+ lenb1 = lenbar
+ lenb0 = 0
+ if (ismidi) call midievent('m',mtrnuml,mtrdenl)
+ else if (charq .eq. 'C') then
+c
+c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music.
+c
+ if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1
+ tcc(iv,ncc(iv)) = itsofar(iv)
+ isl = ibset(islur(iv,nnl(iv)+1),11)
+ call getchar(lineq,iccount,durq)
+c
+c Store clef number, or 7 if clef number = 9 (French violin clef)
+c
+ isl = ior(isl,ishft(min(numclef(durq),7),12))
+ ncmidcc(iv,ncc(iv)) = ncmidf(durq)
+ if (durq .eq. '8') then
+ ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2)
+ iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
+ lastlev = lastlev+7
+ if (nnl(iv).eq.0) then
+ ndlev(iv,1) = ndlev(iv,1)+7
+ ndlev(iv,2) = ndlev(iv,2)+7
+ end if
+ else
+c
+c This won't work if you really had an octave transposition with some
+c other clef. Need a check on whether prior clef was an octave clef.
+c
+ if (iTransAmt(instno(iv)).eq.7) then
+ iTransAmt(instno(iv))=iTransAmt(instno(iv))-7
+ lastlev = lastlev-7
+ if (nnl(iv).eq.0) then
+ ndlev(iv,1) = ndlev(iv,1)-7
+ ndlev(iv,2) = ndlev(iv,2)-7
+ end if
+ end if
+ end if
+c
+c Set marker on note with lowest voice # starting at same time.
+c
+ if (iv .eq. 1) then
+ isl = ibset(isl,15)
+ else
+ do 13 iiv = 1 , iv
+ nnliiv = nnl(iiv)
+ if (iiv .eq. iv) nnliiv = nnliiv+1
+ itother = 0
+ do 14 iip = 1 , nnliiv
+ if (itother .lt. itsofar(iv)) then
+ itother = itother+nodur(iiv,iip)
+ go to 14
+ else if (itother .eq. itsofar(iv)) then
+ islur(iiv,iip) = ibset(islur(iiv,iip),15)
+ go to 15
+ end if
+14 continue
+13 continue
+15 continue
+ end if
+c
+c Need 'or' since may have set bit 15 in the above loop
+c
+ islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1))
+ else if (charq .eq. 'R') then
+c
+c Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1)
+c
+10 call getchar(lineq,iccount,durq)
+c
+c Save designator in case it's a terminal Rr or Rd
+c
+ if (durq .eq. 'l') then
+ islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),5)
+ go to 10
+ else if (index('rdDbz',durq) .gt. 0) then
+ if (durq .eq. 'r') then
+ islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),6)
+ else if (durq .eq. 'd') then
+ islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),8)
+ else if (durq .eq. 'D') then
+ islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),26)
+ else if (durq .eq. 'b') then
+ islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25)
+ else if (durq .eq. 'z') then
+c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29)
+ ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0)
+ end if
+ rptprev = .true.
+ rptfq1 = durq
+ go to 10
+ end if
+ else if (charq .eq. 'V') then
+c
+c Ending
+c
+ nnnl = nnl(1)+1
+ lvoltxt = 0
+11 call getchar(lineq,iccount,durq)
+ if (durq.eq.'b' .or. durq .eq.'x') then
+c
+c End Volta, set bit9, and bit10 on if 'b' (end w/ box)
+c
+ islur(1,nnnl) = ibset(islur(1,nnnl),9)
+ if (durq .eq. 'b') islur(1,nnnl) = ibset(islur(1,nnnl),10)
+ go to 11
+ else if (durq .ne. ' ') then
+c
+c Start volta; Get text
+c
+ if (lvoltxt .eq. 0) then
+c
+c First character for text
+c
+ lvoltxt = 1
+ islur(1,nnnl) = ibset(islur(1,nnnl),7)
+ nvolt = nvolt+1
+ voltxtq(nvolt) = durq
+ else
+ voltxtq(nvolt) = voltxtq(nvolt)(1:lvoltxt)//durq
+ lvoltxt = lvoltxt+1
+ end if
+ go to 11
+ end if
+ else if (charq .eq. 'B') then
+ bcspec = .not.bcspec
+ else if (charq .eq. 'P') then
+c
+c Page numbers. Print stuff right now.
+c
+ npg1 = 0
+c
+c Will use ltopnam to signal whether there's a centered heading
+c
+ ltopnam = 0
+ ipg1r = 0
+16 call getchar(lineq,iccount,durq)
+ if (ichar(durq).ge.48 .and. ichar(durq).le.57) then
+ npg1 = npg1*10+ichar(durq)-48
+ go to 16
+ else if (durq .eq. 'l') then
+ if (npg1.eq.0 .or. mod(npg1,2).eq.1) ipg1r = 1
+ go to 16
+ else if (durq .eq. 'r') then
+ if (npg1.gt.0 .and. mod(npg1,2).eq.0) ipg1r = 1
+ go to 16
+ else if (durq .eq. 'c') then
+c
+c Top-centered name. Assume this is last option. Read the name.
+c May surround name in double quotes (to allow blanks).
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. ' ') then
+ ltopnam = lenstr(cheadq,60)
+ else
+ namstrt = iccount
+ if (durq .eq. chax(34)) then
+c
+c Using quote delimiters.
+c
+ quoted = .true.
+ namstrt = namstrt+1
+ else
+ quoted = .false.
+ end if
+ do 35 iccount = namstrt+1, 128
+ if ((quoted .and. lineq(iccount:iccount).eq.chax(34) .and.
+ * lineq(iccount-1:iccount-1).ne.chax(92)) .or.
+ * (.not.quoted .and. lineq(iccount:iccount) .eq. ' '))
+ * go to 36
+c
+c On exit, iccount is OK, and name is in (namstrt:iccount-1)
+c
+35 continue
+ print*,'Awww, cmon, should not be here.'
+ call stop1()
+36 continue
+ ltopnam = iccount-namstrt
+ cheadq = lineq(namstrt:iccount-1)
+ end if
+ end if
+c
+c Done getting data, now assemble the command
+c
+ if (npg1.eq.0) npg1=1
+c
+c 2/23/03 Don't use \atnextline if on first page and only one system
+c
+c if (ipage.gt.1 .or. nsystp(1).gt.1) then
+ hdlndq = sq//'def'//sq//'atnextline{'//sq//'toppageno{'
+ lhead = 27
+c else
+c hdlndq = sq//'toppageno{'
+c lhead = 11
+c end if
+ if (npg1 .lt. 10) then
+c
+c Note we are overwriting the last "{"
+c
+ write(hdlndq(lhead:lhead),'(i1)')npg1
+ else if (npg1 .lt. 100) then
+ lhead = lhead+3
+ write(hdlndq(lhead-2:lhead),'(i2,a1)')npg1,'}'
+ else
+ lhead = lhead+4
+ write(hdlndq(lhead-3:lhead),'(i3,a1)')npg1,'}'
+ end if
+ hdlndq = hdlndq(1:lhead)//chax(ipg1r+48)//'{'
+ lhead = lhead+2
+c if (ipage.gt.1 .or. nsystp(1).gt.1) then
+ if (ltopnam .eq. 0) then
+ if (islast) write(11,'(a)')hdlndq(1:lhead)//'}}%'
+ else
+ if (islast)
+ * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}}%'
+ end if
+c else
+c if (ltopnam .eq. 0) then
+c if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%'
+c else
+c if (islast)
+c * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%'
+c end if
+c end if
+ else if (charq .eq. 'W') then
+c
+c Just eat the number that must follow, it was used in pmxa
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ else if (charq .eq. 'T') then
+ headlog = .true.
+ inhead = 0
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'i') then
+ call getbuf(instrq)
+c
+c A kluge for parts from separate score file for later movements.
+c
+ if (instrq(1:1) .eq. ' ') headlog = .false.
+ cheadq = instrq(1:60)
+ else if (durq .eq. 't') then
+ call getchar(lineq,iccount,durq)
+c
+c Optionally can include extra vertical \internotes above inbothd
+c
+ if (index('-+0123456789',durq) .gt. 0) then
+ ipm = 1
+ if (index('+-',durq) .gt. 0) then
+c
+c Don't trust readnum to round this negative integer properly
+c
+ iccount = iccount+1
+ if (durq .eq. '-') ipm = -1
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ inhead = ipm*nint(fnum)
+ end if
+ call getbuf(titleq)
+ else
+ call getbuf(compoq)
+ end if
+ inhead = inhead+inbothd
+ iccount = 128
+ else if (charq .eq. 'A') then
+c
+c Accidental handling etc.
+c
+27 call getchar(lineq,iccount,durq)
+ if (durq .eq. 'r') then
+ if (islast) then
+ relacc = .true.
+ write(11,'(a)')sq//'relativeaccid%'
+ end if
+ else if (durq .eq. 's') then
+ bacfac = 1.e6
+ else if (durq .eq. 'b') then
+ if (islast) write(11,'(a)')sq//'bigaccid%'
+ accfac = bacfac
+ else if (durq .eq. 'a') then
+ call getchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,fnum)
+ iccount = iccount-1
+ else if (durq .eq. 'i') then
+ call getchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,tintstf)
+ if (.not.firstgulp) fintstf = tintstf
+c
+c Local corrections for first page were handled by pmxa
+c
+ iccount = iccount-1
+ else if (durq .eq. 'I') then
+ call getchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,gintstf)
+ iccount = iccount-1
+ else if (durq .eq. 'd') then
+ lowdot = .true.
+ else if (durq .eq. 'o') then
+ continue
+ else if (durq .eq. 'S') then
+ do 50 iiv = 1 , noinst
+ call getchar(lineq,iccount,durq)
+ if (index('-s',durq) .gt. 0) then
+ fullsize(iiv) = 0.8
+ else if (durq .eq. 't') then
+ fullsize(iiv) = 0.64
+ else
+c fullsize(ivx) = 1.0
+ fullsize(iiv) = 1.0
+ end if
+50 continue
+ else if (durq .eq. 'e') then
+c
+c Line-spacing equalization
+c
+ equalize = .true.
+c
+c The following redefinition of \parskip was put into pmx.tex in version 2.25 or so.
+c But it causes problems with some older scores and when excerpts are combined
+c with LaTeX. So as of 2.352 we write it here.
+c
+ write(11,'(a)')sq//'global'//sq//'parskip 0pt plus 12'//sq
+ * //'Interligne minus 99'//sq//'Interligne%'
+ tempq = sepsymq(1)
+ lentemp = 1
+ do 51 iiv = 2 , nv-1
+ tempq = tempq(1:lentemp)//sepsymq(iiv)
+ lentemp = lentemp+1
+51 continue
+ write(11,'(a)')sq//'def'//sq//'upstrut{'//sq//'znotes'
+ * //tempq(1:lentemp)//sq//'zcharnote{'//sq//'upamt}{~}'
+ * //sq//'en}%'
+ else if (durq .eq. 'v') then
+c
+c Toggle usevshrink
+c
+ usevshrink = .not.usevshrink
+ else if (durq .eq.'p') then
+c
+c Postscript slurs. fontslur is already false (set in g1etnote)
+c
+ if (.not.WrotePsslurDefaults) then
+c
+c Set postscrirpt slur adjustment defaults
+c
+ write(11,'(a)')sq//'Nosluradjust'//sq//'Notieadjust'
+ * //sq//'nohalfties'
+ WrotePsslurDefaults = .true.
+ end if
+52 continue
+ call g1etchar(lineq,iccount,durq) ! might be "+", "-", "h" or "l"
+ if (index('+-',durq) .gt. 0) then
+c
+c Characters to change defaults for ps slurs
+c
+ call g1etchar(lineq,iccount,charq) ! charq will be "s,t,h,c"
+ if (durq .eq. '+') then
+ if (charq .eq. 's') then
+ write(11,'(a)')sq//'Sluradjust'
+ else if (charq .eq. 't') then
+ write(11,'(a)')sq//'Tieadjust'
+ else if (charq .eq. 'h') then
+ write(11,'(a)')sq//'halfties'
+ else
+ SlurCurve = SlurCurve + 1
+ if (SlurCurve .gt. 3.1) then
+ call printl('WARNING!')
+ call printl
+ * ('Default slur curvature advanced past HH, resetting')
+ SlurCurve = 3
+ end if
+ end if
+ else
+ if (charq .eq. 's') then
+ write(11,'(a)')sq//'Nosluradjust'
+ else if (charq .eq. 't') then
+ write(11,'(a)')sq//'Notieadjust'
+ else if (charq .eq. 'h') then
+ write(11,'(a)')sq//'nohalfties'
+ else
+ SlurCurve = SlurCurve - 1
+ if (SlurCurve .lt. -1.1) then
+ call printl('WARNING!')
+ call printl(
+ * 'Default slur curvature decremented below f, resetting')
+ SlurCurve = -1
+ end if
+ end if
+ end if
+ go to 52 ! Check for another set of default changes
+ else if (durq .eq. 'l') then
+c
+c Set optional linebreak ties
+c
+ OptLineBreakTies = .true.
+ go to 52
+ else if (durq .eq. 'h') then
+c
+c Set flag to write header special on every page
+c
+ HeaderSpecial = .true.
+ go to 52
+ else
+ iccount = iccount-1
+ end if
+ else if (durq .eq. 'K') then
+c
+c Toggle keyboard rest placement flag
+c
+ kbdrests = .not.kbdrests
+ else if (durq .eq. 'c') then
+ call g1etchar(lineq,iccount,durq)
+c
+c Just eat the input; it was used in pmxa
+c
+ go to 27
+ else if (durq .eq. 'V') then
+ bottopgap = .true.
+ topamt = 0.
+ call getchar(lineq,iccount,durq)
+ pmfac = index('- +',durq)-2
+ call g1etchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,botamt)
+ botamt = botamt*pmfac
+ pmfac = index('- +',durq)-2
+ call g1etchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,topamt)
+ topamt = topamt*pmfac
+ iccount = iccount-1
+ go to 27
+ end if
+ if (index('NR',durq) .gt. 0) then
+c
+c Override default part names for scor2prt, or normal include file.
+c Just bypass rest of input line
+c
+ iccount = 128
+ else if (durq .ne. ' ') then
+ go to 27
+ end if
+ else if (charq .eq. 'K') then
+77 continue
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'n') then
+ ignorenats = .true.
+ go to 77
+ end if
+ if (durq .ne. 'i') then
+c
+c Normal, full-score key change and/or transposition
+c
+ num1 = 44-ichar(durq)
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ num1 = num1*nint(fnum)
+c
+c On exit, durq='+','-'. But only need isig if after start, else done in pmxa
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,charq,fnum)
+ if (ismidi) then
+ midisig = nint(fnum)
+ if (durq.eq.'-') midisig = -midisig
+c 130317
+ midisig = midisig+idsig
+ call midievent('k',midisig,0)
+
+ end if
+c70 continue
+ if (num1 .eq. 0) then
+c
+c Key change, not transposition.
+c
+ ipl(ivx,nnl(ivx)+1) = ibset(ipl(ivx,nnl(ivx)+1),28)
+ lastisig = isig
+ isig = nint(fnum)
+ if (durq .eq. '-') isig = -isig
+ isig = isig+idsig
+ if (ismidi) call midievent('k',isig,0)
+ else
+c
+c num1 .ne. 0, so transposition, so must be at beginning. isig came with K...
+c but was passed to pmxb through pmxtex.dat. isig0 comes from setup data
+c (signature before transposition). idsig must be added to future key changes.
+c
+ jv = 0
+ do while (jv .lt. nm)
+ jv = jv+1
+ iTransAmt(jv) = num1
+ end do
+ idsig = isig-isig0
+ end if
+ else
+c
+c Instrument specific transposition.
+c
+ call GetiTransInfo(.false.,ibarcnt,lineq,iccount,
+ * ibaroff,nbars,noinst)
+c
+c The sig parameters will have been set 1st time but that's OK
+c
+ end if
+ else if (charq .eq. chax(47)) then
+ if (btest(iornq(ivx,nnl(ivx)+1),26)) then
+c
+c There was a hardspace followed by end of block. Remove it from the hardspace
+c list, store with shifts instead, set special bit. This code also at '|'
+c
+ irest(ivx,nnl(ivx)) = ibset(irest(ivx,nnl(ivx)),18)
+ nudoff(ivx) = nudoff(ivx)+1
+ udoff(ivx,nudoff(ivx)) = udsp(nudsp)
+ nudsp = nudsp-1
+ iornq(ivx,nnl(ivx)+1) = ibclr(iornq(ivx,nnl(ivx)+1),26)
+ end if
+ call getchar(lineq,iccount,durq)
+c
+c Save ending note level:
+c
+ if (ivx .le. nv) then
+c
+c This is the first line of music on this staff. If previous block had only 1
+c voice, save last pitch from line 1 of prev. block to line 2, in case a
+c 2nd line is started just below
+c
+ if (.not.was2(iv)) ndlev(iv,2) = ndlev(iv,1)
+ was2(iv) = .false.
+ ndlev(iv,1) = lastlev
+ else
+c
+c This is the 2nd line of music on this staff.
+c
+ was2(iv) = .true.
+ ndlev(iv,2) = lastlev
+ end if
+ if (durq .eq. ' ' .and. iv.eq.nv) then
+c
+c End of input block
+c
+ loop = .false.
+ else
+c
+c Start a new line of music
+c
+ if (lenb0.ne.0 .and. firstgulp) lenbar = lenb0
+ nbars = 0
+ if (durq .eq. ' ') then
+c
+c New line of music is on next staff
+c
+ iv = iv+1
+ ivx = iv
+ else
+c
+c durq must be 2nd '/'. New line of music is on same staff. Set up for it
+c
+ ivx = nv+1
+ do 23 iiv = 1 , nv
+ if (nvmx(iiv) .eq. 2) ivx = ivx+1
+23 continue
+ nvmx(iv) = 2
+ ivmx(iv,2) = ivx
+ itsofar(ivx) = 0
+ nnl(ivx) = 0
+ nfb(ivx) = 0
+ nudoff(ivx) = 0
+ ndotmv(ivx) = 0
+ do 24 j = 1 , 200
+ irest(ivx,j) = 0
+ islur(ivx,j) = 0
+ nacc(ivx,j) = 0
+ iornq(ivx,j) = 0
+ ipl(ivx,j) = 0
+ mult(ivx,j) = 0
+24 continue
+c
+c Go back and lower the rests in voice "a" that don't have over-ridden heights
+c
+ do 26 j = 1 , nnl(iv)
+ if (btest(irest(iv,j),0) .and. nolev(iv,j).eq.0)
+ * nolev(iv,j) = -4
+26 continue
+ end if
+ end if
+ iccount = 128
+ else if (charq .eq. 'X') then
+c
+c 3rd arg is only for termination of group shifts. Use "max" to avoid zero index,
+c which only happens for normal X at block start, and we took special measures to
+c keep group shifts for crossing block boundaries.
+c
+ call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx))),
+ * shifton,wheadpt,iornq(ivx,nnl(ivx)+1),ivx,
+ * irest(ivx,nnl(ivx)+1),itsofar(ivx),0,0,0,' ',ndoub)
+ else if (charq .eq. 'I') then
+c
+c Midi controls.
+c
+ call getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars,lenbar,
+ * mtrdenl,nv,.false.)
+ else if (charq .eq. 'M') then
+c
+c Macro action
+c
+ call getchar(lineq,iccount,charq)
+ if (index('RS',charq) .gt. 0) then
+c
+c Record or save a macro. Get the number of the macro.
+c
+ call getchar(lineq,iccount,durq)
+ call readnum(lineq,iccount,durq,fnum)
+ macnum = nint(fnum)
+ macuse = ibset(macuse,macnum)
+ if (charq .eq. 'R') then
+ call mrec1(lineq,iccount,ndxm)
+ else
+c
+c Save (Record but don't activate)
+c
+5 call mrec1(lineq,iccount,ndxm)
+ if (mrecord) then
+ call getbuf(lineq)
+ iccount = 0
+ go to 5
+ end if
+ iccount = iccount+ndxm+1
+ end if
+ else if (charq .eq. 'P') then
+c
+c Playback the macro
+c
+ call getchar(lineq,iccount,charq)
+ call readnum(lineq,iccount,durq,fnum)
+ macnum = nint(fnum)
+ icchold = iccount
+ lnholdq = lineq
+ iccount = 128
+ ilmac = il1mac(macnum)
+ mplay = .true.
+ end if
+ else if (index(',.',charq) .gt. 0) then
+c
+c Continued rhythmic shortcut
+c
+ idotform = index('. ,',charq)
+ if (idotform .eq. 1) then
+c
+c Check for start of forced beam on 2nd member of dotform=1 shortcut
+c
+ if (fbon) then
+ if (t1fb(ivx,nfb(ivx)).eq.itsofar(ivx))
+ * t1fb(ivx,nfb(ivx)) =
+ * t1fb(ivx,nfb(ivx))+nodur(ivx,nnl(ivx))/2
+ end if
+c
+c Change duration of prior note
+c
+ itsofar(ivx) = itsofar(ivx)-nodur(ivx,nnl(ivx))
+ nodur(ivx,nnl(ivx)) = nodur(ivx,nnl(ivx))*3/2
+ itsofar(ivx) = itsofar(ivx)+nodur(ivx,nnl(ivx))
+ end if
+ idotform = idotform+1
+ numnum = 1
+ cdot = .true.
+ go to 1
+ end if
+ return
+ end
+ subroutine getorn(lineq,iccount,iornq,iornq0,ornrpt,noffseg,
+ * ip,ivx,noxtup,notcrd,nole)
+c
+c iornq: Main note. Do not alter if chord note, except turn on bit 23
+c iornq0: Store iorni + bit 23, in case of repeated ornaments
+c iorni: Internal use, 1st 21 bits of iornq or icrdorn, dep. on notcrd.
+c noffseg: horiz. offset for segno
+c nole: level of note w/ orn, used to ID the note/orn if there's a level shift.
+c
+
+ common /comivxudorn/ivxudorn(63)
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /comcb/ nbc,ibcdata(36)
+ character*1 charq,durq
+ character*128 lineq
+ logical ornrpt,negseg,noxtup,notcrd
+c
+c Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U
+c 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid.
+c
+ call getchar(lineq,iccount,charq)
+ if (index('bc',charq) .gt. 0) then
+c
+c caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc)
+c ivx(0-3,28), ip(4-12),
+c vshift (vshift+32 in bits 13-18),
+c hshift (nint(10*vshift)+128 in bits 19-26)
+c bit 27 = 0 if caesura, 1 if breath
+c bit 28: 5th bit of ivx
+c
+ iornq = ibset(iornq,28)
+ nbc = nbc+1
+c ibcdata(nbc) = ivx+16*ip
+ ibcdata(nbc) = mod(ivx,16)+16*ip
+ if (ivx.ge.16) ibcdata(nbc) = ibset(ibcdata(nbc),28)
+ if (charq .eq. 'b') ibcdata(nbc) = ibset(ibcdata(nbc),27)
+ call getchar(lineq,iccount,durq)
+ if (index('+-',durq) .gt. 0) then
+c
+c We have a vertical shift, get it
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,charq,fnum)
+ if (durq .eq. '-') fnum=-fnum
+ call setbits(ibcdata(nbc),6,13,nint(32+fnum))
+ if (index('+-',charq) .gt. 0) then
+c
+c Horizontal shift, get it
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (charq .eq. '-') fnum=-fnum
+ call setbits(ibcdata(nbc),8,19,nint(10*fnum)+128)
+ end if
+ end if
+ return
+ end if
+c
+c Set signal on main note that some note at this time has ornament. ONLY used
+c in beamstrt to activate further tests for whether ihornb is needed.
+c
+ iornq = ibset(iornq,23)
+c
+c Isolate 21 bits defining exisiting ornaments
+c
+ if (notcrd) then
+c iorni = iand(4194303,iornq)
+c iorni = iand(541065215,iornq)
+ iorni = iand(1614807039,iornq)
+ else
+ iorni = iand(4194303,icrdorn(ncrd))
+ end if
+c korn = index('stmgx+Tupf._)e:XXX>^',charq)
+ korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq)
+ if (korn .ne. 15) iorni = ibset(iorni,korn)
+c
+c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later
+c as follows: korn=16-18 for sfn, and or 21 for bare ?.
+c When this if-block is done, korn will = bit# of actual ornament (unless "?").
+c
+ if (korn .eq. 15) then
+c
+cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq
+cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq
+c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq
+c
+c iorni = ior(iorni,iand(iornq0,1638383))
+c iorni = ior(iorni,iand(iornq0,3735535))
+c iorni = ior(iorni,iand(iornq0,540606447))
+ iorni = ior(iorni,iand(iornq0,1614348271))
+ ornrpt = .false.
+ call getchar(lineq,iccount,durq)
+c
+c durq will be ' '
+c
+ else if (korn .eq. 14) then
+c
+c Editorial accidental
+c
+ call getchar(lineq,iccount,durq)
+c korn = 15+index('sfn',durq)
+ korn = 15+index('sfn?',durq)
+ if (korn .eq. 19) korn=21
+ iorni = ibset(ibclr(iorni,14),korn)
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. '?') then
+c
+c This is "oe[s|f|n]?". Set 21st bit also.
+c
+ iorni = ibset(iorni,21)
+ korn = korn+6
+ call getchar(lineq,iccount,durq)
+ end if
+c iorni = ibset(ibclr(iorni,14),korn)
+ else if (korn.eq.4 .and. noxtup) then
+c
+c segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points
+c
+ noffseg = 0
+ negseg = .false.
+ call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') then
+c
+c Segno shift is specified
+c
+ if (durq .eq. '-') then
+ negseg = .true.
+ call getchar(lineq,iccount,durq)
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ noffseg = int(fnum)
+ if (negseg) noffseg = -noffseg
+ end if
+ else if (korn .eq. 7) then
+c
+c Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr"
+c
+ ntrill = ntrill + 1
+ ivtrill(ntrill) = ivx
+ iptrill(ntrill) = ip
+ xnsktr(ntrill) = 1.
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 't') then
+c
+c Convert to new internal symbol for non-'"tr" trill
+c
+ korn = 15
+ iorni = ibset(ibclr(iorni,7),15)
+ call getchar(lineq,iccount,durq)
+ end if
+ if (index('0123456789.',durq) .gt. 0) then
+c
+c We have a number for the length
+c
+ call readnum(lineq,iccount,durq,xnsktr(ntrill))
+ end if
+ else if (korn.eq.10 .and. noxtup) then
+c
+c Fermata
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'd') then
+ korn = 14
+ iorni = ibset(ibclr(iorni,10),14)
+ call getchar(lineq,iccount,durq)
+ end if
+ else
+ call getchar(lineq,iccount,durq)
+ end if
+ if (index('+- :',durq) .eq. 0) then
+ print*,'Unexpected character at end of ornament: ',durq
+ call stop1()
+ end if
+ if (index('+-',durq) .gt. 0) then
+c
+c Shift ornament up or down
+c
+ nudorn = nudorn+1
+c
+c Set bit 25 in iorni as a signal. This may not really be necessary.
+c
+ iorni = ibset(iorni,25)
+c
+c Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev,
+c 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present
+c
+ xofforn = 44-ichar(durq)
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ iofforn = nint(xofforn*fnum)
+ kudorn(nudorn) = ip+ishft(mod(ivx,16),8)+ishft(nole,12)
+ * +ishft(korn,19)+ishft(iofforn+32,25)
+ ivxudorn(nudorn) = ivx
+ if (index('+-',durq) .gt. 0) then
+c
+c Horizontal shift
+c
+ kudorn(nudorn) = ibset(kudorn(nudorn),31)
+ xofforn = 44-ichar(durq)
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+c 141226 ornhshft(nudorn) = nint(xofforn*fnum)
+ ornhshft(nudorn) = xofforn*fnum
+ end if
+ else if (durq .eq. ':') then
+c
+c Turn on repeated ornaments
+c
+ ornrpt = .true.
+c
+c Save the ornament value just set
+c
+ iornq0 = iorni
+ end if
+ if (notcrd) then
+ iornq = ior(iornq,iorni)
+ else
+ icrdorn(ncrd) = ior(icrdorn(ncrd),iorni)
+ end if
+ return
+ end
+ subroutine getpmxmod(global,includeq)
+c
+c If global=.true., checks for environment variable with path to pmx.mod.
+c Then, if variable exists and points to pmx.mod, insert lines from
+c pmx.mod into buffer
+c If global=.false., checks for existence of includeq and uses it.
+c
+c lenbuf0 = total length of bufq on entry
+c lbuf(i) = length of line (i)
+c nlbuf = number of lines stored in bufq
+c ilbuf = index of first line after setup stuff (on entry). In general, index of
+c next line to be sucked from buffer.
+c ilbufmod = counter for lines in pmx.mod as they are grabbed.
+c Starts at ilbuf. Points to position of next line after
+c pmx.mod stuff in bufq on exiting loop 1
+c ilbuff = transient counter for shifting operations
+c ipbuf = on entry, points to last character in setup stuff. In general, points
+c to last character of most recent line sucked from buffer.
+c ipbufmod = points to last character of most recent inserted line
+c from pmx.mod
+c
+ parameter (maxblks=9600,nm=24)
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ logical lastchar,fbon,issegno,isheadr,isvolt
+ character*(*)includeq
+ character*80 pmxmoddirq
+ character*128 lnholdq
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ logical fexist,global
+ line1pmxmod = ilbuf
+ if (.not.global) then
+ inquire(file=includeq,EXIST=fexist)
+c
+c Transfer includeq to temporary char variable with known length
+c
+ pmxmoddirq = includeq
+ lpmxmoddirq = lenstr(pmxmoddirq,80)
+ print*
+ write(15,'()')
+ if (.not.fexist) then
+ call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
+ * //', checking further.')
+c
+c File named includeq doesn't not exist. Get directory from PMXMODDIR and
+c see if it's there
+c
+ call getenv('PMXMODDIR',pmxmoddirq)
+ lpmxmoddirq = lenstr(pmxmoddirq,80)
+ if (lpmxmoddirq. gt. 0) then
+ pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//includeq
+ lpmxmoddirq = lenstr(pmxmoddirq,80)
+ else
+ call printl(
+ * 'No other directory defined by PMXMODDIR, stopping')
+ call stop1()
+ end if
+ inquire(file=pmxmoddirq,EXIST=fexist)
+ if (.not.fexist) then
+ call printl('Could not find '//pmxmoddirq(1:lpmxmoddirq)
+ * //', stopping.')
+ call stop1()
+ end if
+ end if
+ call printl('Opening normal include file '
+ * //pmxmoddirq(1:lpmxmoddirq))
+ open(18,file=pmxmoddirq)
+ else
+c
+c Check for existence of pmx.mod
+c
+ call getenv('PMXMODDIR',pmxmoddirq)
+ lpmxmoddirq = lenstr(pmxmoddirq,80)
+ if (lpmxmoddirq .eq. 0) return
+ pmxmoddirq = pmxmoddirq(1:lpmxmoddirq)//'pmx.mod'
+ lpmxmoddirq = lpmxmoddirq+7
+ inquire(file=pmxmoddirq,EXIST=fexist)
+ if (.not.fexist) return
+ call printl('Opening global include file '
+ * //pmxmoddirq(1:lpmxmoddirq))
+ open(18,file=pmxmoddirq(1:lpmxmoddirq))
+ end if
+ call printl('Adding include data')
+c
+c Read lines in from pmx.mod one at a time
+c
+ ipbufmod = ipbuf
+ lenbufmod = lenbuf0
+ do 1 ilbufmod = ilbuf , maxblks
+ read(18,'(a)',end=3)lnholdq
+c
+c A line was read. Slide all existing lengths from here forward ahead by 1
+c
+ do 2 ilbuff = nlbuf , ilbufmod , -1
+ lbuf(ilbuff+1) = lbuf(ilbuff)
+2 continue
+c
+c Get length of line from include file
+c
+ lenmodline = lenstr(lnholdq,128)
+ if (lenmodline .eq. 0) then
+c
+c Blank line. Make it a single blank with length 1
+c
+ lenmodline = 1
+ lnholdq = ' '
+ end if
+ lbuf(ilbufmod) = lenmodline
+ call printl(lnholdq(1:lenmodline))
+c
+c Insert new stuff into bufq
+c
+ bufq = bufq(1:ipbufmod)//lnholdq(1:lenmodline)//
+ * bufq(ipbufmod+1:lenbufmod)
+c
+c Update internal parameters
+c
+ ipbufmod = ipbufmod+lbuf(ilbufmod)
+ lenbufmod = lenbufmod+lbuf(ilbufmod)
+ nlbuf = nlbuf+1
+1 continue
+3 continue
+ call printl('Closing '//pmxmoddirq(1:lpmxmoddirq))
+ close(18)
+ linesinpmxmod = linesinpmxmod+ilbufmod-ilbuf
+ lenbuf0 = lenbufmod
+c
+c Fix Andre's error reporting problem 101211 leading to log(neg#) due
+c to nline being 2 bigger than it should be
+c
+ nline=nline-2
+c
+ return
+ end
+ subroutine getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
+ * xmtrnum0,npages,nsyst,musicsize,fracindent,istype0,
+ * inameq,clefq,sepsymq,pathnameq,lpath,isig0)
+ parameter (nm=24)
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ character*1 clefq(nm),sepsymq(nm),chax
+ character*40 pathnameq
+ character*79 inameq(nm)
+ character*128 lineq
+ logical istype0,newway,rename
+ common /commidisig/ midisig
+c
+c Get the first line
+c
+ iccount = 0
+9 call getbuf(lineq)
+ if (lineq(1:1) .eq. '%') go to 9
+ istype0 = lineq(1:3).eq.'---'
+ if (istype0) then
+c
+c Have TeX input until next line that starts with '---'. Save in scratch.
+c
+ open(17,status='SCRATCH')
+3 call getbuf(lineq)
+ if (lineq(1:3) .ne. '---') then
+ write(17,'(a)')lineq
+ go to 3
+ end if
+c
+c Force a new line read on first call to readin
+c
+ iccount = 128
+ end if
+c
+c Here, lineq is first line w/ numerical setup data.
+c
+ nv = nint(readin(lineq,iccount,nline))
+ noinst = nint(readin(lineq,iccount,nline))
+ newway = noinst.le.0
+ if (newway) noinst = -noinst
+ do 2 iinst = 1 , noinst
+c
+c Seve # of staves per inst in case later drop some inst's.
+c
+ if (newway) then
+c
+c Read in nvi for each instrument
+c
+ nsperi(iinst) = nint(readin(lineq,iccount,nline))
+ else if (iinst .gt. 1 ) then
+ nsperi(iinst) = 1
+ else
+ nsperi(iinst) = nv-noinst+1
+ end if
+ iiorig(iinst) = iinst
+ nspern(iinst) = nsperi(iinst)
+2 continue
+ mtrnuml = nint(readin(lineq,iccount,nline))
+ mtrdenl = nint(readin(lineq,iccount,nline))
+cc
+cc Kluge to make mtrdenl work
+cc
+c if (mtrdenl .eq. 1) then
+c mtrdenl = 2
+c mtrnuml = mtrnuml*2
+c end if
+ mtrnmp = nint(readin(lineq,iccount,nline))
+ mtrdnp = nint(readin(lineq,iccount,nline))
+ xmtrnum0 = readin(lineq,iccount,nline)
+c
+c Original key sig (before any trnasposition) in next position. Transposed
+c sig for topfile was transferred thru pmxtex.dat. Need isig0 for key
+c changes if transposed.
+c
+ isig0 = nint(readin(lineq,iccount,nline))
+c 130316
+c do 11 iinst = 1 , noinst
+c midisig(iinst) = isig0
+ midisig = isig0
+c11 continue
+ npages = nint(readin(lineq,iccount,nline))
+ nsyst = nint(readin(lineq,iccount,nline))
+ musicsize = nint(readin(lineq,iccount,nline))
+ fracindent = readin(lineq,iccount,nline)
+c
+c Next noinst non-comment lines are names of instruments.
+c
+ do 4 i = 1 , noinst
+5 call getbuf(inameq(i))
+ if (inameq(i)(1:1) .eq. '%') go to 5
+4 continue
+c
+c Next non-comment line has nv clef names
+c
+6 call getbuf(lineq)
+ if (lineq(1:1) .eq. '%') go to 6
+ iv = 0
+ nvsofar = 0
+ do 1 jinst = 1 , noinst
+ nvsofar = nvsofar+nsperi(jinst)
+ do 10 ivi = 1 , nsperi(jinst)
+ iv = iv+1
+ clefq(iv) = lineq(iv:iv)
+ if (iv .eq. nvsofar) then
+ sepsymq(iv) = '&'
+ else
+ sepsymq(iv) = '|'
+ end if
+10 continue
+1 continue
+c
+c Mext non-comment line has path name
+c
+8 call getbuf(pathnameq)
+ if (pathnameq(1:1) .eq. '%') go to 8
+ lpath = index(pathnameq,' ')-1
+12 ipos = index(pathnameq,chax(92))
+ if (ipos .gt. 0) then
+ pathnameq(ipos:ipos)=chax(47)
+ go to 12
+ end if
+ return
+ end
+ function getsquez(n,ntot,space,tnote,to)
+ real*4 tnote(600),to(600)
+ common /comtol/ tol
+c
+c Get the squez factor by checking space against tgovern=minimum duration
+c of all notes sounding at time of n-th note in the list.
+c The starting time of base increment is to(n) and ending time is to(n)+space
+c Sounding notes are those that start at or before to(n) .and. end at or
+c after tend=to(n)+space
+c Since notes are ordered by increasing start times, as soon as we find one
+c that starts too late, we are done checking.
+c
+ tgovern = 1000.
+ tend = to(n)+space
+ do 1 in = 1 , ntot
+c
+c Since to() is ordered by start times, exit loop after first note that
+c starts later than note of interest.
+c
+ if (to(in) .gt. to(n)+tol) go to 2
+ if (to(in)+tnote(in) .gt. tend-tol) then
+c
+c If here, this note overlaps and must be tested.
+c
+ tgovern = min(tgovern,tnote(in))
+ end if
+1 continue
+2 continue
+ getsquez = space/tgovern
+ return
+ end
+ subroutine getx(lineq,iccount,irest,shifton,wheadpt,iornq1,ivx,
+ * irest1,itsofar,ntup,itup,nnodur,dotq,ndoub)
+ parameter(nm=24)
+c
+c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol.
+c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols.
+c Since during getnote phase time is integer itsofar, which is not updated
+c during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if
+c not in xtup.
+c
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ logical shifton,colon,ess,number
+ character*128 lineq
+ character*1 charq,durq,dotq
+ colon = .false.
+ ess = .false.
+ number = .false.
+ nextbl = iccount+index(lineq(iccount:128),' ')-1
+ if (index(lineq(iccount:nextbl),'P') .gt. 0) then
+c
+c "Parts only", ignore entire symbol
+c
+ iccount = nextbl
+ return
+ end if
+1 call getchar(lineq,iccount,charq)
+ if (charq.eq.'B') then
+c
+c "Both parts and score," ignore character
+c
+ go to 1
+ else if (charq .eq. ':') then
+ colon = .true.
+ go to 1
+ else if (charq .eq. 'S') then
+ ess = .true.
+ go to 1
+ else if (index('+-.0123456789',charq) .gt. 0) then
+ number = .true.
+ if (charq.eq.'-') iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (charq .eq. '-') fnum = -fnum
+ if (durq .ne. 'p') then
+ fnum = fnum*wheadpt
+ iccount = iccount-1
+ end if
+ go to 1
+ end if
+c
+c charq must be blank, so done parsing
+c
+ if (.not.ess .and. .not.colon) then
+c
+c Ordinary hardspace. Goes before next note.
+c (Later, at "|" or "/", check for presence and switch to udoff if there!)
+c
+ nudsp = nudsp+1
+ iornq1 = ibset(iornq1,26)
+ udsp(nudsp) = fnum
+ tudsp(nudsp) = itsofar
+ if (ntup .gt. 0) tudsp(nudsp) = tudsp(nudsp)
+c * +float(itup-1)/ntup*ifnodur(nnodur,dotq)
+ * +float(itup-1+ndoub)/ntup*ifnodur(nnodur,dotq)
+ else if (.not.number) then
+c
+c Must be "X:" End a group offset.
+c
+ irest = ibset(irest,17)
+ shifton = .false.
+ return
+ else
+c
+c Only other possibility is start offset, "S" for single, ':' for multiple
+c
+ nudoff(ivx) = nudoff(ivx)+1
+ udoff(ivx,nudoff(ivx)) = fnum
+ if (ess) then
+ irest1 = ibset(irest1,15)
+ else
+ irest1 = ibset(irest1,16)
+ shifton = .true.
+ end if
+ end if
+ return
+ end
+ function i1fnodur(idur,dotq)
+ character*1 dotq
+ if (idur .eq. 6) then
+ i1fnodur=1
+ else if (idur .eq. 3) then
+ i1fnodur=2
+ else if (idur .eq. 1) then
+ i1fnodur=4
+ else if (idur .eq. 8) then
+ i1fnodur=8
+ else if (idur .eq. 4) then
+ i1fnodur=16
+ else if (idur .eq. 2) then
+ i1fnodur=32
+ else if (idur .eq. 0) then
+ i1fnodur=64
+ else if (idur .eq. 16) then
+c
+c Only used for denominator of time signatures, not for notes
+c
+ i1fnodur=4
+ else if (idur .eq. 9) then
+ i1fnodur = 128
+ else
+ print*
+ print*,'You entered an invalid note-length value:',idur
+ call stop1()
+ end if
+ if (dotq .eq. 'd') i1fnodur = i1fnodur*3/2
+ return
+ end
+c integer*4 function longi(ishort)
+c integer*2 ishort
+c longi = ishort
+c return
+c end
+ function iashft(nacc)
+ integer*4 ias(6)
+ data ias /-1,1,0,0,-2,2/
+ iashft = ias(nacc)
+ return
+ end
+ function ifnodur(idur,dotq)
+ character*1 dotq
+ if (idur .eq. 6) then
+ ifnodur=1
+ else if (idur .eq. 3)then
+ ifnodur=2
+ else if(idur .eq. 1) then
+ ifnodur=4
+ else if(idur .eq. 8) then
+ ifnodur=8
+ else if(idur .eq. 4) then
+ ifnodur=16
+ else if(idur .eq. 2) then
+ ifnodur=32
+ else if(idur .eq. 0) then
+ ifnodur=64
+ else if(idur .eq. 9) then
+ ifnodur=128
+ else if (idur .eq. 16) then
+c
+c Only used for denominator of time signatures, not for notes
+c
+ ifnodur=4
+ else
+ print*,'You entered an invalid note value'
+ stop
+ end if
+ if (dotq .eq. 'd') ifnodur = ifnodur*3/2
+ return
+ end
+ function ifnolev(noq,oct,ntrans)
+ character*1 noq
+ integer oct
+ ifnolev = 7*oct+mod(ichar(noq)-92,7)+1+ntrans
+ return
+ end
+c subroutine report(nsdat,isdat1,isdat2)
+c integer*4 isdat1(202),isdat2(202)
+c write(*,'(a)')
+c * ' isd on? iv kv ip id ud1 ud2 ndx ivo iho lev crd lhd rhd'
+c do 1 isdat = 1 , nsdat
+c isdata = isdat1(isdat)
+c ionoff = igetbits(isdata,1,11)
+cc iv = iand(7,isdata)
+c iv = igetbits(isdata,5,13)
+c kv = igetbits(isdata,1,12)+1
+c ip = igetbits(isdata,8,3)
+c idcode = igetbits(isdata,7,19)
+c iud1 = igetbits(isdata,1,26)
+c iud2 = igetbits(isdata,1,27)
+c ndxslur = igetbits(isdata,4,28)
+c isdatb = isdat2(isdat)
+c ivo = igetbits(isdatb,6,6)-32
+c iho = igetbits(isdatb,7,12)-64
+c lev = igetbits(isdatb,7,19)
+c icrd = igetbits(isdatb,1,0)
+c lhd = igetbits(isdatb,1,1)
+c irhd = igetbits(isdatb,7,2)
+c write(*,'(17i4)')isdat,ionoff,iv,kv,ip,idcode,iud1,iud2,ndxslur,
+c * ivo,iho,lev,icrd,lhd,irhd
+c1 continue
+c print*
+c return
+c end
+ function igetbits(isdata,iwidbit,ishift)
+c
+c Extracts integer given by iwidbit bits of isdata, shifted by ishift, and
+c then added to ioff
+c
+ igetbits = iand(2**iwidbit-1,ishft(isdata,-ishift))
+ return
+ end
+ function igetvarlen(mmidi,icm,imidi,nbytes)
+c
+c Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes.
+c
+ parameter (nm=24,mv=24576)
+ integer*2 mmidi(0:nm,mv)
+ igetvarlen = 0
+ do 1 nbytes = 1 , 4
+ mmidi4 = mmidi(icm,imidi+nbytes)
+ igetvarlen = 128*igetvarlen
+c * +iand(127,mmidi(icm,imidi+nbytes))
+ * +iand(127,mmidi4)
+c if (.not.btest(mmidi(icm,imidi+nbytes),7)) return
+ if (.not.btest(mmidi4,7)) return
+1 continue
+ print*,'Messup in igetvarlen'
+ call stop1()
+ end
+ logical function isdotted(nodur,ivx,ip)
+ parameter (nm=24)
+c
+c Function returns true if note is dotted or double-dotted.
+c Return false for any xtuplet.
+c
+ common /comtol/ tol
+ integer*4 nodur(nm,200)
+ if (nodur(ivx,ip) .eq. 0) then
+ isdotted = .false.
+ return
+ else if (ip .gt. 1) then
+ if (nodur(ivx,ip-1) .eq. 0) then
+ isdotted = .false.
+ return
+ end if
+ end if
+c
+c Ruled out all xtups, so is dotted or double-dotted if not a power of 2.
+c
+ isdotted =
+ * mod(alog(float(nodur(ivx,ip)))/.69314718+.5*tol,1.) .gt. tol
+ return
+ end
+ function isetvarlen(idur,nbytes)
+ isetvarlen = 0
+ itemp = idur
+ do 1 nbytes = 1 , 4
+ isetvarlen = isetvarlen + iand(itemp,127)*256**(nbytes-1)
+ itemp = ishft(itemp,-7)
+ if (itemp .gt. 0) then
+ isetvarlen = isetvarlen+2**(8*nbytes+7)
+ else
+ return
+ end if
+1 continue
+ print*,'Problem in fn. isetvarlen'
+ call stop1()
+ end
+ subroutine istring(i,string,len)
+c
+c Returns string with integer only if length is 1, otherwise enclosed in
+c brackets.
+c
+ character*(*) string
+ if (i .ne. 0) then
+ len = alog10(abs(i)*1.0001)+1
+ if (i .lt. 0) len = len+1
+ else
+ string = '0'
+ len = 1
+ return
+ end if
+ if (len .eq. 1) then
+ string = char(48+i)
+ else
+ string = '{'
+ write(string(2:1+len),'(i'//char(48+len)//')')i
+ string = string(1:len+1)//'}'
+ len = len+2
+ end if
+ return
+ end
+ function lenstr(string,n)
+ character*(*) string
+ do 1 lenstr = n , 1 , -1
+ if (string(lenstr:lenstr) .ne. ' ') return
+1 continue
+ lenstr = 0
+ return
+ end
+ function levrn(nolev,irest,iud,ncm,mult)
+c
+c Used for placing numbers in xtups. Returns note level if not a rest,
+c else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm.
+c
+ logical btest
+ if (.not.btest(irest,0)) then
+ levrn = nolev
+ else
+c
+c Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default.
+c
+ if (mult .gt. 0) then
+ if (mult .eq. 2) then
+ ioff = -1+2*iud
+ else if (mult .ne. 4) then
+ ioff = iud*mult
+ else
+ ioff = 1+4*iud
+ end if
+ else
+c
+c May need to futz with this later for non-beamed xtups (quarter, half rests)
+c
+ ioff = iud*2
+ end if
+ levrn = mod(nolev+20,100)-20+ncm+ioff
+ endif
+ return
+ end
+ function lfmt1(x)
+c
+c Computes total length of an "f" format with one decimal place.
+c First round to nearest 0.1
+c
+ if (abs(x) .lt. .001) then
+ lfmt1 = 2
+ else
+ y = sign(.1*int(10*abs(x)+.5),x)
+ lfmt1 = int(log10(1000*abs(y)+.001))
+ if (y .lt. 0) lfmt1 = lfmt1+1
+ end if
+ return
+ end
+ subroutine LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
+ * ispstie,sepsymq)
+ parameter (nm=24)
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /comoct/ noctup
+ integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
+ logical fontslur,WrotePsslurDefaults,btest,upslur,ispstie,tie
+ character*1 udq,chax,sepsymq(nm)
+ character*8 noteq
+ character*128 notexq
+c
+c This is called twice from pmxb after having input an entire block, before
+c making a bar that starts a new system. So nsdat reflects all slur starts
+c and stops in new block, while listslur, which is only set when bars are
+c made, reflects only open slurs from the old block. So we must check
+c listslur to find open ties, not all nsdat.
+c First of two calls (ispstie=.false. on entry) terminates tie at end of line.
+c Second (ispstie=.true. on entry) restarts tie at start of new line. Only
+c need data from original tie-start for both of these. Tie/slur data from
+c closing of full tie are not used except for shape alterations.
+c
+c do 1 ndx = 0 , 11
+ do 1 ndx = 0 , 23
+ if (btest(listslur,ndx)) then
+c
+c Slur or tie with index ndx is open. Find the one with right ndxb, see if tie
+c
+ do 2 isdat = 1 , nsdat
+c if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index
+ if (igetbits(isdat1(isdat),4,28)
+ * +16*igetbits(isdat1(isdat),1,18) .ne. ndx) go to 2 ! Wrong index
+ if (.not.btest(isdat1(isdat),11)) go to 2 ! Bypass if stop
+ if (btest(isdat2(isdat),3)) go to 3 ! "st"
+ idcode = igetbits(isdat1(isdat),7,19)
+ if (idcode.eq.1) go to 3 ! "t"
+ tie = .false.
+ go to 5
+2 continue
+ end if
+ go to 1
+3 continue
+ tie = .true.
+5 continue
+c
+c A slur or tie is open, with index ndx
+c
+ iv = igetbits(isdat1(isdat),5,13)
+ kv = igetbits(isdat1(isdat),1,12)+1
+ udq = 'd'
+ if (btest(isdat1(isdat),27)) udq='u'
+ notexq = chax(92)//'znotes'
+ lnote = 7
+ do 4 iiv = 1 , iv-1
+ notexq = notexq(1:lnote)//sepsymq(iiv)
+ lnote = lnote+1
+4 continue
+ if (kv .eq. 2) then
+ notexq = notexq(1:lnote)//chax(92)//'nextvoice'
+ lnote = lnote+10
+ end if
+c
+c Compute horiz and vert offsets
+c
+c nolev = igetbits(isdat2(isdat),7,19)
+ islhgt = igetbits(isdat3(isdat),8,14)
+ ilb12 = 0
+ if (ispstie) ilb12 = 1
+ ivoff = igetbits(isdat4(isdat),6,ilb12*16)-32
+ if (ivoff .eq. -32) ivoff = 0
+C nolev = nolev+ivoff
+ islhgt = islhgt+ivoff
+ ihoff = (igetbits(isdat4(isdat),7,ilb12*16+6)-64) ! This is 10X hoff
+ if (ihoff .eq. -64) ihoff = 0
+c
+c Add starting stuff for command
+c
+ if (.not.ispstie) then ! End 1st segment
+ notexq = notexq(1:lnote)//chax(92)//'roffset{'
+ lnote = lnote+9
+c hoff = ihoff*.1-.5
+c hoff = ihoff*.1-.8
+ hoff = ihoff*.1-.4
+ if (hoff .lt. 0) then
+ hoff = -hoff
+ notexq = notexq(1:lnote)//'-'
+ lnote = lnote+1
+ end if
+ call writflot(hoff,notexq,lnote)
+ notexq = notexq(1:lnote)//'}{'
+ lnote = lnote+2
+ else
+ notexq = notexq(1:lnote)//chax(92)//'off{-'
+ * //chax(92)//'afterruleskip}'
+ lnote = lnote+21
+c
+c 091025 add dotting for 2nd segment if needed
+c
+ if (btest(isdat2(isdat),4)) then
+ notexq = chax(92)//'dotted'//notexq(1:lnote)
+ lnote = lnote+7
+ end if
+ end if
+ if (ispstie .and. tie) then
+ notexq = notexq(1:lnote)//chax(92)//'tieforis'//udq
+ lnote = lnote+10
+ end if
+ if (btest(isdat3(isdat),0)) then
+c
+c Curvature tweak on termination of 1st seg
+c
+ imid = igetbits(isdat3(isdat),6,2)-32
+c
+c Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping:
+c Abs(imid) Postscript slur type
+c 1 f
+c 4 h
+c 5 H
+c 6 HH
+c
+ notexq = notexq(1:lnote)//chax(92)//'psforts'//chax(48+imid)
+ lnote = lnote+9
+c
+c Zero out the flag in case there's a different curv on term of 2nd,
+c
+ isdat3(isdat) = ibclr(isdat3(isdat),0)
+ end if
+c
+c Add the command name
+c
+ if (ispstie) then
+ notexq = notexq(1:lnote)//chax(92)//'is'//udq
+ lnote = lnote+4
+ else if (tie) then
+ notexq = notexq(1:lnote)//chax(92)//'ttie'
+ lnote = lnote+5
+ else
+ notexq = notexq(1:lnote)//chax(92)//'tslur'
+ lnote = lnote+6
+ end if
+c
+c Add index
+c
+c if (11-ndx .lt. 10) then
+c notexq = notexq(1:lnote)//chax(59-ndx)
+c lnote = lnote+1
+c else
+c notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}'
+c lnote = lnote+4
+c end if
+ if (23-ndx .lt. 10) then
+ notexq = notexq(1:lnote)//chax(71-ndx)
+ lnote = lnote+1
+ else if (23-ndx .lt. 20) then
+ notexq = notexq(1:lnote)//'{1'//chax(61-ndx)//'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//'{2'//chax(51-ndx)//'}'
+ lnote = lnote+4
+ end if
+ if (ispstie .or. .not.tie) then
+c
+c Add note name for slur height
+c
+ noctup = 0
+ ncm = igetbits(isdat3(isdat),8,22)
+ if (ncm .eq. 23) noctup = -2
+c call notefq(noteq,lnoten,nolev,ncm)
+ call notefq(noteq,lnoten,islhgt,ncm)
+ notexq = notexq(1:lnote)//'{'//noteq(1:lnoten)//'}'
+ lnote = lnote+1+lnoten+1
+ end if
+ if (ispstie) then
+c
+c Horizontal shift start of new thing
+c
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+c ihoff = ihoff-13
+ if (tie) then
+ ihoff = ihoff-12
+ else
+ ihoff = ihoff-7
+ end if
+ if (ihoff .lt. 0) then
+ ihoff = -ihoff
+ notexq = notexq(1:lnote)//'-'
+ lnote = lnote+1
+ end if
+ call writflot(ihoff*.1,notexq,lnote)
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+c
+c Add closing stuff
+c
+ if (ispstie) then
+ notexq = notexq(1:lnote)//chax(92)//'off{'
+ * //chax(92)//'afterruleskip}'
+ lnote = lnote+20
+ else
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ notexq = notexq(1:lnote)//chax(92)//'en%'
+ lnote = lnote+4
+ write(11,'(a)')notexq(1:lnote)
+1 continue
+ ispstie = .not.ispstie
+ return
+ end
+ subroutine littex(islur,nnl,iv,topmods,lineq,iccount)
+ parameter (nm=24)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink
+ integer islur(nm,200)
+ logical topmods
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg,merge
+ character*128 lineq,litq
+ character*20 voltxtq
+ character*1 durq,chax
+ merge = .false.
+ if (nlit .gt. 0) then
+ merge = iv.eq.ivlit(nlit) .and. nnl.eq.iplit(nlit)
+ end if
+ nlit = nlit+1
+ ivlit(nlit) = iv
+ iplit(nlit) = nnl
+ itype = 1
+17 call getchar(lineq,iccount,durq)
+ if (durq .eq. chax(92)) then
+ itype=itype+1
+ go to 17
+ end if
+ litq(nlit) = chax(92)//durq
+ lenlit(nlit) = 2
+18 call getchar(lineq,iccount,durq)
+ if (durq.eq.chax(92)) then
+ call getchar(lineq,iccount,durq)
+ if (durq .ne. ' ') then
+c
+c Starting a new tex command within the string
+c
+ litq(nlit) = litq(nlit)(1:lenlit(nlit))//chax(92)//durq
+ lenlit(nlit) = lenlit(nlit)+2
+ go to 18
+ end if
+ else
+ litq(nlit) = litq(nlit)(1:lenlit(nlit))//durq
+ lenlit(nlit) = lenlit(nlit)+1
+ go to 18
+ end if
+c
+c If here, just read backslash-blank so string is done
+c
+ if (itype .eq. 1) then
+ islur(iv,nnl) = ibset(islur(iv,nnl),16)
+ if (merge) then
+c
+c There are 2 separate strings on the same note, so merge them.
+c
+ nlit = nlit-1
+ litq(nlit) = litq(nlit)(1:lenlit(nlit))
+ * //litq(nlit+1)(1:lenlit(nlit+1))
+ lenlit(nlit) = lenlit(nlit)+lenlit(nlit+1)
+ if (lenlit(nlit) .gt. 128) then
+ print*
+ print*,
+ * 'Merged type-1 TeX strings longer than 128 characters'
+ write(15,'(/,a)')
+ * 'Merged type-1 TeX strings longer than 128 characters'
+ call stop1()
+ end if
+ end if
+ else
+c
+c Type 2 or 3.
+c
+ if (itype .eq. 3) then
+c
+c Write the string NOW
+c
+ if (islast)
+ * write(11,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
+ else
+c
+c Must go at top
+c
+ if (.not.topmods) then
+ topmods = .true.
+ open(16,status='SCRATCH')
+ end if
+c
+c Must write '%' here rather than later, in case string ends with blank.
+c
+ write(16,'(a)')litq(nlit)(1:lenlit(nlit))//'%'
+ end if
+ nlit = nlit-1
+ end if
+ return
+ end
+ function llen(strq,n)
+ character*129 strq
+ do 1 llen = n , 0 , -1
+ if (strq(llen:llen) .ne. ' ') return
+1 continue
+ end
+ function log2(n)
+c
+c 5/25/08 Modify to allow more slurs
+c
+c log2 = alog(1.*n)/0.6931472+.0001
+c log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0
+ log2 = dlog(1.d0*n)/0.693147181d0+.00000002d0
+ return
+ end
+ subroutine logbeam(numnew,nip1,nip2)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ character*1 ulq,sepsymq,sq,ulfq,ulfbq
+ logical beamon,firstgulp,figbass,figchk,isfig,isxtup,btest,
+ * autofbon
+ ibm1(ivx,numnew) = nip1
+ ibm2(ivx,numnew) = nip2
+ numnow = numnew
+ if (numnew .gt. 1) then
+c
+c If it starts before any others, must put it in order
+c
+ do 11 ib = numnew-1 , 1 , -1
+ if (ibm1(ivx,ib) .lt. nip1) go to 12
+ ibm1(ivx,ib+1) = ibm1(ivx,ib)
+ ibm2(ivx,ib+1) = ibm2(ivx,ib)
+ ulq(ivx,ib+1) = ulq(ivx,ib)
+ ibm1(ivx,ib) = nip1
+ ibm2(ivx,ib) = nip2
+ numnow = ib
+11 continue
+12 continue
+ end if
+ sum = 0.
+c
+c Beam has non-xtup within
+c
+ nrests = 0
+ isxtup = .false.
+ do 9 iip = nip1 , nip2
+ if (btest(islur(ivx,nip1),21)) then
+c
+c Forced multiplicity
+c
+ call setbits(mult(ivx,iip),4,0,
+ * igetbits(islur(ivx,nip1),3,22)+8)
+ else if (.not.isxtup) then
+ if (nodur(ivx,iip) .gt. 0) then
+ call setbits(mult(ivx,iip),4,0,4-log2(nodur(ivx,iip))+8)
+ else
+c
+c Start xtup within forced beam
+c
+ isxtup = .true.
+ iip1 = iip
+ end if
+ else if (isxtup .and. nodur(ivx,iip).gt.0) then
+c
+c End of xtup within forced beam. Must count doubled notes
+c
+ ndoub = 0
+ do 1 iiip = iip1 , iip
+ if (btest(nacc(ivx,iiip),18)) ndoub = ndoub+1
+1 continue
+ multx = int(10.5+2.929+(0.952*alog(1.+iip-iip1+ndoub)-
+ * alog(nodur(ivx,iip)/2.))/0.69315)-10
+ do 74 iiip = iip1 , iip
+ call setbits(mult(ivx,iiip),4,0,multx+8)
+c
+c Note the following still works after making mult only the 1st 4 bits.
+c
+ if (btest(nacc(ivx,iiip),18))
+ * mult(ivx,iiip) = mult(ivx,iiip)-1
+ if (btest(nacc(ivx,iiip),19)) then
+ mult(ivx,iiip) = mult(ivx,iiip)+1
+ else if (iiip .gt. 1) then
+ if (btest(nacc(ivx,iiip-1),19))
+ * mult(ivx,iiip) = mult(ivx,iiip)+1
+ end if
+74 continue
+ isxtup = .false.
+ end if
+ if (btest(irest(ivx,iip),0)) then
+ nrests = nrests+1
+ else
+ sum = sum+nolev(ivx,iip)
+ end if
+9 continue
+c
+c Set beam up-down-ness
+c
+ if (ifb.gt.0 .and. ulfbq(ivx,max(1,ifb)).ne.'x') then
+ if (ulfbq(ivx,ifb) .eq. 'f') then
+c
+c Get default, then trade "l" and "u"
+c
+ ulq(ivx,numnow) = char(225-ichar(
+ * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))))
+ else
+ ulq(ivx,ifb) = ulfbq(ivx,ifb)
+ end if
+c
+c This probably works only because forced beams are done first, so they
+c don't have to be re-sorted within each voice. ????
+c
+ else if (nvmx(iv) .eq. 2) then
+c
+c Multi-voice per staff
+c
+ if (ivx .le. nv) then
+ ulq(ivx,numnow) = 'l'
+ else
+ ulq(ivx,numnow) = 'u'
+ end if
+ else
+c
+c Defaults
+c
+ ulq(ivx,numnow) =
+ * ulfq(sum/(nip2-nip1+1-nrests),ncmid(iv,nip1))
+ end if
+ return
+ end
+ subroutine m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
+c
+c This is called when (a) macro recording is just starting and
+c (b) at the start of a new line, if recording is on
+c
+ parameter (maxblks=9600)
+ character*128 lineq,lnholdq
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
+ * ic1mac(20),ilmac,iplmac
+ logical mrecord,mplay,endmac
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ lbuf(1) = lbuf(1)
+ if (.not.mrecord) then
+c
+c Starting the macro
+c
+ ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
+ il1mac(macnum) = ilbuf-1
+ ic1mac(macnum) = iccount
+ mrecord = .true.
+ end if
+ if (iccount .lt. 128) then
+ ndxm = index(lineq(iccount+1:128),'M')
+ if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
+ * 128-iccount)
+ if (ndxm .gt. 0) then
+c
+c This line ends the macro.
+c
+ if (lineq(iccount+ndxm+1:iccount+ndxm+1) .ne. ' ') then
+ call errmsg(lineq,iccount+ndxm+1,ibarcnt-ibaroff+nbars+1,
+ * 'Improper macro termination!')
+ call stop1()
+ end if
+ ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
+ il2mac(macnum) = ilbuf-1
+ mrecord = .false.
+ end if
+ end if
+ return
+ end
+ subroutine make1bar(ibmrep,tglp1,tstart,cwrest,squez,
+ * istop,numbms,istart)
+ parameter (nm=24,mv=24576)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ character*10 figq
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig,bar1syst
+ common /comeskz2/ eskz2(nm,200)
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ common /combeam/ ibmtyp
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comas2/ nasksys,wasksys(800),elasksys(800)
+ common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ common /comsln/ is1n1,is2n1,irzbnd,isnx
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg,autofbon
+ character*128 litq
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ integer cnn(nm),istart(80),istop(80),nxtnow(nm),ifbnow(nm),
+ * numbms(nm),mapfb(24)
+ real*4 xit(nm),t1xtup(20),tstart(80),squez(80)
+ character*1 ulfbq
+ character*79 inameq
+ character*20 voltxtq
+ common /comoct/ noctup
+ character*80 headrq,lowerq
+ logical cwrferm
+ common /comcwrf/ cwrferm(nm)
+ common /comnsp/ space(80),nb,prevtn(nm),
+ * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
+ logical lower,cwrest(nm),vxtup,flgndb,btest,upslur,
+ * infbmx(nm),lowdot,inxtup(nm),drawbm
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /comstart/ facmtr
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+c
+c Above are factors for grace note, clef spacing. (fraction of wheadpt)
+c In 1.04, moved to block data subprogram
+c
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /comtol/ tol
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur,
+ * WrotePsslurDefaults
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /comntot/ ntot
+ if (ismidi) then
+c
+c Initialize for this bar the accidental counter for the midi file.
+c naccim(icm) = # of accidentals from earlier in the bar
+c
+ do 45 iv = 1 , nv
+ do 4599 kv = 1 , nvmx(iv)
+ naccim(midchan(iv,kv)) = 0
+4599 continue
+45 continue
+ end if
+c
+c Time from start of gulp to end of bar, used with forced beams
+c
+ tglp2 = lenb0+ibar*lenb1
+ if (lenb0 .gt. 0) tglp2 = tglp2-lenb1
+ tglp1 = tglp2-lenbar
+c
+c infbmx will only be true if in xtup that is NOT in explicit forced beam.
+c
+ do 1 iv = 1 , nv
+ do 1999 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ cwrest(ivx) = .false.
+ infbmx(ivx) = .false.
+ inxtup(ivx) = .false.
+ if (ibar .gt. 1) then
+ nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
+ else
+ nn(ivx) = nib(ivx,ibar)
+ end if
+1999 continue
+1 continue
+c
+c initialize list note counter, time(iv), curr. note(iv). The loop to 4
+c ONLY initializes each voice.
+c
+ in = 1
+ nxtup = 0
+ narp = 0
+ do 4 iv = 1 , nv
+ do 4999 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ cwrferm(ivx) = .false.
+ cnn(ivx) = 1
+ ivxo(in) = ivx
+ ipo(in) = cnn(ivx)
+ tnote(in) = fnote(nodur,ivx,1,nacc)
+ to(in) = 0.
+ xit(ivx) = tnote(in)
+c
+c Note that xit(ivx) is to END of note in voice, but it1xtup is start time.
+c
+ if (nodur(ivx,ipo(in)) .eq. 0) then
+c
+c First note of xtuplet at start of bar in voice ivx.
+c
+ nxtup = nxtup+1
+ nxtnow(ivx) = nxtup
+ inxtup(ivx) = .true.
+ t1xtup(nxtup) = 0.
+c
+c Xtup at start of bar. If no explicit forced beam, start one, set
+c signal infbmx, and save number ifbnow for use at termination.
+c
+ if (nfb(ivx) .gt. 0) then
+ do 60 ifb = 1 , nfb(ivx)
+ if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
+c
+c No explicit fb here; so exit loop and insert one.
+c
+ go to 61
+ else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
+ * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
+c
+c IS explicit fb here; must NOT insert one
+c
+ go to 62
+ end if
+60 continue
+ end if
+61 continue
+c
+c If here, xtup isn't in explicit fb, so must insert one
+c
+ infbmx(ivx) = .true.
+ call addfb(nfb,ivx,t1xtup(nxtup)+
+ * tglp1,t1fb,t2fb,ulfbq,ifbadd)
+ ifbnow(ivx) = ifbadd
+ end if
+62 continue
+ if (abs(xit(ivx)-lenbar) .lt. tol) xit(ivx) = 1000.
+ in = in+1
+4999 continue
+4 continue
+c
+c Build the list: This is a manual loop starting at 5
+c
+5 continue
+c
+c Determine which voice comes next from end of notes done so far.
+c tmin is the earliest ending time of notes done so far
+c
+ tmin = 1000.
+ do 6 iiv = 1 , nv
+ do 6999 kv = 1 , nvmx(iiv)
+ iivx = ivmx(iiv,kv)
+ tminn = min(tmin,xit(iivx))
+ if(tminn .lt. tmin-tol) then
+ tmin = tminn
+ ivx = iivx
+ end if
+6999 continue
+6 continue
+ if (abs(tmin-1000.) .lt. tol) go to 7
+ ivxo(in) = ivx
+ cnn(ivx) = cnn(ivx)+1
+ ipo(in) = cnn(ivx)
+ to(in) = tmin
+c
+c Check if this voice is done
+c
+ tnote(in) = fnote(nodur,ivx,cnn(ivx),nacc)
+ if (cnn(ivx) .eq. nn(ivx)) then
+ xit(ivx) = 1000.
+ else
+ xit(ivx) = xit(ivx)+tnote(in)
+ end if
+c
+c Flag xtups
+c
+ if (nodur(ivx,cnn(ivx)) .eq. 0) then
+ if (.not.inxtup(ivx)) then
+c
+c First note of xtup, not at start of bar.
+c
+ nxtup = nxtup+1
+ nxtnow(ivx) = nxtup
+ inxtup(ivx) = .true.
+ t1xtup(nxtup) = xit(ivx)-tnote(in)
+c
+c (Note: can't be on last note in voice, so xit(ivx) <> 1000)
+c Put xtuplet in a forced beam if not already in forced beam
+c
+ if (nfb(ivx) .gt. 0) then
+ do 70 ifb = 1 , nfb(ivx)
+ if (t1fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
+c
+c NO explicit bm; put one in
+c
+ go to 71
+ else if (t1fb(ivx,ifb) .lt. tglp1+xit(ivx)+tol .and.
+ * t2fb(ivx,ifb) .gt. tglp1+xit(ivx)+tol) then
+c
+c IS explicit bm. Don't put one
+c
+ go to 72
+ end if
+70 continue
+ end if
+71 continue
+c
+c If here, no explicit bm, so put one in
+c
+ infbmx(ivx) = .true.
+ call addfb(nfb,ivx,t1xtup(nxtup)+tglp1,
+ * t1fb,t2fb,ulfbq,ifbadd)
+ ifbnow(ivx) = ifbadd
+ end if
+72 continue
+ else if (inxtup(ivx)) then
+c
+c This test is sufficient because already know nodur>0
+c
+ inxtup(ivx) = .false.
+ if (infbmx(ivx)) then
+c
+c Xtup is in auto-forced beam, so end it
+c
+ t2fb(ivx,ifbnow(ivx)) =
+ * t1xtup(nxtnow(ivx))+nodur(ivx,cnn(ivx))+tglp1
+ infbmx(ivx) = .false.
+ end if
+ end if
+ if (btest(irest(ivxo(in),ipo(in)),24) .or.
+ * btest(irest(ivxo(in),ipo(in)),30)) then
+c
+c For staff jumped beam, flag the first note (lowest voice) at same time.
+c Later will start new notes group here.
+c
+ inj = in
+ if (ivxo(in) .gt. 1) then
+ do 40 iin = in-1 , 1 , -1
+ if (to(iin)+tol .lt. to(in)) go to 41
+ if (abs(to(iin)-to(in)) .lt. tol) then
+ inj = iin
+ go to 40
+ end if
+40 continue
+ end if
+41 continue
+ irest(ivxo(inj),ipo(inj)) = ibset(irest(ivxo(inj),ipo(inj)),29)
+ end if
+ in = in+1
+ go to 5
+7 continue
+ ntot = in-1
+ do 8 in = 1 , ntot-1
+ tno(in) = to(in+1)-to(in)
+8 continue
+ tno(ntot) = tnote(ntot)
+c
+c Debug writes
+c
+c write(*,'()')
+c write(*,'(a)')' Greetings from PMXB'
+c write(*,'(16i5)')(ivxo(in),in=1,ntot)
+c write(*,'(16i5)')(ipo(in),in=1,ntot)
+c write(*,'(16f5.1)')(to(in),in=1,ntot)
+c write(*,'(16f5.1)')(tno(in),in=1,ntot)
+c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
+c write(*,'(16f5.1)')(fnote(nodur,ivxo(in),ipo(in),nacc),in=1,ntot)
+c
+c Done w/ list. Loop for parsing into note blocks:
+c
+ ib = 1
+ istart(1) = 1
+ space(1) = 0.
+ in = 1
+c
+c A manual loop to set space(ib) and istop(ib)
+c
+9 continue
+
+ ivx = ivxo(min(in+1,ntot))
+ ip = ipo(min(in+1,ntot))
+ isl = islur(ivx,ip)
+ if (in.eq.ntot .or. ((ivx.eq.1 .and.
+ * (iand(isl,67109216).gt.0 .or. btest(ipl(1,ip),28)
+c * .or. ornq(1,ip).eq.'g')) .or. btest(isl,15) )) then
+c Bits 1-13: stmgx+Tupf._)
+c 14: Down fermata, was F
+c 15: Trill w/o "tr", was U
+ * .or. btest(iornq(1,ip),4))) .or. btest(isl,15) )
+c
+c Checking for start of 2nd part of jumped beam
+c
+ * .or. btest(irest(ivx,ip),29) ) then
+c
+c Bar end, segno, int. rpt or sig change, clef,end of 1st part of jumped beam;
+c flow out of if-loop and into block-wrapup
+c
+c 10/18/97: Problem with clef alignment. Got isl{15} set on lowest-numbered
+c voice, but it wasn't first in the list at the same time. So check if
+c prior notes in list have same time
+c 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef
+c changes on last note in the list?
+c
+ if (btest(isl,15) .and. in.lt.ntot) then
+ do 50 iin = in , 1 , -1
+ if (tno(iin) .gt. tol) then
+ in = iin
+ islur(ivx,ip) = ibclr(islur(ivx,ip),15)
+ islur(ivxo(in+1),ipo(in+1)) =
+ * ibset(islur(ivxo(in+1),ipo(in+1)),15)
+ go to 51
+ end if
+50 continue
+51 continue
+ end if
+ if (space(ib) .lt. tol) then
+ space(ib) = tno(in)
+ squez(ib) = 1.
+ end if
+ istop(ib) = in
+ else if (space(ib) .lt. tol) then
+c
+c space hasn't been set yet, so tentatively set:
+c
+ space(ib) = tno(in)
+ if (space(ib) .lt. tol) then
+ in=in+1
+ else
+ squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
+ istop(ib) = in
+ end if
+ go to 9
+ else if (tno(in+1) .lt. tol) then
+c
+c This is not the last note in the group, so
+c
+ in = in+1
+ go to 9
+ else if (abs(tno(in+1)-space(ib)) .lt. tol) then
+ xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
+ if (abs(xsquez-squez(ib)) .lt. tol) then
+c
+c Keep spacing the same, update tentative stop point
+c
+ in = in+1
+ istop(ib) = in
+ go to 9
+ end if
+ end if
+c
+c At this point istart and istop are good, so finalize block
+c
+ tstart(ib) = to(istart(ib))
+ if (istop(ib) .eq. ntot) go to 15
+ ib = ib+1
+ istart(ib) = istop(ib-1)+1
+ in = istart(ib)
+c
+c Set tentative block space and squeeze-factor for upcoming block
+c
+ space(ib) = tno(in)
+ if (space(ib).gt.tol)
+ * squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
+ istop(ib) = in
+ go to 9
+15 continue
+ nb = ib
+c
+c Invert the list of places into ipl(0-7), making it easier to analyze a voice
+c
+ do 13 in = 1 , ntot
+c
+c ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes.
+c
+c ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in)
+ ipl2(ivxo(in),ipo(in)) = in
+13 continue
+c
+c Compute elemskips from start of bar to each note in the bar, for beam slopes
+c
+ eskzb = 0.
+ ib = 1
+ do 30 in = 1 , ntot
+ if (in .eq. istart(ib)) then
+ deskb = squez(ib)*feon(space(ib)/squez(ib))
+ else if (tno(in-1) .gt. tol) then
+ eskzb = eskzb+deskb
+ end if
+ eskz(ivxo(in),ipo(in)) = eskzb
+ eskz2(ivxo(in),ipo(in)) = eskzb
+ if (in .eq. istop(ib)) then
+ eskzb = eskzb+deskb
+ ib = ib+1
+ end if
+30 continue
+c
+c Analyze for beams.
+c
+ do 20 iv = 1 , nv
+ do 2099 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ numbms(ivx) = 0
+ mapfb(1) = 0
+ mapfb(2) = 0
+ mapfb(3) = 0
+ mapfb(4) = 0
+ mapfb(5) = 0
+ mapfb(6) = 0
+c
+c First forced beams.
+c
+ if (nfb(ivx) .gt. 0) then
+c
+c tglp2 is time from start of gulp to end of current bar.
+c
+ nfbbar = 0
+ do 80 ifb = 1 , nfb(ivx)
+ if (t1fb(ivx,ifb).gt.tglp2-tol) go to 81
+ nfbbar = nfbbar+1
+ numbms(ivx) = numbms(ivx)+1
+ numnew = numbms(ivx)
+c
+c Times from beginning of bar
+c
+ itbb1 = int(t1fb(ivx,ifb)-tglp1+tol)
+ itbb2 = int(t2fb(ivx,ifb)-tglp1+tol)
+ do 83 ip = 1 , nn(ivx)
+ if (int(to(ipl2(ivx,ip))+tol) .eq. itbb1) then
+ nip1fb = ip
+ do 84 ip1 = ip , nn(ivx)
+ inip1 = ipl2(ivx,ip1)
+ if (abs(to(inip1)+tnote(inip1)-itbb2) .lt. tol) then
+ nip2fb = ip1
+ itbb3 = itbb2-2
+ go to 85
+ end if
+84 continue
+ end if
+83 continue
+ print*
+ print*,'Timing problem w/ forced beams'
+ write(15,'(/a)')'Timing problem w/ forced beams'
+85 continue
+ call logbeam(numnew,nip1fb,nip2fb)
+c
+c Set up mapfb for forced beam just logged:
+c
+ ib1 = itbb1/2
+ ib2 = itbb3/2
+ ibrep = lenbar/ibmrep/2
+ do 86 irep = 1 , ibmrep
+ ib1now = max(0,ib1-(irep-1)*ibrep)
+ ib2now = min(irep*ibrep-1,ib2-(irep-1)*ibrep)
+ mapnow = 0
+ do 87 ib = ib1now , ib2now
+ mapnow = ibset(mapnow,ib)
+87 continue
+ mapfb(irep) = ior(mapfb(irep),mapnow)
+86 continue
+c
+c Since we are cycling thru forced beams, for those that start with a rest and
+c have height & slope adjustments, move adjustments to next note.
+c 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at
+c start of beam
+c
+ if (btest(irest(ivx,nip1fb),0)) then
+ do 88 kp = nip1fb+1 , nip2fb
+ call setbits(ipl(ivx,kp),6,11,
+ * igetbits(ipl(ivx,nip1fb),6,11))
+ call setbits(ipl(ivx,kp),6,17,
+ * igetbits(ipl(ivx,nip1fb),6,17))
+ call setbits(islur(ivx,kp),2,27,
+ * igetbits(islur(ivx,nip1fb),2,27))
+88 continue
+ end if
+80 continue
+81 continue
+c
+c Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar.
+c Remember, makeabar is called 1/bar, and it calls findbeam once per voice.
+c
+ if (nfbbar .gt. 0) then
+ nfb(ivx) = nfb(ivx)-nfbbar
+ do 82 ifb = 1 , nfb(ivx)
+ t1fb(ivx,ifb) = t1fb(ivx,ifb+nfbbar)
+ t2fb(ivx,ifb) = t2fb(ivx,ifb+nfbbar)
+ ulfbq(ivx,ifb) = ulfbq(ivx,ifb+nfbbar)
+82 continue
+ end if
+ end if
+ ifb = 0
+c
+c Done with forced beam masks for this bar and voice. Now get normal beams.
+c
+ call findbeam(ibmrep,numbms,mapfb)
+2099 continue
+20 continue
+ return
+ end
+ subroutine make2bar(ninow,tglp1,tstart,cwrest,squez,
+ * istop,numbms,istart,clefq)
+ parameter (nm=24,mv=24576)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ character*10 figq
+ character*1 ulq,sepsymq,sq,chax
+ logical beamon,firstgulp,figbass,figchk,isfig,bar1syst,isbjmp,
+ * isbj2
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ common /combeam/ ibmtyp
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comas2/ nasksys,wasksys(800),elasksys(800)
+ common /comhead/ ihdht,lower,headrq,lowerq,ihdvrt
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ common /comsln/ is1n1,is2n1,irzbnd,isnx
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg,issig,rpndot,autofbon
+ character*128 litq
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ integer istart(80),istop(80),iaskb(nm),numbms(nm),
+ * nornb(nm),ihornb(nm,24),lcwr(nm),ibmcnt1(nm),ifig(2)
+ character*1 ulfbq,udqq,clefq(nm),slurudq,udq
+ character*8 noteq
+ character*79 cwrq(nm),notexq,inameq
+ character*20 voltxtq
+ common /comoct/ noctup
+ character*80 soutq,headrq,lowerq
+ common /comnsp/ space(80),nb,prevtn(nm),
+ * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
+ logical bspend,lower,cwrest(nm),vxtup,
+ * isgrace,isclef,nofirst,iscln,isdot,isflag,
+ * isacc,isfirst,flgndb,btest,stemup,upslur,
+ * isgaft,isarp,isrshft,isaccs,iscacc,
+ * lowdot,flipend,iscwr,isdotted,beamon1(nm)
+ real*4 ptgr(37),ptclef(nm),ptsndg(nm),eskndg(nm),tstart(80),
+ * squez(80)
+ logical cwrferm,drawbm
+ common /comcwrf/ cwrferm(nm)
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xelsk(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /comstart/ facmtr
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+c
+c Factors for grace note, clef spacing. (fraction of wheadpt)
+c In 1.04, moved to block data subprogram
+c
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
+ common /comtol/ tol
+ common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
+ logical ignorenats,newmbrhgt
+ integer*2 mmidi,iinsiv
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc,fontslur
+ * ,WrotePsslurDefaults
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ logical slmon,dbltie
+ common /comslm/ levson(0:nm),levsoff(0:nm),imidso(0:nm),
+ * naccbl(0:nm),laccbl(0:nm,10),jaccbl(0:nm,10),nusebl,
+ * slmon(0:nm),dbltie
+ common /comevent/ miditime,lasttime
+ logical kbdrests
+ common /comkbdrests/ levbotr(8),levtopr(8),kbdrests
+ logical secondgrace
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /commidisig/ midisig
+c 130316
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+ common /comclefrests/ centrests
+ logical centrests
+ common /xjbeambrests/ nbrests
+ common /comc8flag/ c8flag(nm)
+ logical c8flag
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ character*4 ivxq
+ logical rename
+ common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
+ * poefa
+ real*4 poefa(125)
+ logical nocodabn
+ nbrests = 0
+c
+c Set up main ib loop within which a block (notes group) is written
+c
+ do 25 iv = 1 , nv
+ do 2599 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ ibmcnt(ivx) = 1
+ ibmcnt1(ivx) = 1
+ beamon(ivx) = .false.
+ beamon1(ivx) = .false.
+ nornb(ivx) = 0
+ iaskb(ivx) = 1
+ vxtup(ivx) = .false.
+ drawbm(ivx) = .true.
+2599 continue
+25 continue
+ naskb = 0
+ ifig(1) = 1
+ ifig(2) = 1
+ ixtup = 0
+ bspend = .false.
+ iscwr = .false.
+ rpndot = .false.
+ do 16 ib = 1 , nb
+c
+c Check for segno
+c
+ if (btest(iornq(1,ipo(istart(ib))),4) .and.
+ * ivxo(istart(ib)).eq.1) then
+ if (noffseg.le.-10) then
+ write(noteq(1:5),'(1H{,i3,1H})')noffseg
+ lnoten = 5
+ else if (noffseg.lt.0 .or. noffseg.ge.10) then
+ write(noteq(1:4),'(1H{,i2,1H})')noffseg
+ lnoten = 4
+ else
+ write(noteq(1:1),'(i1)')noffseg
+ lnoten = 1
+ end if
+ notexq = sq//'znotes'//sq//'segnoo'//noteq(1:lnoten)//'9'
+ lnote = 15+lnoten
+ do 130 iv = 2 , nv
+ if (lnote .gt. 60) then
+ if (islast) write(11,'(a)')notexq(1:lnote)//'%'
+ notexq = sepsymq(iv-1)//sq//'segnoo'
+ * //noteq(1:lnoten)//'9'
+ lnote = lnoten+9
+ else
+ notexq = notexq(1:lnote)//sepsymq(iv-1)//sq//'segnoo'
+ * //noteq(1:lnoten)//'9'
+ lnote = lnote+lnoten+9
+ end if
+130 continue
+ if (islast) write(11,'(a)')notexq(1:lnote)//sq//'en'
+ lnote = 0
+ end if
+c
+c Check for new clefs
+c
+ isclef = .false.
+ if (btest(islur(ivxo(istart(ib)),ipo(istart(ib))),15))
+ * then
+c
+c In preceding line, fl32 gave wrong result for ... .gt.0 !!!
+c
+ do 140 in = istart(ib) , istop(ib)
+ if (btest(islur(ivxo(in),ipo(in)),11)) then
+ call wsclef(ivxo(in),ninow,
+ * iand(ishft(islur(ivxo(in),ipo(in)),-12),7))
+c
+c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
+c
+c if (clefq(ivxo(in)) .eq. '8') then
+ if (btest(ipl(ivxo(in),ipo(in)),2)) then
+c
+c Find instrument number for voice ivso(in)
+c
+ iv1 = 1
+ do 1111 iinst = 1 , ninow
+ if (ivxo(in) .lt. iv1+nspern(iinst)) go to 2222
+ iv1 = iv1+nspern(iinst)
+1111 continue
+ print*
+ print*,'Should not be here in make2bar!'
+ call stop1()
+2222 continue
+ if (iinst .le. 9) then
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',
+ * iinst,sq//'treblelowoct%'
+ else
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',
+ * iinst,sq//'treblelowoct%'
+ end if
+ c8flag(ivxo(in)) = .true.
+ end if
+ end if
+140 continue
+ if (islast) write(11,'(a)')sq//'pmxnewclefs'
+ isclef = .true.
+ end if
+c
+c Start a notes group. We're just gonna define every one using pnotes{n},
+c where \def\pnotes#1{\vnotes#1\elemskip}
+c
+ soutq = sq//'pnotes{'
+ eonsqz = squez(ib)*feon(space(ib)/squez(ib))
+ if (eonsqz .gt. 9.995) then
+ write(soutq(9:12),'(f4.1)')eonsqz
+ else if (eonsqz .gt. 0.995) then
+ write(soutq(9:12),'(f4.2)')eonsqz
+ else if (eonsqz .gt. 0.095) then
+ soutq = soutq(1:8)//'0.'
+ write(soutq(11:12),'(i2)')nint(100*eonsqz)
+ else
+ soutq = soutq(1:8)//'0.0'
+ write(soutq(12:12),'(i1)')nint(100*eonsqz)
+ end if
+ soutq = soutq(1:12)//'}'
+ lsout = 13
+c
+c Check whole block, flag accidentals etc that are too close, one per *time*.
+c Note about bar starts and after rpt's/boublebars: There is an afterruleskip
+c (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so
+c (dotsfac*wheadpt) is presumed to be filled up.
+c
+ in = istart(ib)-1
+ itrpt = -1
+ itsig = -1
+c
+c Begin big manual loop over notes in this block; ends at 112
+c
+111 in = in+1
+ if (in .gt. istop(ib)) go to 112
+ ip = ipo(in)
+ ivx = ivxo(in)
+ if (ivx .le. nv) then
+ iv = ivx
+ else
+ do 128 iv = 1 , nv
+ if (nvmx(iv) .eq. 2 .and. ivmx(iv,2).eq. ivx) go to 129
+128 continue
+ print*,'Trouble finding iv!, ivx,nvmx,ivmx:',ivx,nvmx(1),nvmx(2)
+ print*,ivmx(1,1),ivmx(1,2),ivmx(2,1),ivmx(2,2)
+ stop
+ end if
+129 continue
+c
+c Call precrd here so we know how much space to add for accid's in chords
+c After calling precrd, icashft>0 means there is a shifted chordal accid (incl.
+c main note.
+c
+c To call precrd, need up-downness, so must track if in beam.
+c
+c Deal w/ staff-jumping beams later
+c if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
+c * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or.
+c * btest(nacc(ivx,ip),21)) then
+c if (.not.btest(irest(ivx,ip),24)) then
+ if ((numbms(ivx).gt.0 .and. ibmcnt1(ivx).le.numbms(ivx)
+ * .and. ibm1(ivx,ibmcnt1(ivx)) .eq. ip)) then
+ beamon1(ivx)=.true.
+ end if
+ icashft = 0
+ if (btest(ipl(ivx,ip),10)) then
+c
+c There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds.
+c
+ if (beamon1(ivx)) then
+ call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
+ * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt1(ivx)),
+ * .false.,icashft)
+ else
+ call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
+ * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
+ * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
+ * .false.,icashft)
+ end if
+ end if
+c
+c Turn beam off?
+c
+ if (beamon1(ivx) .and. ibm2(ivx,ibmcnt1(ivx)).eq.ip) then
+ beamon1(ivx) = .false.
+ ibmcnt1(ivx) = ibmcnt1(ivx)+1
+ end if
+c
+c Remember, rpts & internal sigs can only come at start of (internal) block
+c
+ isacc = iand(nacc(ivx,ip),3).gt.0
+ * .and. .not.btest(nacc(ivx,ip),17)
+ * .and. .not.btest(ipl(ivx,ip),10)
+c
+c i.e., do not set for chord. Now check for "(" as ornament on main note,
+c
+c!!! Need to do this for chord notes too. Maybe in chkarp?
+c
+ isaccs = isacc .or. btest(iornq(ivx,ip),0)
+c
+c 5/15/02 Add check for ) ornament of prior note.
+c 5/16 Nope...fails when grace intervenes.
+c if (ip .gt. 1) then
+c isaccs = isaccs .or. btest(iornq(ivx,ip-1),13)
+c end if
+ isarp = btest(iornq(ivx,ip),27)
+ iscacc = .false.
+ if (btest(ipl(ivx,ip),10)) then
+c
+c There is a chord here; check for arpeggios and accidentals. Note accid shifts are
+c not of concern here, only whether there's an accid, whick causes iscacc=.true.
+c
+ iscacc = igetbits(nacc(ivx,ip),3,0).gt.0 .and.
+ * .not.btest(nacc(ivx,ip),17)
+ call chkarp(ncrd,icrdat,ivx,ip,iscacc,isarp)
+ end if
+c
+c When we get motivated, will do spacing for arpeggios here.
+c
+ if (ivx.eq.1 .and. iand(islur(ivx,ip),96).gt.0)
+ * itrpt = nint(to(in))
+ issig = btest(ipl(ivx,ip),28)
+ if (ivx.eq.1 .and. issig) itsig = nint(to(in))
+ isgrace = btest(islur(ivx,ip),4) .and.
+ * .not.btest(ipl(ivx,ip),29) .and. .not.btest(ipl(ivx,ip),31)
+ isgaft = .false.
+ if (ip .gt. 1) then
+ xnd = tnote(ipl2(ivx,ip-1))
+ isgaft = btest(ipl(ivx,ip-1),29) .or. btest(ipl(ivx,ip-1),31)
+ isgrace = isgrace .or. isgaft
+ end if
+ iscln = isclef .and. btest(islur(ivx,ip),11)
+c
+c Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd
+c
+ isflag = ip.gt.1 .and. xnd.gt.tol .and. xnd.lt.16.-tol
+ if (isflag)
+ * isflag = .not.btest(irest(ivx,ip-1),0)
+ * .and. udqq(nolev(ivx,ip-1),
+ * ncmid(iv,ip-1),islur(ivx,ip-1),nvmx(iv),ivx,nv).eq.'u'
+ if (isflag) then
+ do 116 ibmchk = 1 , numbms(ivx)
+ if (ip-1 .lt. ibm1(ivx,ibmchk)) then
+ go to 117
+c
+c Add check for non-beamed xtuplets. May be problem with stem direction.
+c
+ else if (ip-1.le.ibm2(ivx,ibmchk) .and.
+ * .not.btest(islur(ivx,ibm1(ivx,ibmchk)),18)) then
+ isflag = .false.
+ go to 117
+ end if
+116 continue
+ end if
+117 continue
+c
+c If isflag, then won't need to check for dot on prev. note.
+c
+c 5/16/02 ??? Try using this for ) ornament.
+c
+ isflag = isflag .or. btest(iornq(ivx,ip-1),13)
+ isdot = ip.gt.1
+ if (isdot) isdot = isdotted(nodur,ivx,ip-1)
+ isrshft = ip .gt. 1
+ if (isrshft) isrshft = btest(irest(ivx,ip-1),20)
+ if (.not.(isaccs.or.isgrace.or.iscln.or.isflag.or.isrshft.or.
+ * isdot.or.btest(iornq(ivx,ip),26).or.
+ * btest(irest(ivx,ip),21).or.isarp.or.
+ * btest(irest(ivx,ip),27).or.iscacc)) go to 111
+c
+c Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift.
+c Compute pts, the total occupied space including prior notehead.
+c
+c 130324
+c wheadpt1 = wheadpt*fullsize(iv)
+ wheadpt1 = wheadpt*fullsize(instno(iv))
+ pts = wheadpt1
+c
+c Set up for possible cautionary accidental here
+c
+ if (isaccs .or. iscacc) then
+ if (.not.btest(iornq(ivx,ip),31)) then
+ taccfac = accfac
+ else
+ taccfac = 1.4*accfac ! cautionary accidental
+ end if
+ end if
+ if (isgrace) then
+ secondgrace = .false.
+ do 122 ig = 1 , ngrace
+ if (.not. isgaft) then
+ if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 123
+ else if (ip .gt. 1) then
+ if (ipg(ig).eq.ip-1 .and. ivg(ig).eq.ivx) go to 123
+ end if
+122 continue
+ print*,'Problem finding grace index in makeabar'
+ stop
+123 continue
+c
+c wgr = distance to backspace (in headwidths), less main acc.
+c ptgr = same in pts,+ main acc. Not used for after-grace. Distance to backspace.
+c spgr = total space needed (w/o main acc).
+c Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place.
+c
+ if (nng(ig) .eq. 1) then
+ wgr = grafac
+ if (multg(ig) .eq. 0) wgr = wgr-.4
+ else
+ wgr = nng(ig)*emgfac
+ do 126 ing = 2 , nng(ig)
+ if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
+126 continue
+ end if
+ if (graspace(ig) .gt. 0.) then
+c
+c User-defined space before grace
+c
+ wgr = wgr+graspace(ig)
+ end if
+ ptgr(ig) = wgr*wheadpt1
+ spgr = ptgr(ig)+xb4fac*wheadpt1
+c
+c!!! May need to mod for chord accid's
+c
+ if (isaccs .or. iscacc) ptgr(ig) = ptgr(ig) + taccfac*wheadpt1
+ if (naccg(ngstrt(ig)) .gt. 0) spgr = spgr+wheadpt1*agc1fac
+ pts = pts+spgr
+c
+c Special check for after-grace on ip-1 and normal on ip. Must go back thru
+c loop again for the normal grace.
+c
+ if (isgaft .and. ig.lt.ngrace .and. .not.secondgrace) then
+ if (ipg(ig+1).eq.ip) then
+ secondgrace = .true.
+ ig = ig+1
+ go to 123
+ end if
+ end if
+ end if
+ if (iscln) then
+ pts = pts+clefac*wheadpt1
+c
+c How far to backspace when printing the clef
+c
+ ptclef(ivx) = 0.
+c
+c!!! May need to mod for chord accid's
+c
+ if (isaccs .or. iscacc)
+ * ptclef(ivx) = ptclef(ivx)+taccfac*wheadpt1
+ if (isgrace) ptclef(ivx) = ptclef(ivx)+spgr
+ end if
+ if (isrshft) then
+ pts = pts+rtshfac*wheadpt1
+ else if (isflag) then
+ pts = pts+flagfac*wheadpt1
+ else if (isdot) then
+ pts = pts+dotfac*wheadpt1
+ end if
+ if (abs(to(in)-itrpt) .lt. tol) then
+c
+c Repeat, need a little extra space
+c
+ pts = pts+dotsfac*wheadpt1
+ end if
+ if (isarp) then
+ pts = pts+arpfac*wheadpt1
+ end if
+c
+c Add in padding space
+c
+ pts = pts+xspfac*wheadpt1
+c
+c Now done with all items needing space except accidentals,
+c accidental shifts, and left-notehead-shifts, and will later
+c subtract a notehead if at start of bar.
+c
+c Get available space in elemskips (esk)
+c
+ isfirst = ip.eq.1 .or. abs(to(in)-itrpt).lt.tol .or.
+ * abs(to(in)-itsig).lt.tol
+ if (isfirst) then
+c
+c At start of bar or after repeat sign or new signature
+c
+ if (abs(to(in)-itsig).lt.tol) then
+ esk = 0.
+ else
+ esk = fbar
+ end if
+ else
+c
+c Not 1st note of bar
+c
+ esk = eskz(ivx,ip)-eskz(ivx,ip-1)
+ end if
+ if (isgrace) then
+c
+c Since graces can be very long, cannot assume no interference if prior
+c note uses >1 noteskip. So must get elsk's back to prior note, whether or
+c not it used only one noteskip.
+c <<But if it was xtup. don't need to call eskb4.>>????
+c
+c 10/8/05 Kluge to not zero out esk if in xtup
+c
+ esksav = esk
+ if ((ip.le.2 .or. nodur(ivx,max(1,ip-2)).gt.0) .and.
+c * to(in).ne.itsig)
+ * abs(to(in)-itsig).gt.tol)
+ * call eskb4(ip,ivx,in,ib,space,tstart,fbar,itrpt,esk)
+ if (abs(esk) .lt. tol) esk = esksav
+ end if
+c
+c Done getting available elemskips. Remove headwidth if first. Must do here
+c rather than earlier since check uses isfirst
+c
+ if (isfirst) pts = pts-wheadpt1
+c
+c Deal with accidental shifts and left-notehead shifts
+c
+ if (btest(ipl(ivx,ip),10)) then
+c
+c In a chord
+c
+ ptsl = 0.
+ if (btest(irest(ivx,ip),27)) ptsl = wheadpt1
+ ptsadd = max(ptsl,icashft*.05*wheadpt1)
+c
+c Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK
+c
+ else
+c
+c Not in a chord
+c
+ ihshft = 0
+ if (isaccs) then
+ ihshft = igetbits(nacc(ivx,ip),7,10)
+c if (ihshft .ne. 0) ihshft = max(0,64-ihshft)
+ if (ihshft .ne. 0) ihshft = max(0,107-ihshft)
+ end if
+c
+c Check for left-shifted main note
+c
+ if (btest(ipl(ivx,ip),8)) ihshft = max(20,ihshft)
+ ptsadd = ihshft*.05*wheadpt1
+ end if
+ pts = pts+ptsadd
+ if (isgrace) ptgr(ig) = ptgr(ig)+ptsadd
+ if (iscln) ptclef(ivx) = ptclef(ivx)+ptsadd
+c
+c Left-shifted, non-chord note before?
+c
+ if (ip .gt. 1) then
+ if (.not.btest(ipl(ivx,ip-1),10) .and.
+ * btest(irest(ivx,ip-1),27)) pts = pts-wheadpt1
+ end if
+c
+c Try big accidentals first
+c
+ ptbneed = pts
+ if (isaccs .or. iscacc) then
+ ptbneed = ptbneed+wheadpt1*bacfac
+ end if
+ if (poefa(iline)*poenom*esk .gt. ptbneed) then
+c
+c Set flag for big accidental
+c
+ if (isacc) nacc(ivx,ip) = ibset(nacc(ivx,ip),3)
+ go to 99
+ end if
+c
+c Cannot use big, so try small
+c
+ ptsneed = pts
+ if (isaccs .or. iscacc) then
+ ptsneed = ptsneed+taccfac*wheadpt1
+ end if
+ if (poefa(iline)*poenom*esk .lt. ptsneed) then
+ call addask(to(in),ptsneed,poefa(iline)*esk,
+ * fixednew,scaldold,0.,poefa(iline),.false.)
+ end if
+99 continue
+ if (btest(iornq(ivx,ip),26)) then
+c
+c User-defined space. Warning, "zero" may change value in addask!
+c
+ zero = 0.
+ call addask(to(in),ptsneed,zero,
+ * fixednew,scaldold,tglp1,1.,.true.)
+ end if
+c
+c End of big manual loop over "in" for accidental checking
+c
+ go to 111
+112 continue
+c
+c End of ask analysis for this block.
+c
+c Adjust eskz if there are added spaces. Corrects length of xtup brackets.
+c
+ if (naskb.gt.0) call adjusteskz(ib,istart,poenom)
+c
+c Check for internal repeat or sig change.
+c
+ if (ib.gt.1 .and. ivxo(istart(ib)).eq.1) then
+ iirpt = iand(islur(1,ipo(istart(ib))),67109216)
+ if (iirpt .gt. 0) then
+c
+c Internal repeat
+c
+ if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
+ if (iirpt .eq. 96) then
+ if (islast) write(11,'(a)')sq//'leftrightrepeat'
+ fixednew = fixednew+lrrptfac*wheadpt
+ else if (btest(iirpt,5)) then
+ if (islast) write(11,'(a)')sq//'leftrepeat'
+ fixednew = fixednew+rptfac*wheadpt
+ else if (btest(iirpt,6)) then
+ if (islast) write(11,'(a)')sq//'rightrepeat'
+ fixednew = fixednew+rptfac*wheadpt
+ else if (btest(iirpt,8)) then
+ if (islast) write(11,'(a)')sq//'doublebar'
+ else
+ print*,'Unexpected mid-bar repeat command R*'
+ call stop1()
+ end if
+ scaldold = scaldold-fbar
+ end if
+ if (btest(ipl(1,ipo(istart(ib))),28)) then
+c
+c Internal signature change.
+c
+ notexq = sq//'generalsignature{'
+ lnote = 18
+ if (isig .lt. 0) then
+ notexq = notexq(1:lnote)//'-'
+ lnote = lnote+1
+ end if
+ if (islast) write(11,'(a)')notexq(1:lnote)
+ * //chax(48+abs(isig))//'}%'
+ if (islast .and. ignorenats)
+ * write(11,'(a)')sq//'ignorenats%'
+ if (islast) write(11,'(a)')sq//'zchangecontext'//sq
+ * //'addspace{-.5'//sq//'afterruleskip}%'
+ lnote = 0
+ end if
+ end if
+ flgndb = .false.
+c
+c Done with start-of-block stuff. Begin main loop over voices.
+c
+ do 11 iv = 1 , nv
+ do 1199 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ icm = midchan(iv,kv)
+c
+c A rather klugey way to set flag for figure in this voice
+c Must always check figbass before figchk.
+c
+ if (figbass) then
+ ivf = 0
+ if (ivx .eq. 1) then
+ ivf = 1
+ else if (ivx .eq. ivxfig2) then
+ ivf = 2
+ end if
+ if (ivf.gt.0) figchk(ivf) = nfigs(ivf).gt.0
+ end if
+ if (ivx .gt. 1) then
+ if (ivx .le. nv) then
+ call addstr(sepsymq(iv-1),1,soutq,lsout)
+ else
+ call addstr(sq//'nextvoice',10,soutq,lsout)
+ end if
+ end if
+ if (ihdht.gt.0 .and. ivx.eq.nv) then
+c
+c Write header. First adjust height if needed to miss barno.
+c
+ if (bar1syst .and. iline.ne.1) then
+ ihdht = 15+irzbnd+isnx
+ end if
+c
+c Add user-defined vertical shift
+c
+ ihdht = ihdht+ihdvrt
+ lchead = lenstr(headrq,80)
+ notexq = sq//'zcharnote{'
+ write(notexq(12:13),'(i2)')ihdht
+ notexq = notexq(1:13)//'}{'//sq//'bigfont'//sq//'kern-30pt '
+ call addstr(notexq,34,soutq,lsout)
+ call addstr(headrq(1:lchead)//'}',1+lchead,soutq,lsout)
+ ihdht = 0
+ end if
+ if (lower .and. ivx.eq.nv) then
+ lclow = lenstr(lowerq,80)
+ call addstr(sq//'zcharnote{-6}{'//
+ * sq//'tempo'//sq//'kern-10pt '//
+ * lowerq(1:lclow)//'}',33+lclow,soutq,lsout)
+ lower=.false.
+ end if
+ tnow = tstart(ib)
+ nofirst = .true.
+c
+c Done setting up voice ivx for start of block ib. Loop over notes in voice.
+c
+ do 10 jn = istart(ib), istop(ib)
+ if (ivxo(jn) .ne. ivx) go to 10
+ ip = ipo(jn)
+c
+c May have problem with not initializing islhgt, so do it here
+c
+ islhgt = 0
+c
+ if (nofirst) then
+ noctup = 0
+ if (ncmid(iv,ip) .eq. 23) noctup = -2
+ nofirst = .false.
+ end if
+c
+c Check for internal floating figure (before last note of group).
+c
+12 if (figbass) then
+ if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
+ ivf = 1
+ if (ivx .gt. 1) ivf = 2
+ if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.tnow-tol)
+ * then
+c
+c Bypassed figure location. Backup, place fig, return.
+c
+ offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
+ call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,
+ * lsout)
+ go to 12
+ end if
+ end if
+ end if
+c
+c Put in \sk if needed
+c
+ if (to(jn) .gt. tnow+tol) then
+ call addstr(sq//'sk',3,soutq,lsout)
+ tnow = tnow+space(ib)
+ go to 12
+ end if
+c
+c Check for user-defined shifts
+c
+ if (btest(irest(ivx,ip),15).or.btest(irest(ivx,ip),16))
+ * call putshft(ivx,.true.,soutq,lsout)
+21 if (iaskb(ivx).le.naskb .and.
+ * tnow.gt.task(iaskb(ivx))-tol) then
+ if (task(iaskb(ivx)) .gt. tstart(ib)-tol) then
+c
+c Insert placeholder for accidental skip
+c
+ call addstr(sq//'ask ',9,soutq,lsout)
+ nasksys = nasksys+1
+ wasksys(nasksys) = wask(iaskb(ivx))
+ if (wask(iaskb(ivx)) .gt. 0.) then
+ elasksys(nasksys) = elask(iaskb(ivx))
+ else
+c
+c This is a signal to permit negative ask's. Should really have elask>=0.
+c
+ elasksys(nasksys) = -elask(iaskb(ivx))
+ end if
+ end if
+c
+c May have skipped some task's in earlier blocks (due to void voice)
+c
+ iaskb(ivx) = iaskb(ivx)+1
+ go to 21
+ end if
+ if (figbass) then
+ if (ivx.eq.1 .or. ivx.eq.ivxfig2) then
+ ivf = 1
+ if (ivx .gt. 1) ivf = 2
+ if (figchk(ivf) .and.
+ * abs(itfig(ivf,ifig(ivf))-tnow).lt.tol) then
+c
+c Figure on a note. NB: later special check for late figs.
+c
+ call putfig(ivf,ifig(ivf),0.,figchk(ivf),soutq,lsout)
+ end if
+ end if
+ end if
+c
+c Check for new clef here.
+c
+ if (isclef .and. btest(islur(ivx,ip),11)) then
+ if (ptclef(iv) .gt. 0.) then
+ notexq = sq//'off{-'
+ if (ptclef(iv) .lt. 9.95) then
+ write(notexq(7:9),'(f3.1)')ptclef(iv)
+ lnote = 9
+ else
+ write(notexq(7:10),'(f4.1)')ptclef(iv)
+ lnote = 10
+ end if
+ notexq = notexq(1:lnote)//'pt}'
+ lnote = lnote+3
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+ call clefsym(islur(iv,ip),notexq,lnote,nclef)
+c
+c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8'
+c
+ if (btest(ipl(ivx,ip),2)) notexq =
+ * notexq(1:8)//'8'//notexq(10:10)
+ call addstr(notexq,lnote,soutq,lsout)
+ if (ptclef(iv) .gt. 0.) then
+ notexq = sq//'off{'
+ if (ptclef(iv) .lt. 9.95) then
+ write(notexq(6:8),'(f3.1)')ptclef(iv)
+ lnote = 8
+ else
+ write(notexq(6:9),'(f4.1)')ptclef(iv)
+ lnote = 9
+ end if
+ notexq = notexq(1:lnote)//'pt}'
+ lnote = lnote+3
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+ end if
+c
+c Checking for literal TeX string BEFORE starting beams!!
+c
+ if (btest(islur(ivx,ip),16)) then
+ do 124 il = 1 , nlit
+ if (iplit(il).eq.ip .and. ivlit(il).eq.ivx) go to 125
+124 continue
+ print*,'Problem finding index for literal string'
+ call stop1()
+125 continue
+c
+c Write a type 1 tex string.
+c
+ if (lenlit(il) .lt. 71) then
+c
+c Add normally
+c
+ call addstr(litq(il),lenlit(il),soutq,lsout)
+ else
+c
+c Longer than 71. Write souq, Write string, start new soutq.
+c
+ if (islast) write(11,'(a)')soutq(1:lsout)//'%'
+ if (islast) write(11,'(a)')litq(il)(1:lenlit(il))//'%'
+ lsout = 0
+ end if
+ end if
+c
+c Arpeggio on a main (non-chordal) note?
+c
+ if (btest(iornq(ivx,ip),27)) then
+c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip),
+ call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip),
+ * soutq,lsout)
+ end if
+c
+c See if a beam starts here
+c
+ if ((numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
+ * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or.
+ * btest(nacc(ivx,ip),21)) then
+ if (.not.btest(irest(ivx,ip),24)) then
+c
+c Not a jump start
+c
+ if (kbdrests .and. btest(irest(ivx,ip),0) .and.
+ * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
+ * nolev(ivx,ip).le.50)
+ * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
+ * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
+ * mult,ipl)
+ call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib)
+c
+c Shift beam start if notehead was shifted
+c
+ if (btest(ipl(ivx,ip),8)) then
+ call addstr(sq//'loff{',6,soutq,lsout)
+ else if (btest(ipl(ivx,ip),9)) then
+ call addstr(sq//'roff{',6,soutq,lsout)
+ end if
+ if (lnote .gt. 0) call addstr(notexq,lnote,soutq,lsout)
+ if (btest(ipl(ivx,ip),8) .or.
+ * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
+ else
+c
+c Jump start. Set marker for second part of a jump beam. Note ivbj2 was set
+c to 0 at end of first part of jump beam
+c
+ ivbj2 = ivx
+c
+c Check for xtup since we bypassed beamstrt wherein vxtup is normally set
+c
+ if (btest(irest(ivx,ip),28) .and. ixrest(ivx).ne.2)
+ * vxtup(ivx) = .true.
+c
+c Since beamstrt is not called, and drawbm is normally set there, need to set
+c it here. This could cause problems if someone tries a staff-jumping,
+c unbarred beam, which I'll deal with when it comes up.
+c
+ drawbm(ivx) = .true.
+ end if
+ if (ixrest(ivx) .eq. 0) then
+ beamon(ivx) = .true.
+ bspend = .true.
+ if (.not.btest(irest(ivx,ip),24))bspend = .true.
+ end if
+ end if
+c
+c Setup for chords and possible slurs in chords
+c
+ if (btest(ipl(ivx,ip),10)) then
+c
+c There is a chord on this note. Just rerun precrd. Klunky, but saves
+c me from tracking down errors instroduced when I moved 1st call
+c forward for accidental spacing analysis.
+c
+ if (beamon(ivx)) then
+ call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
+ * ipl(ivx,ip),irest(ivx,ip),ulq(ivx,ibmcnt(ivx)),
+ * .true.,icashft)
+ else
+ call precrd(ivx,ip,nolev(ivx,ip),nacc(ivx,ip),
+ * ipl(ivx,ip),irest(ivx,ip),udqq(nolev(ivx,ip),
+ * ncmid(iv,ip),islur(ivx,ip),nvmx(iv),ivx,nv),
+ * .true.,icashft)
+ end if
+ end if
+c
+c Is there slur or grace activity?
+c
+ isgrace = btest(islur(ivx,ip),4)
+ if (ip .gt. 1) isgrace = isgrace.or.btest(ipl(ivx,ip-1),31)
+c
+c isgrace if not 1st note in bar and previous note has Way-after grace.
+c
+ if (btest(islur(ivx,ip),0) .or. isgrace) then
+ if (btest(islur(ivx,ip),0)) then
+ if (fontslur) then
+c
+c Call routine for non-postscript slurs
+c
+ call doslur(nolev(ivx,ip),isdat1,isdat2,isdat3,nsdat,
+ * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
+ * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
+ * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
+ * nacc(ivx,ip))
+ else
+c
+c Postscript slurs
+c
+ call dopsslur(nolev(ivx,ip),isdat1,isdat2,isdat3,
+ * isdat4,nsdat,
+ * ip,iv,kv,nv,beamon(ivx),ncmid(iv,ip),soutq,lsout,
+ * ulq(ivx,ibmcnt(ivx)),islur(ivx,ip),ipl(ivx,ip),
+ * iornq(ivx,ip),islhgt,tnote(ipl2(ivx,ip)),
+ * nacc(ivx,ip))
+ end if
+ end if
+ if (isgrace) then
+c
+c Grace note.
+c
+ iphold = ip
+ isgrace = .false.
+ if (ip .gt. 1) isgrace = btest(ipl(ivx,ip-1),31)
+ if (isgrace) iphold = iphold-1
+ isgrace = isgrace .or. (.not.btest(ipl(ivx,ip),31)
+ * .and..not.btest(ipl(ivx,ip),29))
+c
+c Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace
+c on current note. Do A-grace on current note, and W-grace at barend, later.
+c
+ if (isgrace) then
+ call dograce(ivx,iphold,ptgr,soutq,lsout,ncmid(iv,ip),
+ * nacc(ivx,ip),ig,ipl(ivx,iphold),.false.,
+ * beamon(ivx),nolev(ivx,ip),ncmid(iv,ip),
+ * islur(ivx,ip),nvmx(iv),nv,ibmcnt(ivx),
+c 130324
+c * tnote(ipl2(ivx,ip)),ulq)
+ * tnote(ipl2(ivx,ip)),ulq,instno(iv))
+ if (slurg(ig)) then
+c
+c Terminate slur started in dograce. Get direction of main note stem
+c
+ if (.not.beamon(ivx)) then
+c
+c Separate note. Get stem direction.
+c
+ stemup = udqq(nolev(ivx,ip),ncmid(iv,ip),
+ * islur(ivx,ip),nvmx(iv),ivx,nv) .eq. 'u'
+ else
+c
+c In a beam
+c
+ stemup = ulq(ivx,ibmcnt(ivx)) .eq. 'u'
+ end if
+c
+c Stop the shift if whole note
+c
+ stemup = stemup .or.
+ * tnote(ipl2(ivx,ip)).gt.63
+ call endslur(stemup,.not.upg(ig),nolev(ivx,ip),0,
+ * ndxslur,0,ncmid(iv,ip),soutq,lsout,fontslur)
+ end if
+ end if
+ end if
+ if (btest(iornq(ivx,ip),24)) then
+c
+c Start slur on main note for After- or Way-after-grace.
+c
+c???? ndxslur = log2(33554431-listslur)
+ ndxslur = log2(16777215-listslur)
+c
+c Get note name
+c
+ call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip))
+c
+c Get slur direction
+c
+ slurudq = 'u'
+ if (.not.beamon(ivx)) then
+ if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
+ * nvmx(iv),ivx,nv) .eq. 'u') slurudq = 'd'
+ else
+ if (ulq(ivx,ibmcnt(ivx)) .eq. 'u') slurudq = 'd'
+ end if
+c
+cc Replace ndxslur by 11-ndxslur when printing only.
+c Replace ndxslur by 23-ndxslur when printing only.
+c
+c if (11-ndxslur .lt. 10) then
+ if (23-ndxslur .lt. 10) then
+c notexq = sq//'islur'//slurudq//chax(59-ndxslur)
+ notexq = sq//'islur'//slurudq//chax(71-ndxslur)
+ * //noteq(1:lnoten)
+ call addstr(notexq,8+lnoten,soutq,lsout)
+ else if (23-ndxslur .lt. 20) then
+ notexq = sq//'islur'//slurudq//'{1'//chax(61-ndxslur)
+ * //'}'//noteq(1:lnoten)
+ call addstr(notexq,11+lnoten,soutq,lsout)
+ else
+ notexq = sq//'islur'//slurudq//'{2'//chax(51-ndxslur)
+ * //'}'//noteq(1:lnoten)
+ call addstr(notexq,11+lnoten,soutq,lsout)
+ end if
+c call setbits(ipl(ivx,ip),4,23,ndxslur)
+ call setbits(ipl(ivx,ip),5,23,ndxslur)
+ if (btest(ipl(ivx,ip),31))
+c
+c Starting slur on W-grace on THIS note. Record ndxslur.
+c
+ * listslur = ibset(listslur,ndxslur)
+ end if
+ end if
+c
+c Process dynamic marks
+c
+ if (btest(irest(ivx,ip),26)) then
+ call dodyn(ivx,ip,
+ * nolev(ivx,ip),ncmid(iv,ip),ipl(ivx,ip),islur(ivx,ip),
+ * irest(ivx,ip),nvmx(iv),nv,beamon(ivx),ihornb,nornb,ulq,
+ * ibmcnt(ivx),nodur(ivx,ip).ge.64,soutq,lsout)
+ end if
+c
+c Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st.
+c
+ if (btest(ipl(ivx,ip),10)) then
+c
+c Need a duration to set type of note head
+c
+c Clumsy test, but vxtup is not set until main note is processed.
+c
+ if (.not.(vxtup(ivx).or.btest(irest(ivx,ip),28))) then
+ nodu = nodur(ivx,ip)
+ else if (btest(irest(ivx,ip),2) .or.
+ * (ip.gt.1.and.btest(irest(ivx,ip-1),2))) then
+c
+c In a 2-note tremolo
+c
+ if (btest(irest(ivx,ip),2)) then
+c
+c First note of tremolo, duration is on next note
+c
+ nodu = nodur(ivx,ip+1)
+ else
+ nodu = nodur(ivx,ip)
+ end if
+ else if (iand(mult(ivx,ip),15)-8 .lt. 0) then
+ nodu = 32
+ else
+ nodu = 16
+ end if
+ call docrd(ivx,ip,nodu,ncmid(iv,ip),iv,tnow,soutq,lsout,
+ * ulq,ibmcnt(ivx),islur(ivx,ip),nvmx(iv),nv,
+ * beamon(ivx),nolev(ivx,ip),ihornb,nornb,stemlen,
+ * btest(nacc(ivx,ip),27),nacc(ivx,ip),
+ * irest)
+ end if
+c
+c Now that chords are done, add stuff to midi file
+c
+ if (ismidi) call addmidi(icm,
+c 130316
+ * nolev(ivx,ip)+miditran(instno(iv)),
+ * iand(nacc(ivx,ip),7),midisig,
+ * tnote(ipl2(ivx,ip)),
+ * btest(irest(ivx,ip),0),.false.)
+c
+c Check for breath or caesura
+c
+ if (btest(iornq(ivx,ip),28)) then
+ call putcb(ivx,ip,notexq,lnote)
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+c
+c Check for main-note ornaments. ')' on dotted notes go in with note, not here.
+c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F
+c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD
+c
+c isacc = iand(iornq(ivx,ip),4194287) .gt. 0
+c isacc = iand(iornq(ivx,ip),541065199) .gt. 0
+ isacc = iand(iornq(ivx,ip),1614807023) .gt. 0
+c
+c isacc=.true. if any ornament except segno
+c
+ if (btest(iornq(ivx,ip),13) .and. nodur(ivx,ip).gt.0) then
+c
+c If ). is only ornament, bypass. If with others, temporarirly zero the bit.
+c
+ if (2**log2(nodur(ivx,ip)) .ne. nodur(ivx,ip)) then
+ if (iand(iornq(ivx,ip),516079) .eq. 0) then
+c
+c ). is the only non-segno ornament
+c
+ isacc = .false.
+ else
+c
+c There are other ornaments in addition
+c
+ rpndot = .true.
+ iornq(ivx,ip) = ibclr(iornq(ivx,ip),13)
+ end if
+ end if
+ end if
+ if (isacc .and. .not.cwrferm(ivx)) then
+c
+c Check for centered whole-bar rest with fermata (bits 10 or 14).
+c
+ if (iand(iornq(ivx,ip),17408).gt.0
+ * .and. btest(irest(ivx,ip),0) .and.
+ * nodur(ivx,ip).eq.lenbar .and.
+ * .not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)) then
+ cwrferm(ivx) = .true.
+ go to 30
+ end if
+ call putorn(iornq(ivx,ip),nolev(ivx,ip),nolev(ivx,ip),
+ * nodur(ivx,ip),nornb,ulq,ibmcnt(ivx),ivx,ncmid(iv,ip),
+ * islur(ivx,ip),nvmx(iv),nv,ihornb,stemlen,
+ * notexq,lnote,ip,islhgt,beamon(ivx),
+ * btest(ipl(ivx,ip),10))
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+ if (rpndot) then
+ iornq(ivx,ip) = ibset(iornq(ivx,ip),13)
+ rpndot = .false.
+ end if
+30 continue
+c
+c Check for main note accidental
+c
+ if (iand(nacc(ivx,ip),3).gt.0 .and.
+ * .not.btest(nacc(ivx,ip),17)) then
+ ihshft = igetbits(nacc(ivx,ip),7,10)
+ if (ihshft .ne. 0) ihshft=ihshft-107
+ if (.not.btest(ipl(ivx,ip),10) .and. btest(ipl(ivx,ip),8))
+c
+c Not a chord, and left-shifted main note, so left-shift accid
+c
+ * ihshft = ihshft-20
+ call doacc(ihshft,igetbits(nacc(ivx,ip),6,4),
+ * notexq,lnote,nacc(ivx,ip),nolev(ivx,ip),ncmid(iv,ip),
+ * btest(irest(ivx,ip),31))
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+c
+c Lower dot for lower-voice notes. Conditions are:
+c 1. Dotted time value
+c 2. Lower voice of two
+c 3. Note is on a line
+c 4. Not a rest
+c. 5. Flag (lowdot) is set to true
+c 6. Not in an xtuplet
+c
+ if (lowdot .and. nvmx(iv).eq.2 .and. ivx.le.nv
+ * .and. nodur(ivx,ip).ne.0) then
+ if (.not.btest(irest(ivx,ip),0) .and.
+ * 2**log2(nodur(ivx,ip)).ne.nodur(ivx,ip) .and.
+ * mod(nolev(ivx,ip)-ncmid(ivx,ip),2).eq.0) then
+ if (btest(irest(ivx,ip),19)) then
+c
+c Note already in movdot list. Drop by 2.
+c
+ updot(ivx,ndotmv(ivx)+1) =
+ * updot(ivx,ndotmv(ivx)+1)-2.
+ else
+c
+c Not in list so just move it right now
+c
+ call dotmov(-2.,0.,soutq,lsout,
+ * igetbits(islur(ivx,ip),1,3))
+ end if
+ end if
+ end if
+c
+c Check for dotted main notes with moved dots. Chord notes done elsewhere.
+c Added check rules out special chordal 2nds, but later must check
+c substituted chord note for dot shift that now applies to main note.
+c
+ if (btest(irest(ivx,ip),19)) then
+ ndotmv(ivx) = ndotmv(ivx)+1
+ call dotmov(updot(ivx,ndotmv(ivx)),rtdot(ivx,ndotmv(ivx)),
+ * soutq,lsout,igetbits(islur(ivx,ip),1,3))
+ end if
+c
+c Stemlength changes
+c
+ if (btest(mult(ivx,ip),27)) then
+ dstemlen = igetbits(mult(ivx,ip),6,10)*.5-4.
+ call addstr(sq//'stdstemfalse',13,soutq,lsout)
+ stemshort = 4.66+.667*dstemlen
+ call addstr(sq//'stemlength{',12,soutq,lsout)
+ write(notexq,'(f4.1)')stemshort
+ call addstr(notexq(1:4)//'}',5,soutq,lsout)
+ else if (ip .gt. 1) then
+ if (btest(mult(ivx,ip-1),27))
+c
+c Cancel shortening. Looks like it gets automatically restored if new inst. or
+c new line, so no need to worry about affecting other lines
+c
+ * call addstr(sq//'stemlength{4.66}',17,soutq,lsout)
+ end if
+c
+c Zero out slur-height marker for raising ornaments
+c
+ islhgt = 0
+c
+c Now start with spacing notes. Is a beam start pending?
+c
+ if (bspend .and.
+ * ibm2(ivx,ibmcnt(ivx)).gt.ibm1(ivx,ibmcnt(ivx))) then
+ if (ixrest(ivx) .eq. 4) then
+c
+c Special path for single note at end of otherwise beamed xtup
+c
+ ixrest(ivx) = 0
+ else
+ if (kbdrests .and. btest(irest(ivx,ip),0) .and.
+ * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
+ * nolev(ivx,ip).le.50)
+ * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
+ * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
+ * mult,ipl)
+ if (btest(islur(ivx,ip),29)
+ * .and.btest(irest(ivx,ip),24)) then
+ notexq = chax(92)//'sk'
+ lnote = 3
+ else
+ call beamn1(notexq,lnote)
+c if (isbjmp .and.
+ if (isbjmp .and. ivbj2.ne.0 .and.
+ * iand(mult(ivx,ip),15)-8 .gt. multbj1) then
+c
+c Need to increase multiplicity at the beam jump
+c
+c ibmcnt was increased by 1 at the end of first seg of jump beam!?
+c Try adding e.g. \nbbu1 if needed to increase multiplicity. Add
+c character in reverse order to start of notexq.
+c
+ if (ivbj1 .lt. 9) then
+ notexq = char(48+ivbj1)//notexq(1:lnote)
+ lnote = lnote+1
+ else
+ notexq = '{1'//char(38+ivbj1)//'}'
+ * //notexq(1:lnote)
+ lnote = lnote+4
+ end if
+ notexq = 'bb'//ulq(ivbj1,ibmcnt(ivbj1)-1)
+ * //notexq(1:lnote)
+ lnote = lnote+3
+ if (iand(15,mult(ivx,ip))-8 .eq. 3) then
+ notexq = 'b'//notexq(1:lnote)
+ lnote = lnote+1
+ end if
+ notexq = sq//'n'//notexq(1:lnote)
+ lnote = lnote+2
+ end if
+ end if
+ end if
+ bspend = .false.
+c
+c Is a beam ending?
+c
+ else if (numbms(ivx).gt.0 .and. ibmcnt(ivx).le.numbms(ivx)
+ * .and. (ibm2(ivx,ibmcnt(ivx)).eq.ip .or.
+ * btest(nacc(ivx,ip),20))) then
+ if (bspend) then
+c
+c Must be a single-note ending of a jump-beam
+c
+ bspend = .false.
+ end if
+ call beamend(notexq,lnote)
+ if (isbjmp .and. ivx.eq.ivbj1) then
+c
+c Jump beam segment is ending, check if multiplicity DECREASES
+c
+ if (space(ib+1) .gt. space(ib)) then
+c
+c Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8.
+c
+ if (ivx .lt. 10) then
+ ivxq = char(ivx+48)
+ livx = 1
+ else
+ ivxq = '{1'//char(ivx-10)//'}'
+ livx = 4
+ end if
+c Changes to get staffcrossall.pmx to work. Not clear how.
+c if (nint(space(ib+1)-space(ib)) .eq. 6) then
+ if (space(ib+1).eq.8..and.space(ib).eq.2.) then
+ notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))//
+ * ivxq(1:livx)//sq//'tbb'//
+ * ulq(ivx,ibmcnt(ivx))//ivxq(1:livx)//notexq(1:lnote)
+ lnote = lnote+11+2*livx
+c else if (nint(space(ib+1)-space(ib)) .eq. 4) then
+ else if (space(ib+1).eq.8..and.space(ib).eq.4.) then
+ notexq = sq//'tbb'//ulq(ivx,ibmcnt(ivx))//
+ * ivxq(1:livx)//notexq(1:lnote)
+ lnote = lnote+5+livx
+c else
+ else if (space(ib+1).eq.4..and.space(ib).eq.2.) then
+ notexq = sq//'tbbb'//ulq(ivx,ibmcnt(ivx))//
+ * ivxq(1:livx)//notexq(1:lnote)
+ lnote = lnote+6+livx
+ end if
+ end if
+ end if
+ if (.not.btest(nacc(ivx,ip),20)) then
+ vxtup(ivx) = .false.
+ nornb(ivx) = 0
+ ibmcnt(ivx) = ibmcnt(ivx)+1
+ beamon(ivx) = .false.
+ end if
+c
+c Or if we're in the middle of a beam
+c
+ else if (numbms(ivx).gt.0 .and. beamon(ivx)) then
+c
+c Added 130127
+c
+ if (kbdrests .and. btest(irest(ivx,ip),0) .and.
+ * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
+ * nolev(ivx,ip).le.50)
+ * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
+ * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr,
+ * mult,ipl)
+ call beamid(notexq,lnote)
+c
+c Or whole-bar rest
+c
+ else if (btest(irest(ivx,ip),0)
+ * .and. nodur(ivx,ip).eq.lenbar
+ * .and..not.(firstgulp.and.ibar.eq.1.and.lenb0.gt.0)
+ * .and..not.btest(irest(ivx,ip),25)
+ * .and..not.btest(islur(ivx,ip),29)) then
+c
+c Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp
+c
+ cwrest(ivx) = .true.
+ iscwr = .true.
+ call notex(cwrq(ivx),lcwr(ivx))
+ tnow = tnow+lenbar
+ go to 10
+ else if (ixrest(ivx) .eq. 0) then
+c
+c Before writing note or rest, check for keyboard rest height adjustment.
+c Conditions are 0. This is a non-blank rest
+c 1. kbdrests = .true.
+c 2. There are two voices on the staff
+c 3. No user-def height adjustments have been applied (nolev<50)
+c
+ if (kbdrests .and. btest(irest(ivx,ip),0) .and.
+ * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and.
+ * nolev(ivx,ip).le.50) then
+ call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,
+ * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr,
+ * mult,ipl)
+ end if
+ if (btest(ipl(ivx,ip),4)) then
+c
+c Deal with single stem tremolo
+c Get up-downness, borrowed from notex
+c
+ if (udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
+ * nvmx(iv),ivx,nv).eq.'u') then
+ udq = 'u'
+ else
+ udq = 'l'
+ end if
+ multtrem = igetbits(ipl(ivx,ip),2,5)+1
+ if (nodur(ivx,ip) .lt. 64) then
+ notexq = sq//'tr'
+ else
+ notexq = sq//'Tr'
+ end if
+ lnote = 3
+ if (multtrem .eq. 2) then
+ notexq = notexq(1:3)//'r'
+ lnote = 4
+ else if (multtrem .eq.3) then
+ notexq = notexq(1:3)//'rr'
+ lnote = 5
+ end if
+c
+c Get a numerical pitch argument
+c
+ lineno = nolev(ivx,ip)-ncmid(iv,ip)+4
+ if (lineno .lt.0 .or. lineno .gt.9) then
+ write(noteq,'(a1,i2,a1)')'{',lineno,'}'
+ lnoten = 4
+ else
+ noteq = char(lineno+48)
+ lnoten = 1
+ end if
+ notexq = notexq(1:lnote)//'m'//udq//noteq(1:lnoten)
+ lnote = lnote+2+lnoten
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+c
+c Get code for a separate note or rest
+c If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note),
+c pitch will be shifted +/-1 inside notex.
+c
+ call notex(notexq,lnote)
+ end if
+c
+c Right offset? This may cause trouble
+c
+ if (btest(ipl(ivx,ip),8)) then
+ call addstr(sq//'loff{',6,soutq,lsout)
+ else if (btest(ipl(ivx,ip),9)) then
+ call addstr(sq//'roff{',6,soutq,lsout)
+ end if
+ if (ixrest(ivx).eq.0 .and. lnote.gt. 0) then
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+ if (btest(ipl(ivx,ip),8) .or.
+ * btest(ipl(ivx,ip),9)) call addstr('}',1,soutq,lsout)
+c
+c Terminate user-defined offsets. Fix format
+c
+ if (btest(irest(ivx,ip),15) .or. btest(irest(ivx,ip),17))
+ * call putshft(ivx,.false.,soutq,lsout)
+c
+c Deal with After- and Way-after-graces. First, if end of bar, compute space
+c needed since it wasn't done during general ask-checks. If extra space is
+c rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp.
+c But will still need to add extra space as hardspace.
+c
+ if (ip.eq.nn(ivx) .and. (btest(ipl(ivx,ip),31).or.
+ * btest(ipl(ivx,ip),29))) then
+ do 77 ig = 1 , ngrace
+ if (ipg(ig).eq.ip .and. ivg(ig).eq.ivx) go to 78
+77 continue
+ print*,'Problem finding grace index at "do 77"'
+ call stop1()
+78 continue
+c
+c Get elemskip to end of bar. WON'T WORK IF XTUPS !!
+c
+ esk = 0.
+ do 40 iib = ib , nb
+ if (iib .eq. ib) then
+ itleft = nint(to(ipl2(ivx,ip)))
+ else
+ itleft = nint(tstart(ib))
+ end if
+ if (iib .lt. nb) then
+ itright = nint(tstart(iib+1))
+ else
+ itright = lenbar
+ end if
+ esk = esk+feon(space(ib))*
+ * (itright-itleft)/space(ib)
+40 continue
+ ptsavail = poenom*esk-wheadpt
+ if (nng(ig) .eq. 1) then
+ wgr = grafac
+ else
+ wgr = nng(ig)*emgfac
+ do 41 ing = 1 , nng(ig)
+ if (naccg(ngstrt(ig)-1+ing) .gt. 0) wgr = wgr+acgfac
+41 continue
+ end if
+ ptgr(ig) = wgr*wheadpt
+ ptsneed = (wgr+0.5)*wheadpt
+ ptsndg(ivx) = 0.
+ if (ptsavail .lt. ptsneed) then
+ ptsndg(ivx) = ptsneed
+ eskndg(ivx) = esk
+ if (btest(ipl(ivx,ip),31)) then
+c
+c Convert GW to GA
+c
+ ipl(ivx,ip) = ibset(ibclr(ipl(ivx,ip),31),29)
+ end if
+ end if
+ end if
+c
+c Check for GA
+c
+ if (btest(ipl(ivx,ip),29))
+ * call dograce(ivx,ip,ptgr,soutq,lsout,ncmid(iv,ip),
+ * nacc(ivx,ip),ig,ipl(ivx,ip),.false.,
+c 130324
+c * .false.,0,0,0,0,0,0,0.,ulq)
+ * .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
+c
+c Update running time
+c
+ tnow = tnow+space(ib)
+10 continue
+c
+c Have finished last note in this voice and block
+c
+ itendb = nint(to(istop(ib))+space(ib))
+ if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
+ ivf = 1
+ if (ivx .gt. 1) ivf = 2
+17 if (figchk(ivf) .and. itfig(ivf,ifig(ivf)).lt.itendb) then
+c
+c There's at least one figure left. offnsk could be <0
+c
+ offnsk = (tnow-itfig(ivf,ifig(ivf)))/space(ib)
+ call putfig(ivf,ifig(ivf),offnsk,figchk(ivf),soutq,lsout)
+ go to 17
+ end if
+ end if
+c
+c Check for flag, dot, or upstem on last note of bar.
+c
+ if (ib .eq. nb) then
+ ip = ipo(ipl2(ivx,nn(ivx)))
+ flgndv(ivx) = 0.
+ if (abs(tnote(ipl2(ivx,ip))-space(ib)).lt.tol) then
+ if (space(ib) .lt. 16.-tol) then
+c
+c Note in last space, smaller than a quarter note.
+c
+ if ((.not.btest(irest(ivx,ip),0) .and.
+ * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
+ * nvmx(iv),ivx,nv).eq.'u')
+ * .or. isdotted(nodur,ivx,ip)) then
+c
+c Upstem non-rest, or dotted
+c
+ if (numbms(ivx).gt.0
+ * .and. ip.eq.ibm2(ivx,max(1,numbms(ivx)))
+ * .and. .not.isdotted(nodur,ivx,ip))
+ * then
+c
+c In beam and not dotted, so use smaller space
+c
+ flgndv(ivx) = upstmfac
+ else
+ flgndv(ivx) = flagfac
+ end if
+ end if
+ else
+c
+c Last space, nonflagged (no beam) only worry dot or up
+c
+ if (isdotted(nodur,ivx,ip)) then
+ flgndv(ivx) = flagfac
+ else if (tnote(ipl2(ivx,ip)).lt.64 .and.
+ * udqq(nolev(ivx,ip),ncmid(iv,ip),islur(ivx,ip),
+ * nvmx(iv),ivx,nv).eq.'u') then
+c
+c Upstem on last note , non-flagged
+c
+ flgndv(ivx) = upstmfac
+ end if
+ end if
+ end if
+c
+c Check for right-shifted chordal note
+c
+ if (btest(irest(ivx,ip),20)) flgndv(ivx) = rtshfac
+ flgndb = flgndb .or. flgndv(ivx).gt.0.
+ if (ismidi) then
+c
+c For midi, set flags for accidentals on last note of bar. Assume they affect
+c first note of next bar whether or not tied.
+c Note has already been done, so next entry into addmidi is 1st in new bar.
+c First do main note, then chord notes
+c
+c Gyrations needed to account for multi-bar tied full-bar notes?
+cc Old old lbacc(icm) = iand(nacc(ivx,ip),7)
+c New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7)
+c
+ if (iand(nacc(ivx,ip),7) .gt. 0) then
+c
+c Explicit accidental on last main note in bar
+c
+ do 55 kacc = 1 , naccbl(icm)
+ if (laccbl(icm,kacc) .eq. nolev(ivx,ip)) go to 56
+55 continue
+ naccbl(icm) = naccbl(icm)+1
+ laccbl(icm,naccbl(icm)) = nolev(ivx,ip)
+ jaccbl(icm,naccbl(icm)) = iashft(iand(nacc(ivx,ip),7))
+ end if
+56 continue
+ if (btest(ipl(ivx,ip),10) .and. crdacc) then
+ do 57 icrd = icrd1 , icrd2
+ iacc = igetbits(icrdat(icrd),3,20)
+ if (iacc .gt. 0) then
+c
+c Explicit accidental on chord note at end of bar
+c
+ nolevc = igetbits(icrdat(icrd),7,12)
+ do 58 kacc = 1 , naccbl(icm)
+ if (laccbl(icm,kacc) .eq. nolevc) go to 59
+58 continue
+ naccbl(icm) = naccbl(icm)+1
+ laccbl(icm,naccbl(icm)) = nolevc
+ jaccbl(icm,naccbl(icm)) = iashft(iacc)
+ end if
+59 continue
+57 continue
+ end if
+c if (lbacc(icm).eq.0 .and. accb4(icm)) then
+ do 65 kacc = 1 , naccim(icm)
+c
+c If naccim(icm)>0,
+c possible implicit accidental from earlier in the bar. Check for prior accid
+c in this bar at relevant note levels, main and chord notes. Only act if no
+c explicit action from just above. Assuming any accid on last note in bar,
+c either explicit or implicit, has same effect on 1st note of next bar.
+c
+ if (nolev(ivx,ip) .eq. laccim(icm,kacc)) go to 66
+ if (btest(ipl(ivx,ip),10)) then
+ do 67 icrd = icrd1 , icrd2
+ if (iand(ishft(icrdat(icrd),-12),127) .eq.
+ * laccim(icm,kacc)) go to 66
+67 continue
+ end if
+ go to 65
+66 continue
+c
+c So far we know there is a main or chord note at level laccim(icm,kacc). So
+c it will get a bl-accid if it didn't just already get one.
+c
+ do 68 macc = 1 , naccbl(icm)
+ if (laccbl(icm,macc) .eq. laccim(icm,kacc)) go to 65
+68 continue
+ naccbl(icm) = naccbl(icm)+1
+ laccbl(icm,naccbl(icm)) = laccim(icm,kacc)
+ jaccbl(icm,naccbl(icm)) = jaccim(icm,kacc)
+65 continue
+ end if
+ end if
+1199 continue
+11 continue
+c
+c Close out the notes group
+c
+ call addstr(sq//'en',3,soutq,lsout)
+ if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%'
+16 continue
+c
+c Check for way-after graces at end of bar. We could not link these to notes
+c as in midbar since there is no note following grace! Also, set flag if
+c hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop.
+c
+ isgrace = .false.
+ do 75 iv = 1 , nv
+ nvmxsav(iv) = nvmx(iv)
+ do 7599 kv = 1 , nvmx(iv)
+ ivmxsav(iv,kv) = ivmx(iv,kv)
+ ivx = ivmx(iv,kv)
+ ptsgnd = 0.
+ if ((btest(ipl(ivx,nn(ivx)),29).or.btest(ipl(ivx,nn(ivx)),31))
+ * .and. ptsndg(ivx).gt.0.) then
+ flgndb = .true.
+ if (ptsndg(ivx) .gt. ptsgnd) then
+ ptsgnd = ptsndg(ivx)
+ eskgnd = eskndg(ivx)
+ end if
+ end if
+ if (btest(ipl(ivx,nn(ivx)),31)) then
+c
+c This voice has a way-after grace here at end of bar
+c
+ if (.not.isgrace) then
+c
+c This is the first one, so set up the string
+c
+ isgrace = .true.
+ ivlast = 1
+ soutq = sq//'znotes'
+ lsout = 7
+ end if
+ do 76 iiv = ivlast , iv-1
+ call addstr(sepsymq(iiv),1,soutq,lsout)
+76 continue
+ ivlast = iv
+c
+c No need to put in 'nextvoice', even if 2 lines/staff
+c
+ call dograce(ivx,nn(ivx),ptgr,soutq,lsout,ncmid(iv,nn(ivx)),
+ * nacc(ivx,nn(ivx)),ig,ipl(ivx,nn(ivx)),.true.,
+c 130324
+c * .false.,0,0,0,0,0,0,0.,ulq)
+ * .false.,0,0,0,0,0,0,0.,ulq,instno(iv))
+ end if
+7599 continue
+75 continue
+ if (isgrace) then
+ call addstr(sq//'en%',4,soutq,lsout)
+ if (islast .and. lsout .gt. 0) write(11,'(a)')soutq(1:lsout)
+ end if
+ lsout = 0
+c
+c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest
+c This has to be the only use of atnextbar
+c
+ if (ibar.eq.ibarmbr .and. islast) then
+ if (newmbrhgt) then
+ soutq = sq//'def'//sq//'mbrhgt{'
+ if (mbrhgt .le. -10) then
+ write(soutq(13:15),'(i3)')mbrhgt
+ lsout = 15
+ else if (mbrhgt.ge.10.or.mbrhgt.le.-1) then
+ write(soutq(13:14),'(i2)')mbrhgt
+ lsout = 14
+ else
+ soutq = soutq(1:12)//char(48+mbrhgt)
+ lsout = 13
+ end if
+ soutq = soutq(1:lsout)//'}%'
+ write(11,'(a)')soutq(1:lsout+2)
+ newmbrhgt = .false.
+ end if
+ soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes'
+ lsout = 22
+ notexq = sq//'mbrest'
+ lnote = 7
+ call istring(mbrest,noteq,len)
+ notexq = notexq(1:lnote)//noteq(1:len)
+ lnote = lnote+len
+ mtrspc = nint(xb4mbr)
+ xb4mbr = 0.
+ call istring(mtrspc,noteq,len)
+ notexq = notexq(1:lnote)//noteq(1:len)//'0'
+ lnote = lnote+len+1
+ do 62 iv = 1 , nv
+ call addstr(notexq,lnote,soutq,lsout)
+ if (iv .lt. nv) call addstr(sepsymq(iv),1,soutq,lsout)
+62 continue
+ call addstr(sq//'en}%',5,soutq,lsout)
+ write(11,'(a)')soutq(1:lsout)
+ lsout = 0
+ if (ishort .gt. 0) then
+ mbrsum = mbrsum+mbrest
+ nmbr = nmbr+1
+ end if
+ if (mbrest .gt. 1) then
+ ndig = int(alog10(mbrest-1+.01))+1
+ write(11,'(a14,i'//chax(48+ndig)//',a1)')
+ * sq//'advance'//sq//'barno',mbrest-1,'%'
+ end if
+ else if (iscwr) then
+c
+c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar
+c to check for new clef and add space by redefining \CenterBar
+c
+ centrests = .true.
+ call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout)
+ call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22,
+ * soutq,lsout)
+ do 60 iv = 1 , nv
+c added
+ lnote = 0
+c
+ do 61 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ if (cwrest(ivx)) then
+ call addstr(sq//'CenterBar{',11,soutq,lsout)
+ if (.not.cwrferm(ivx)) then
+ if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then
+c
+c Kluge to use new definitions for centered, stacked rests
+c
+ if (cwrq(ivx)(2:10).eq.'liftpause' .or.
+ * cwrq(ivx)(2:10).eq.'liftPAuse')
+ * cwrq(ivx)(10:10) = 'c'
+ end if
+ call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq,
+ * lsout)
+ call addstr('}{-2}{'//sq//'value}',13,soutq,lsout)
+ else
+c
+c Fermata on centered rest. Will need to fix up level.
+c 12/6/07 shift it left so it's centered over rest
+c
+ notexq = notexq(1:lnote)//sq//'loffset{.33}{'
+ * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx))
+ * //'}{-2}{'//sq//'value}'
+ lnote = lnote+26+lcwr(ivx)+13
+ call addstr(notexq,lnote,soutq,lsout)
+ cwrferm(ivx) = .false.
+ end if
+ end if
+61 continue
+ if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout)
+60 continue
+ if (islast) then
+ call addstr(sq//'en}%',5,soutq,lsout)
+ if (lsout.gt.0)write(11,'(a)')soutq(1:lsout)
+ end if
+ end if
+c
+c End of block for centered whole-bar rests and multi-bar rests
+c
+c If at end of block, save durations of last notes in bar, for possible use
+c if clef changes at start of next bar
+c
+ if (ibar .eq. nbars) then
+ do 63 iv = 1 , nv
+ do 6399 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ prevtn(ivx) = tnote(ipl2(ivx,nn(ivx)))
+6399 continue
+63 continue
+ end if
+c
+c Update time for midi. This is only used for the event track
+c
+ if (ismidi) then
+ miditime = miditime+15*lenbar
+c
+c If pickup, write the real time signature to the event track. Cannot use
+c mtrnuml since it was reset to 0, have to recompute it
+c
+ if (lenb0 .eq. lenbar)
+ * call midievent('m',mtrdenl*lenb1/64,mtrdenl)
+ end if
+ return
+ end
+ subroutine makeabar()
+c
+c On input, have pseudo-durations in nodur(ivx,ip). Not real durations for
+c xtups, since only last note of xtup gets non-zero nodur, which
+c corresponds to single note of full length of xtup.
+c In this subroutine we make an ordered list of all notes in all voices.
+c ilnc = list note counter
+c ivxo(ilnc), ipo(ilnc) = voice# and position in voice of ilnc-th note.
+c to(ilnc) = real start time of note in PMX-units (64=whole note)
+c tno(ilnc) = time to next event in the bar.
+c tnote(ilnc) = actual duration of note
+c Then run thru list, grouping consecutive notes into \notes groups ib.
+c space(ib) = real time unit for the \notes group
+c squez(ib) = factor on space to get effective space. This will be 1 if
+c there is a note exactly spanning each interval of space, and
+c <1 if not.
+c Details: let eon = elemskips per noteskip (like length). Basic formula is
+c eon = sqrt(space/2.)
+c If tgovern >= space, then
+c eon = sqrt(tgovern/2)*(space/tgovern) = space/sqrt(2*tgovern).
+c Time needed to give this eon using basic formula is
+c teq = space**2/tgovern
+c Factor on space to get teq is
+c squez(ib) = space/tgovern
+c The eon for each ib can then be computed based on time of space*squez.
+c Iff squez = 1, there is a note spanning every increment in the \notes group.
+c
+c tnminb = minimum time span in the bar for increments spanned by notes,
+c i.e., with squez=1. Use after parsing into line to decide if
+c spacing needs to be "flattened" among notes groups.
+c
+ common /comtol/ tol
+ parameter (nm=24,nkb=3999,maxblks=9600)
+ common /a1ll/ iv,ivxo(600),ipo(600),to(600),tno(600),nnl(nm),
+ * nv,ibar,mtrnuml,nodur(nm,200),lenbar,iccount,
+ * nbars,itsofar(nm),nib(nm,15),nn(nm),
+ * rest(nm,200),lenbr0,lenbr1,firstline,newmeter
+ common /linecom/ elskb,tnminb(nkb)
+ common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
+ * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
+ * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
+ common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
+ logical rest,firstline,newmeter
+ integer cnn(nm),istart(80),istop(80)
+ real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600)
+ elskb = 0.
+ tnminb(ibarcnt) = 1000.
+ do 1 iv = 1 , nv
+ do 1999 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ if (ibar .gt. 1) then
+ nn(ivx) = nib(ivx,ibar)-nib(ivx,ibar-1)
+ else
+ nn(ivx) = nib(ivx,ibar)
+ end if
+1999 continue
+1 continue
+c
+c initialize list note counter, time(iv), curr. note(iv)
+c
+ ilnc = 1
+ do 4 iv = 1 , nv
+ do 4999 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ cnn(ivx) = 1
+ ivxo(ilnc) = ivx
+ ipo(ilnc) = 1
+ to(ilnc) = 0.
+ tnote(ilnc) = fnote(nodur,ivx,1,nacc)
+ xit(ivx) = tnote(ilnc)
+ if (abs(xit(ivx)-lenbar).lt.tol) xit(ivx) = 1000.
+ ilnc = ilnc+1
+4999 continue
+4 continue
+c
+c Build the list
+c
+5 continue
+c
+c Determine which voice comes next from end of notes done so far.
+c tmin is the earliest ending time of notes done so far
+c
+ tmin = 1000.
+ do 6 iv = 1 , nv
+ do 6999 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ tminn = min(tmin,xit(ivx))
+ if(tminn .lt. tmin) then
+ tmin = tminn
+ ivnext = ivx
+ end if
+6999 continue
+6 continue
+ if (tmin .gt. 999.) go to 7
+ ivxo(ilnc) = ivnext
+ cnn(ivnext) = cnn(ivnext)+1
+ ipo(ilnc) = cnn(ivnext)
+ to(ilnc) = tmin
+c
+c Check if this voice is done
+c
+ tnote(ilnc) = fnote(nodur,ivnext,cnn(ivnext),nacc)
+ if (cnn(ivnext) .eq. nn(ivnext)) then
+ xit(ivnext) = 1000.
+ else
+ xit(ivnext) = xit(ivnext)+tnote(ilnc)
+ end if
+ ilnc = ilnc+1
+ go to 5
+7 continue
+ ntot = ilnc-1
+ if (ntot .gt. 600) then
+ call printl(' ')
+ call printl('Cannot have more than 600 notes per bar, stopping')
+ call stop1()
+ end if
+ do 8 in = 1 , ntot-1
+ tno(in) = to(in+1)-to(in)
+8 continue
+ tno(ntot) = fnote(nodur,ivxo(ntot),ipo(ntot),nacc)
+ tnote(ntot) = tno(ntot)
+c
+c Debug writes
+c
+c write(*,'()')
+c write(*,'(16i5)')(ivxo(in),in=1,ntot)
+c write(*,'(16i5)')(ipo(in),in=1,ntot)
+c write(*,'(16f5.1)')(to(in),in=1,ntot)
+c write(*,'(16f5.1)')(tno(in),in=1,ntot)
+c write(*,'(16i5)')(nodur(ivxo(in),ipo(in)),in=1,ntot)
+c write(*,'(16f5.1)')(tnote(in),in=1,ntot)
+c
+c Done w/ list. Initialize loop for building note blocks:
+c
+ ib = 1
+ istart(1) = 1
+ space(1) = 0.
+ in = 1
+c
+c Start the loop
+c
+9 continue
+ if (in .eq. ntot) then
+ if (space(ib) .lt. tol) then
+ space(ib) = tno(in)
+c
+c Last gap in bar is spanned by a note, so cannot need a squeeze.
+c
+ squez(ib) = 1.
+ end if
+ istop(ib) = ntot
+c
+c From here flow out of this if block and into block-setup
+c
+ else if (space(ib) .lt. tol) then
+c
+c space hasn't been set yet, so tentatively set:
+c
+ space(ib) = tno(in)
+ if (space(ib) .lt. tol) then
+ in=in+1
+ else
+c
+c Tentative space tno(in) is non-zero. Set squez, which will be kept (since
+c it is a unique property of the particular increment starting here) :
+c
+ squez(ib) = getsquez(in,ntot,space(ib),tnote,to)
+ istop(ib) = in
+ end if
+ go to 9
+ else if (tno(in+1) .lt. tol) then
+c
+c This is not the last note in the space, so
+c
+ in = in+1
+ go to 9
+ else if (abs(tno(in+1)-space(ib)) .lt. tol) then
+c
+c Next increment has same space. Does it have same squez?
+c
+ xsquez = getsquez(in+1,ntot,space(ib),tnote,to)
+c
+c If it does have the same squez, loop, otherwise flow out
+c
+ if (abs(xsquez-squez(ib)) .lt. tol) then
+c
+c Keep spacing the same, update tentative stop point
+c
+ in = in+1
+ istop(ib) = in
+ go to 9
+ end if
+ end if
+c
+c At this point istart, istop, space, and squez are good, so close out block
+c
+ tstart(ib) = to(istart(ib))
+c
+c Compute elemskips assuming no flattening to increase min space. The formula
+c is only correct if f1eon(t) = sqrt(t/2); more generally (after possible
+c flattening in pmxb), elsperns = squez*feon(space/squez)
+c
+ elsperns = f1eon(space(ib)*squez(ib))
+ if (istop(ib) .eq. ntot) then
+ nnsk = nint((lenbar-tstart(ib))/space(ib))
+ else
+ nnsk = nint((to(istop(ib)+1)-tstart(ib))/space(ib))
+ end if
+ elskb = elskb+elsperns*nnsk
+ if (nptr(ibarcnt+1) .gt. nptr(ibarcnt)) then
+ call catspace(space(ib),squez(ib),nnsk)
+ else
+c
+c This is the first entry for this bar
+c
+ nnpd(nptr(ibarcnt)) = nnsk
+ durb(nptr(ibarcnt)) = space(ib)
+ sqzb(nptr(ibarcnt)) = squez(ib)
+ nptr(ibarcnt+1) = nptr(ibarcnt+1)+1
+ end if
+c
+c Update minimum space spanned by a note
+c
+ if (abs(squez(ib)-1) .lt. tol)
+ * tnminb(ibarcnt) = min(tnminb(ibarcnt),space(ib))
+ if (istop(ib) .eq. ntot) go to 15
+c
+c End of spatial accounting for now
+c
+ ib = ib+1
+ istart(ib) = istop(ib-1)+1
+ in = istart(ib)
+c
+c Set tentative block space for new block
+c
+ space(ib) = tno(in)
+ if (space(ib).gt.tol)
+ * squez(ib)= getsquez(in,ntot,space(ib),tnote,to)
+ istop(ib) = in
+ go to 9
+15 continue
+c nb = ib
+c
+c Debug writes
+c
+c write(*,'(16i5)')(istart(ib),ib=1,nb)
+c write(*,'(16i5)')(istop(ib),ib=1,nb)
+c write(*,'(16f5.1)')(space(ib),ib=1,nb)
+c write(*,'(16f5.1)')(squez(ib),ib=1,nb)
+c
+ return
+ end
+ subroutine midievent(typeq,in1,in2)
+c
+c We now store "conductor" events in mmidi(numchan,.), and count bytes
+c with imidi(numchan)
+c
+ parameter (nm=24,mv=24576)
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /comevent/ miditime,lasttime
+ character*1 typeq
+ idur = isetvarlen(miditime-lasttime,nbytes)
+ imidi(numchan) = imidi(numchan)+nbytes+1
+ do 1 i = 1 , nbytes
+ mmidi(numchan,imidi(numchan)-i) = mod(idur,256)
+ idur = ishft(idur,-8)
+1 continue
+ mmidi(numchan,imidi(numchan)) = 255
+ if (typeq .eq. 't') then
+c
+c Tempo event. in1 = quarters per minute (integer)
+c
+ mmidi(numchan,imidi(numchan)+1) = 5*16+1
+ mmidi(numchan,imidi(numchan)+2) = 3
+ misperq = nint(60000000./in1)
+ do 2 i = 1 , 3
+ mmidi(numchan,imidi(numchan)+6-i) = mod(misperq,256)
+ misperq = ishft(misperq,-8)
+2 continue
+ imidi(numchan) = imidi(numchan)+5
+ else if (typeq .eq. 'm') then
+c
+c Meter event. in1=numerator, in2=denom (power of 2)
+c
+ mmidi(numchan,imidi(numchan)+1) = 5*16+8
+ mmidi(numchan,imidi(numchan)+2) = 4
+ mmidi(numchan,imidi(numchan)+3) = in1
+ if (in2 .gt. 0) then
+ mmidi(numchan,imidi(numchan)+4) = log2(in2)
+ else
+ mmidi(numchan,imidi(numchan)+4) = 0
+ end if
+ mmidi(numchan,imidi(numchan)+5) = 24
+ mmidi(numchan,imidi(numchan)+6) = 8
+ imidi(numchan) = imidi(numchan)+6
+ else if (typeq .eq. 'k') then
+c
+c Keychange event. in1 = isig
+c
+ mmidi(numchan,imidi(numchan)+1) = 5*16+9
+ mmidi(numchan,imidi(numchan)+2) = 2
+ mmidi(numchan,imidi(numchan)+3) = mod(256+in1,256)
+ mmidi(numchan,imidi(numchan)+4) = 0
+ imidi(numchan) = imidi(numchan)+4
+ else
+ print*,'Program flameout in midievent'
+ call stop1()
+ end if
+ lasttime = miditime
+ return
+ end
+ subroutine moveln(iuin,iuout,done)
+ logical done
+ character*129 outq
+ done = .false.
+ read(iuin,'(a)',end=1) outq
+ lenout = llen(outq,129)
+ write(iuout,'(a)') outq(1:lenout)
+ return
+1 done = .true.
+ return
+ end
+ subroutine mrec1(lineq,iccount,ndxm)
+c
+c This is called when (a) macro recording is just starting and
+c (b) at the start of a new line, if recording is on
+c
+ parameter (maxblks=9600)
+ character*128 lineq,lnholdq
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ logical mrecord,mplay,endmac
+ common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
+ * ic1mac(20),ilmac,iplmac
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ if (.not.mrecord) then
+c
+c Starting the macro
+c
+ ip1mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount
+ il1mac(macnum) = ilbuf-1
+ ic1mac(macnum) = iccount
+ mrecord = .true.
+ end if
+ if (iccount .lt. 128) then
+ ndxm = index(lineq(iccount+1:128),'M')
+ if (ndxm .gt. 0) ndxm = ntindex(lineq(iccount+1:128),'M',
+ * 128-iccount)
+ if (ndxm .gt. 0) then
+c
+c This line ends the macro.
+c
+ ip2mac(macnum) = ipbuf-lbuf(ilbuf-1)+iccount+ndxm
+ il2mac(macnum) = ilbuf-1
+ mrecord = .false.
+ end if
+ end if
+ return
+ end
+ function ncmid(iv,ip)
+ parameter (nm=24)
+ common /all/ mult(nm,200),jv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtol/ tol
+ if (ncc(iv) .eq. 1) then
+ ncmid = ncmidcc(iv,1)
+ else
+ xtime = to(ipl2(ivx,ip))
+ do 1 icc = ncc(iv) , 1 , -1
+ if (xtime .gt. tcc(iv,icc)-tol) then
+ ncmid = ncmidcc(iv,icc)
+ return
+ end if
+1 continue
+ print*,'Problem in ncmid()'
+ stop
+ end if
+ end
+ function ncmidf(clefq)
+c
+c Return middle line of a clef
+c
+ character*1 clefq
+ if (clefq .eq. '8') then
+c
+c treblelowoct; will treat as treble for this purpose
+c
+ ncmidf = 35
+ else
+ ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2
+ end if
+ return
+ end
+ subroutine newvoice(jv,clefq,change)
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ character*1 ulfbq,clefq
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ logical change,autofbon
+ nvmx(jv) = 1
+ ivmx(jv,1) = jv
+ itsofar(jv) = 0
+ nnl(jv) = 0
+ nfb(jv) = 0
+ if (firstgulp .or. change) then
+ ncmidcc(jv,1) = ncmidf(clefq)
+ else
+ ncmidcc(jv,1) = ncmidcc(jv,ncc(jv))
+ end if
+ tcc(jv,1) = 0.
+ ncc(jv) = 1
+ nudoff(jv) = 0
+ ndotmv(jv) = 0
+ do 5 j = 1 , 200
+ irest(jv,j) = 0
+ islur(jv,j) = 0
+ ipl(jv,j) = 0
+ nacc(jv,j) = 0
+ iornq(jv,j) = 0
+ mult(jv,j) = 0
+ if (jv.le.2) isfig(jv,j) = .false.
+5 continue
+ return
+ end
+ subroutine notefq(noteq,lnote,nolev,ncmid)
+c
+c Returns name of note level with octave transpositions, updates noctup.
+c
+ common /comoct/ noctup
+ character*8 noteq
+ character*1 upcaseq,noteqt,chax
+ nupfroma = mod(nolev+1,7)
+ iname = 97+nupfroma
+ ioctup = (nolev+1)/7-4
+ noteqt = chax(iname)
+ if (ncmid .eq. 23) noteqt = upcaseq(noteqt)
+ if (ioctup .eq. noctup) then
+ noteq = noteqt
+ lnote = 1
+c
+c Must ALWAYS check if lnote=1 for use with functions requiring a blank
+c
+ else if (ioctup .gt. noctup) then
+c
+c Raise octave. Encase in {}
+c
+ write(noteq,'(8a1)')'{',(chax(39),i=noctup,ioctup-1),
+ * noteqt,'}'
+ lnote = 3+ioctup-noctup
+ noctup = ioctup
+ else
+c
+c Lower octave
+c
+ write(noteq,'(8a1)')'{',(chax(96),i=ioctup,noctup-1),
+ * noteqt,'}'
+ lnote = 3+noctup-ioctup
+ noctup = ioctup
+ end if
+ return
+ end
+ subroutine notex(notexq,lnote)
+c
+c Returns non-beamed full note name
+c
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,
+ * isfig,ispoi,btest,even
+ character*1 udq,udqq,chax
+ character*4 dotq
+ character*2 numq
+ character*79 notexq
+ character*8 noteq
+ character*40 restq
+ common /compoi/ ispoi
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ character*10 figq
+ ip = ipo(jn)
+ nole = nolev(ivx,ip)
+c
+c Check for special situations with 2nds (see precrd)
+c
+ if (btest(nacc(ivx,ip),30)) then
+ nole = nole - 1
+ else if (btest(nacc(ivx,ip),31)) then
+ nole = nole + 1
+ end if
+ nodu = nodur(ivx,ip)
+ if (.not.btest(irest(ivx,ip),0)) then
+ udq = udqq(nole,ncmid(iv,ip),
+ * islur(ivx,ip),nvmx(iv),ivx,nv)
+ end if
+c
+c Check figure level
+c
+c if (figbass .and. isfig(ivx,ip)
+c * .and. .not.btest(irest(ivx,ip),0)) then
+ if (figbass .and. .not.btest(irest(ivx,ip),0) .and.
+ * ((ivx.eq.1.and.isfig(1,ip))
+ * .or.(ivx.eq.ivxfig2.and.isfig(2,ip)))) then
+ if (udq .eq. 'u' .or. nodu.ge.64) then
+c
+c Upper or no stem, fnole (in noleunits) set by notehead
+c
+ fnole = nole
+ else
+c
+c Lower stem, fnole set by bottom of stem
+c
+ fnole = nole-stemlen
+ end if
+ zmin = fnole-ncmid(ivx,ip)+4
+ if (ivx .eq. 1) then
+ ifigdr(1,iline) = max(ifigdr(1,iline),nint(4-zmin))
+ else
+ ifigdr(2,iline) = max(ifigdr(2,iline),nint(4-zmin))
+ end if
+ end if
+ if (.not.btest(irest(ivx,ip),0)) then
+ call notefq(noteq,lnoten,nole,ncmid(iv,ip))
+ if (lnoten .eq. 1) call addblank(noteq,lnoten)
+ if (nodu .eq. 1) then
+ notexq =sq//'cccc'//udq//noteq(1:lnoten)
+ lnote = lnoten+6
+ else if (nodu .eq. 2) then
+ notexq =sq//'ccc'//udq//noteq(1:lnoten)
+ lnote = lnoten+5
+ else if (nodu .eq. 4) then
+ notexq =sq//'cc'//udq//noteq(1:lnoten)
+ lnote = lnoten+4
+ else if (nodu .eq. 8) then
+ notexq =sq//'c'//udq//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (nodu .eq. 16) then
+ notexq =sq//'q'//udq//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (nodu .eq. 32) then
+ notexq =sq//'h'//udq//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (nodu .eq. 64) then
+ notexq =sq//'wh'//noteq(1:lnoten)
+ lnote = lnoten+3
+ else if (nodu .eq. 128) then
+c notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk'
+c lnote = lnoten+10
+ notexq =sq//'breve'//noteq(1:lnoten)
+ lnote = lnoten+6
+ else
+ dotq = 'p'
+ ldot = 1
+ if (btest(iornq(ivx,ip),13)) then
+c
+c Dotted note with ')' ornament
+c
+ dotq='m'
+ else if (btest(islur(ivx,ip),3)) then
+c
+c Double dot
+c
+ dotq = 'pp'
+ ldot = 2
+ end if
+ if (nodu .ge. 192) then
+ notexq =sq//'breve'//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+6+ldot
+ else if (nodu .ge. 96) then
+ notexq =sq//'wh'//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+3+ldot
+ else if (nodu .ge. 48) then
+ notexq =sq//'h'//udq//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+3+ldot
+ else if (nodu .ge. 24) then
+ notexq =sq//'q'//udq//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+3+ldot
+ else if (nodu .ge. 12) then
+ notexq =sq//'c'//udq//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+3+ldot
+ else if (nodu .ge. 6) then
+ notexq =sq//'cc'//udq//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+4+ldot
+ ispoi = .true.
+ else
+ notexq =sq//'ccc'//udq//dotq(1:ldot)//noteq(1:lnoten)
+ lnote = lnoten+5+ldot
+ ispoi = .true.
+ end if
+ if (dotq(1:1) .eq. 'm') then
+c
+c Need another call to the note, in case the first one has octave shifts
+c
+ if (lnoten .eq. 2) then
+ notexq = notexq(1:lnote)//'{'//noteq(2:2)//'}'
+ lnote = lnote+3
+ else
+ notexq = notexq(1:lnote)//noteq(lnoten-1:lnoten-1)
+ lnote = lnote+1
+ end if
+ end if
+ end if
+ else if (btest(islur(ivx,ip),29)) then
+c
+c Blank rest
+c
+ notexq = sq//'sk'
+ lnote = 3
+ else
+c
+c Non-blank rest
+c
+ lnote = 0
+ nole = mod(nole+20,100)-20
+c
+c Kluge to get pause symbol for rp:
+c
+ if (btest(islur(ivx,ip),19)) nodu = 64
+ if (nodu .le. 28) then
+c
+c Normal rest < or = double-dotted quarter
+c
+ lrest = 3
+ if (nodu .gt. 14) then
+ restq =sq//'qp'
+ else if (nodu .gt. 7) then
+ restq =sq//'ds'
+ else if (nodu .gt. 3) then
+ restq =sq//'qs'
+ else if (nodu .gt. 1) then
+ restq =sq//'hs'
+ else
+ restq =sq//'qqs'
+ lrest = 4
+ end if
+c
+c Special case for rest at start of F-tuplet inside a forced beam
+c
+ if (btest(nacc(ivx,ip),18) .and.
+ * btest(nacc(ivx,ip),19)) then
+ restq = sq//'pt4'//restq(1:lrest)
+ lrest = lrest+4
+ end if
+ notexq = restq
+ lnote = lrest
+c
+c At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc.
+c
+ if (nole .ne. 0) then
+ if (abs(nole) .lt. 10) then
+ noteq = chax(48+abs(nole))
+ lnoten = 1
+ else
+ write(noteq(1:2),'(i2)')abs(nole)
+ lnoten = 2
+ end if
+ if (nole .gt. 0) then
+ notexq = sq//'raise'//noteq(1:lnoten)//sq//'internote'
+ else
+ notexq = sq//'lower'//noteq(1:lnoten)//sq//'internote'
+ end if
+ lnote = 16+lnoten
+ notexq = notexq(1:lnote)//restq(1:lrest)
+ lnote = lnote+lrest
+ end if
+ if (2**log2(nodu) .ne. nodu) then
+c
+c Deal with dots (on rests shorter than half rest)
+c
+ restq = sq//'pt'
+ lrest = 3
+ if (2*nodu .gt. 3*2**log2(nodu)) then
+ restq = sq//'ppt'
+ lrest = 4
+ end if
+ nole = nole+4
+ raisedot = 0
+c
+c Tweak dot positions for special cases
+c
+ even = (mod(100+nole,2).eq.0)
+c if (.not.even.and.nodu.gt.8.and.
+c * (nole.lt.0.or.nole.gt.8)) then
+ if (.not.even .and. (nole.lt.0.or.nole.gt.8)) then
+ raisedot = 1
+ end if
+ if (nole.ge.10 .or. nole.le.-1) then
+ write(numq,'(i2)')nole
+ restq = restq(1:lrest)//'{'//numq//'}'
+ lrest = lrest+4
+ else
+ restq = restq(1:lrest)//chax(nole+48)
+ lrest = lrest+1
+ end if
+ if (raisedot.gt.0) then
+ restq = sq//'raise'//sq//'internote'//
+ * sq//'hbox{'//restq(1:lrest)//'}'
+ lrest = lrest+23
+ end if
+ notexq = restq(1:lrest)//notexq(1:lnote)
+ lnote = lnote+lrest
+ end if
+ else
+c
+c Half rest or longer
+c
+ if (nole .eq. 0) then
+c
+c Half or longer rest is not raised or lowered
+c
+ if (nodu .le. 56) then
+ notexq =sq//'hpause'
+ lnote = 7
+ else if (nodu .le. 112) then
+ if (.not.btest(islur(ivx,ip),19) .or.
+ * btest(irest(ivx,ip),25)) then
+ notexq = sq//'pause'
+ else
+ notexq = sq//'pausc'
+ end if
+ lnote = 6
+ else
+ notexq =sq//'PAuse'
+ lnote = 6
+ end if
+ if (2**log2(nodu) .ne. nodu) then
+c
+c Dotted rest, hpause or longer
+c
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ if (2*nodu .gt. 3*2**log2(nodu)) then
+c
+c Double dotted long rest
+c
+ notexq = notexq(1:lnote)//'p'
+ lnote = lnote+1
+ end if
+ end if
+ else
+c
+c Raised or lowered half or whole rest
+c
+ if (nodu .eq. 32) then
+ notexq = sq//'lifthpause'
+ lnote = 11
+ else if (nodu .eq. 48) then
+ notexq = sq//'lifthpausep'
+ lnote = 12
+ else if (nodu .eq. 56) then
+ notexq = sq//'lifthpausepp'
+ lnote = 13
+ else if (nodu .eq. 64) then
+ notexq = sq//'liftpause'
+ lnote = 10
+ else if (nodu .eq. 96) then
+ notexq = sq//'liftpausep'
+ lnote = 11
+ else if (nodu .eq. 112) then
+ notexq = sq//'liftpausepp'
+ lnote = 12
+ else if (nodu .eq. 128) then
+ notexq = sq//'liftPAuse'
+ lnote = 10
+ else
+c
+c Assume dotted double whole rest
+c
+ notexq = sq//'liftPAusep'
+ lnote = 11
+ end if
+c
+c Set up height spec
+c
+ nole = sign(abs(nole)/2,nole)
+ if (nole.le.9 .and. nole.ge.0) then
+ noteq = chax(48+nole)
+ lnoten = 1
+ else
+ noteq = '{'
+ if (nole .ge. -9) then
+ write(noteq(2:3),'(i2)')nole
+ lnoten = 3
+ else
+ write(noteq(2:4),'(i3)')nole
+ lnoten = 4
+ end if
+ noteq = noteq(1:lnoten)//'}'
+ lnoten = lnoten+1
+ end if
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ end if
+ end if
+ end if
+ return
+ end
+ function ntindex(line,s2q,lenline)
+c
+c Returns index(line,s2q) if NOT in TeX string, 0 otherwise
+c
+ character*(*) s2q,line
+ character*1 chax
+ logical intex
+ ndxs2 = index(line,s2q)
+ ndxbs = index(line,chax(92))
+ if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then
+ ntindex = ndxs2
+ else
+c
+c There are both bs and s2q, and bs is to the left of sq2. So check bs's to
+c right of first: End is '\ ', start is ' \'
+c
+ len = lenstr(line,lenline)
+ intex = .true.
+ do 1 ic = ndxbs+1 , len
+ if (ic .eq. ndxs2) then
+ if (intex) then
+ ntindex = 0
+ ndxs2 = index(line(ic+1:len),s2q)+ic
+ else
+ ntindex = ndxs2
+ return
+ end if
+ else if (intex .and. line(ic+1:ic+2).eq.chax(92)//' ') then
+ intex = .false.
+ else if (.not.intex .and. line(ic+1:ic+2).eq.' '//chax(92))
+ * then
+ intex = .true.
+ end if
+1 continue
+ end if
+ return
+ end
+ subroutine ntrbbb(n,char1q,ulqq,iv,notexq,lnote)
+c
+c This appends to notexq e.g. '\ibbbu1'
+c
+ common /combbm/ isbbm
+ logical isbbm
+ character*79 notexq
+ character*1 char1q,ulqq,chax
+ character*4 tempq
+ if (n .ge. 5) isbbm = .true.
+ if (lnote .gt. 0) then
+ notexq = notexq(1:lnote)//chax(92)//char1q
+ else
+ notexq = chax(92)//char1q
+ end if
+ lnote = lnote+2
+ do 3 im = 1 , n
+ notexq = notexq(1:lnote)//'b'
+ lnote = lnote+1
+3 continue
+c
+c add the number, 0 if 12
+c
+c 5/25/08 Allow >12
+c
+c call istring(mod(iv,12),tempq,len)
+ if (iv .lt. 24) then
+ call istring(iv,tempq,len)
+ else if (iv .eq. 24) then
+ tempq(1:1) = '0'
+ len = 1
+ else
+ call printl('Sorry, too man open beams')
+ call stop1()
+ end if
+ notexq = notexq(1:lnote)//ulqq//tempq(1:len)
+ lnote = lnote+1+len
+ return
+ end
+ function numclef(clefq)
+c
+c Returns the number to be used as argument of \setclef for MusiXTeX
+c For input 0-6 or tsmanrb return 0-7
+c 7 f 9
+c 8 0
+c
+ character*1 clefq
+ if (ichar(clefq) .lt. 55) then
+c if (ichar(clefq) .le. 55) then
+ numclef = ichar(clefq)-48
+c if (numclef .eq. 7) numclef = 9
+ else if (clefq .eq. '7') then
+ numclef = 9
+ else if (clefq .eq. '8') then
+ numclef = 0
+ else
+ numclef = index('tsmanrbxxf',clefq)-1
+ end if
+ return
+ end
+ subroutine outbar(i,jlast)
+ character*1 chax
+ nfmt = log10(i+.5)+2
+ if (jlast+5+nfmt .lt. 80) then
+ write(*,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i
+ write(15,'(a5,i'//chax(48+nfmt)//',$)')' Bar',i
+ jlast = jlast+5+nfmt
+ else
+ write(*,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i
+ write(15,'(/,a5,i'//chax(48+nfmt)//',$)')' Bar',i
+ jlast = 5+nfmt
+ end if
+ return
+ end
+ subroutine pmxa(basenameq,lbase,isfirst,nsyout,nbarss,optimize)
+cccccccccccccccccccccccccccccccccccccccccccccccc
+cc cc
+cc Subroutine, combine with pmxb.for
+cc
+cccccccccccccccccccccccccccccccccccccccccccccccc
+cc
+cc Need to consider X spaces in xtuplets when getting poenom, and
+cc maybe fbar?
+cc mx06a
+cc ID numbers for voices when number of voices is reduced.
+cc
+cc mx03a
+cc account for new fracindent for new movements.
+cc
+cc Known changes since pmxa. Version 1.1b (see pmxb for longer list)
+cc
+cc Check ID codes for slurs.
+cc Version 1.24 still does not have details for spacing/positioning
+cc arpeggios if there are accidentals or shifted notes or crowded scores.
+cc Fix problem in 1.22 with arpeggios across multi-line staves
+cc Fix problem in 1.22 with flat key signatures
+cc Read setup data as strings
+cc Warning for octave designation plus +/-
+cc Don't pause for volta warning,
+cc Macros
+cc Correct fsyst to account for transposition and key changes.
+cc Check for nbars > nsyst
+cc
+ccccccccccccccccccccccccccccccccccc
+ parameter (nm=24,nkb=3999,nks=125,maxblks=9600)
+ logical loop,usefig,isfirst,optimize
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ integer nn(nm),nodur(nm,200),ivxo(600),ipo(600),
+ * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks)
+ common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks),
+ * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr,
+ * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks)
+ common /compage/ widthpt,ptheight,hoffpt,voffpt,
+ * nsyst,nflb,ibarflb(0:40),
+ * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18),
+ * usefig,fintstf,gintstf,fracsys(30),nmovbrk,isysmb(0:30),
+ * nistaff(0:40)
+ common /comkeys/ nkeys,ibrkch(18),newkey(18),iskchb,idsig,isig1,
+ * mbrestsav,kchmid(18),ornrpt,shifton,barend,noinst,stickyS
+ real*4 elsk(nkb),celsk(0:nkb),elss(nks),to(600),tno(600)
+ character*128 lnholdq
+ character*44 basenameq
+ logical rest(nm,200),firstline,fbon,isvolt,iskchb,kchmid,ornrpt,
+ * stickyS
+ common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt,
+ * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0
+ logical lastchar,newmeter,newmb(nkb),issegno,bottreb,isheadr,
+ * shifton,barend
+ common /a1ll/ iv,ivxo,ipo,to,tno,nnl,nv,ibar,mtrnuml,
+ * nodur,lenbar,iccount,nbars,itsofar,nib,nn,
+ * rest,lenbr0,lenbr1,firstline,newmeter
+ common /linecom/ elskb,tnminb(nkb)
+ common /cblock/
+ * etatop,etabot,etait,etatc,etacs1,hgtin,hgtti,hgtco,
+ * xilbn,xilbtc,xilhdr,xilfig,a,b,inhnoh
+ common /cominbot/ inbothd
+ common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200)
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ common /commus/ musize,whead20
+ common /comeon/ eonk,ewmxk
+ logical mrecord,mplay,endmac,cstuplet
+ logical novshrinktop,upslur,fontslur,WrotePsslurDefaults
+ common /comnvst/ novshrinktop,cstuplte
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /comligfont/ isligfont
+ logical isligfont
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ logical fulltrans
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
+ * poefa
+ real*4 poefa(125)
+ logical nocodabn
+ data wtimesig,wclef,wkeysig
+ * / 0.72 , 0.8 , 0.28 /
+c data poefa /125*1./
+c This corrected a problem in Bob Tennent's compilation of pmx2.94
+c
+ do 97 i = 1 , 125
+ poefa(i) = 1.
+97 continue
+ is4bignv = .false.
+ AIset = .false.
+ whead20 = 0.3
+ ishort = 0
+ if (.not.optimize) then
+ print*
+ print*,'Starting first PMX pass'
+ write(15,'(a)') ' Starting first PMX pass'
+ end if
+ if (isfirst) then
+ open(19,file='pmxaerr.dat')
+ write(19,'(i6)') 0
+ close(19)
+ end if
+ if (.not.optimize) jprntb = 81
+ macuse = 0
+ ornrpt = .false.
+ stickyS = .false.
+ mrecord = .false.
+ mplay = .false.
+ lastchar = .false.
+ novshrinktop = .false.
+ cstuplet = .false.
+ fontslur = .true.
+ isligfont = .false.
+ fulltrans = .false.
+ do 42 ibarcnt = 1 , nkb
+ udsp(ibarcnt) = 0.
+ wminnh(ibarcnt) = -1.
+42 continue
+c
+c Initialize input buffer
+c
+ lenbuf0 = ipbuf
+ ipbuf = 0
+ ilbuf = 1
+ call g1etset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,
+ * xmtrnum0,newkey(1),npages,nsyst,musize,bottreb)
+c
+c Set up list of instrument numbers (iv)
+c
+ ivnow = 0
+ do 13 instnow = 1 , noinst
+ do 14 iscount = 1 , nsperi(instnow)
+ ivnow = ivnow+1
+ instno(ivnow) = instnow
+14 continue
+13 continue
+c
+c Save initial meter for midi
+c
+ if (.not.isfirst .and. npages.eq.0) then
+ print*,'Sorry, must have npages>0 for optimization.'
+ call stop1()
+ end if
+ nsyout = nsyst
+c
+c isig1 will be changed in getnote if there is a transposition
+c
+ isig1 = newkey(1)
+ if (npages .gt. nsyst) then
+ call printl('npages > nsyst in input. Please fix the input.')
+ call stop1()
+ end if
+c
+c fbar = afterruleskip/elemskip
+c apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt
+c
+ fbar = 1.
+ wheadpt = whead20*musize
+ ifig = 0
+ usefig = .true.
+ lenbeat = i1fnodur(mtrdenl,'x')
+ lenmult = 1
+ if (mtrdenl .eq. 2) then
+ lenbeat = 16
+ lenmult = 2
+ end if
+ lenbr1 = lenmult*mtrnuml*lenbeat
+ lenbr0 = nint(lenmult*xmtrnum0*lenbeat)
+ mtrnuml = 0
+ if (lenbr0 .ne. 0) then
+ ibaroff = 1
+ lenbar = lenbr0
+ else
+ ibaroff = 0
+ lenbar = lenbr1
+ end if
+ ibarcnt = 0
+ nptr(1) = 1
+ iccount = 128
+ nmovbrk = 0
+ nflb = 0
+ nfpb = 0
+ ipagfpb(0) = 1
+ isysfpb(0) = 1
+ ibarflb(0) = 1
+ isysflb(0) = 1
+ nistaff(0) = nv-1
+c
+c Check for pmx.mod
+c
+ linesinpmxmod = 0
+c line1pmxmod = ilbuf
+ call getpmxmod(.true.,' ')
+ if (.not.isfirst .and. linesinpmxmod .gt. 0) then
+ print*,'Sorry, cannot optimize if there is a pmx.mod file'
+ call stop1()
+ end if
+c
+c Initialize for loop over lines
+c
+ nkeys = 1
+ ibrkch(1) = 1
+ mbrestsav = 0
+ shifton = .false.
+ firstline = .true.
+ newmeter = .false.
+ ihead = 0
+ isheadr = .false.
+ idsig = 0
+ iddot = 0
+ fintstf = -1.
+ gintstf = 1.0
+ listcresc = 0
+ listdecresc = 0
+30 loop = .true.
+ iskchb = .false.
+ issegno = .false.
+ nbars = 0
+ ibarmbr = 0
+ do 4 iv = 1 , nv
+ nvmx(iv) = 1
+ ivmx(iv,1) = iv
+ itsofar(iv) = 0
+ nnl(iv) = 0
+ do 5 j = 1 , 200
+ rest(iv,j) = .false.
+ nacc(iv,j) = 0.
+5 continue
+4 continue
+ iv = 1
+ ivx = 1
+ fbon = .false.
+ barend = .false.
+ isvolt = .false.
+2 if (loop) then
+c
+c Within this short loop, nv voices are filled up for the duration of a block.
+c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
+c nodur(..),rest(..). nnl will later be
+c increased and things slid around as accidental skips are added.
+c
+ call g1etnote(loop,ifig,optimize,fulltrans)
+ if (lastchar) go to 20
+ go to 2
+ end if
+ if (mbrestsav .gt. 0) then
+ call printl(' ')
+ call printl(
+ * 'You must enter the same multibar rest in ALL parts')
+ call stop1()
+ end if
+ do 10 ibar = 1 , nbars
+ ibarcnt = ibarcnt+1
+c
+c The following is just a signal to start a new bar when cataloging spaces
+c for catspace(...)
+c
+ nptr(ibarcnt+1) = nptr(ibarcnt)
+ newmb(ibarcnt) = .false.
+ if (newmeter.and.ibar.eq.1) newmb(ibarcnt) = .true.
+c
+c Above is only for spacing calcs later on. Remember new meter can only occur
+c at START of a new input line (ibar = 1)
+c
+ if (ibar .ne. ibarmbr) then
+ if (.not.optimize) call outbar(ibarcnt-ibaroff,jprntb)
+ else
+ if (.not.optimize) then
+ write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
+ * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
+ write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
+ * ibarcnt-ibaroff,'-',ibarcnt-ibaroff+mbrest-1
+ jprntb = 0
+ end if
+ ibaroff = ibaroff-mbrest+1
+ end if
+ if (firstline .and. lenbr0.ne.0) then
+ if (ibar .eq. 1) then
+ lenbar = lenbr0
+ else
+ lenbar = lenbr1
+ end if
+ end if
+ if (ibar .gt. 1) then
+c
+c For bars after first, slide all stuff down to beginning of arrays
+c
+ do 11 iv = 1 , nv
+ do 1199 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ ioff = nib(ivx,ibar-1)
+ do 12 ip = 1 , nib(ivx,ibar)-ioff
+ nodur(ivx,ip) = nodur(ivx,ip+ioff)
+ rest(ivx,ip) = rest(ivx,ip+ioff)
+ nacc(ivx,ip) = nacc(ivx,ip+ioff)
+12 continue
+1199 continue
+11 continue
+ end if
+ do 67 iv = 1 , nv
+ do 6799 kv = 1 , nvmx(iv)
+ ioff= 0
+ if(ibar.gt.1)ioff = nib(ivmx(iv,kv),ibar-1)
+6799 continue
+67 continue
+ call makeabar()
+ elsk(ibarcnt) = elskb+fbar
+10 continue
+ newmeter = .false.
+ firstline = .false.
+ go to 30
+20 continue
+c
+c Vertical analysis.
+c
+ if (npages .eq. 0) then
+ if (nsyst .eq. 0) then
+ print*,'When npages=0, must set nsyst=bars/syst, not 0'
+ call stop1()
+ end if
+ nsyst = (ibarcnt-1)/nsyst+1
+ if (nv .eq. 1) then
+ nsystpp = 12
+ else if (nv .eq. 2) then
+ nsystpp = 7
+ else if (nv .eq. 3) then
+ nsystpp = 5
+ else if (nv .eq. 4) then
+ nsystpp = 3
+ else if (nv .le. 7) then
+ nsystpp = 2
+ else
+ nsystpp = 1
+ end if
+ npages = (nsyst-1)/nsystpp+1
+ end if
+c
+c Check nsyst vs ibarcnt
+c
+ if (nsyst .gt. ibarcnt) then
+ print*
+ print*,'nsyst,ibarcnt:',nsyst,ibarcnt
+ print*,'There are more systems than bars.'
+ write(15,'(a,2i5)')' nsyst,ibarcnt:',nsyst,ibarcnt
+ write(15,'(a)')' There are more systems than bars.'
+ call stop1()
+ end if
+c
+c Set up dummy forced line & page breaks after last real one
+c
+ nflb = nflb+1
+ ibarflb(nflb) = ibarcnt+1
+ isysflb(nflb) = nsyst+1
+ nfpb = nfpb+1
+ ipagfpb(nfpb) = npages+1
+ isysfpb(nfpb) = nsyst+1
+ heightil = ptheight*4./musize
+ open(12,status='SCRATCH')
+ write(12,'(a)')basenameq(1:lbase)
+ write(12,*)lbase
+c
+c Pass to pmxb the initial signature, including effect of transposition.
+c
+ write(12,'(6f10.5/f10.5,3i5)')fbar,wheadpt,etait,
+ * etatc,etacs1,etatop,etabot,inbothd,inhnoh,isig1
+ write(12,*)npages,widthpt,ptheight,hoffpt,voffpt,nsyst
+ iflbnow = -1
+ isysb4 = 0
+ do 8 ifpb = 1 , nfpb
+c
+c Each time thru this loop is like a single score with several pages
+c
+ npages = ipagfpb(ifpb)-ipagfpb(ifpb-1)
+ nsyst = isysfpb(ifpb)-isysfpb(ifpb-1)
+ nomnsystp = (nsyst-1)/npages+1
+ nshort = nomnsystp*npages-nsyst
+ do 7 ipage = 1 , npages
+ nsystp = nomnsystp
+ if (ipage .le. nshort) nsystp = nsystp-1
+c
+c Last system number on this page:
+ isysendpg = isysb4+nsystp
+ nintpg = 0
+ do 15 isy = isysb4+1, isysendpg
+ if (isysflb(iflbnow+1) .eq. isy) iflbnow = iflbnow+1
+ nintpg = nintpg+nistaff(iflbnow)
+15 continue
+ xilfrac = 0.
+ xiltxt = 0.
+ if (ipage.eq.1 .and. ihead.gt.0) then
+c
+c Needn't zero out ihead after printing titles if we only allow titles at top?
+c
+ if (iand(ihead,1) .eq. 1) then
+ xiltxt = xiltxt+hgtin*4/musize
+ xilfrac = xilfrac+etait
+ end if
+ if (iand(ihead,2) .eq. 2) then
+ xiltxt = xiltxt+hgtti*4/musize
+ xilfrac = xilfrac+etatc
+ end if
+ if (iand(ihead,4) .eq. 4) then
+ xiltxt = xiltxt+hgtco*4/musize
+ xilfrac = xilfrac+etacs1
+ else
+c
+c Use double the title-composer space if there is no composer
+c
+ xilfrac = xilfrac+etatc
+ end if
+ end if
+ D = xilfrac+nsystp-1+etatop+etabot
+c C = nsystp*(nv-1)
+ C = nintpg
+c xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn
+ xN = heightil - xiltxt - 4*(nintpg+nsystp) - (nsystp-1)*xilbn
+ if (bottreb) xN = xN-(nsystp-1)*xilbtc
+ if (ihead.eq.0 .and. isheadr) xN = xN - xilhdr
+ if (ifig .eq. 1) then
+ xN = xN - nsystp*xilfig
+ end if
+ glueil = (xN-b*C)/(D+a*C)
+ omegaG = (b*D+a*xN)/(D+a*C)
+c
+c G = \interlines between systems
+c omega*G = \interlines between staves of the same system
+c \interstaff = 4+omega*G
+c C = total number of interstaff spaces in the page
+c D = omega-indep factors for scalable height = nsy-1 (intersystem glue)
+c + etatop + etabot + etatxt +
+c N = scaleable height (\interlignes) = height - htext - staff heights - xil
+c xil = extra interliges = (nsy-1)*xilbn + 10 if header and no titles
+c + (nsy-1)*xiltcb for treble clef bottoms
+c + nsy*xilfig for figures
+c G = N/(D + omega * C) = glueil, (1)
+c But (empirically) omega*G = a*G + b (2)
+c with a=1.071 and b=2.714
+c Solving (1) and (2) gives
+c G = (N-b*C)/(D+a*C) , omega*G = (b*D+a*N)/(D+a*C)
+c Pass to pmxb omega*G (=\interstaff-4)
+c (etatop,bot,it,tc,cx)*G as inputs to \titles
+c
+c glueil = (heightil-xiltxt-nsystp*(xil+4*nv))
+c * /(nsystp*(1+gfact*(nv-1))-1+etatop+etabot+xilfrac)
+c xnsttop = glueil*etatop
+c xintstaff = 4+gfact*glueil
+c
+c Only the first page will get local adjustment now if needed, others in pmxb
+c
+ if (ifpb.eq.1 .and. ipage.eq.1 .and. fintstf.gt.0.) then
+ facins = fintstf
+ fintstf = -1.
+ else
+c
+c gintstf = 1.0 by default, but may be changed with AI<x>
+c
+ facins = gintstf
+ end if
+ write(12,*)nsystp,max(0.,etatop*glueil),facins*(omegaG+4)
+ ihead = 0
+ isheadr = .false.
+ isysb4 = isysendpg
+7 continue
+8 continue
+c
+c Done with vertical, now do horizontals
+c
+ celsk(1) = elsk(1)
+ do 21 ibar = 2 , ibarcnt
+ celsk(ibar) = celsk(ibar-1)+elsk(ibar)
+21 continue
+ lastbar(0) = 0
+ ibar1 = 1
+ wmins = -1.
+ iflb = 1
+ imovbrk = 0
+ ikey = 1
+c
+c Return nsyst to its *total* value
+c
+ nsyst = isysfpb(nfpb)-1
+ do 22 isyst = 1 , nsyst
+ if (isyst .eq. isysflb(iflb)) iflb = iflb+1
+ if (nmovbrk.gt.0 .and. imovbrk.lt.nmovbrk) then
+ if (isyst .eq. isysmb(imovbrk+1)) imovbrk = imovbrk+1
+ end if
+ ibarb4 = lastbar(isyst-1)
+ if (isyst .eq. 1) then
+ if (isfirst) elsstarg = celsk(ibarflb(1)-1)/
+ * (isysflb(1)-1-fracindent)*(1-fracindent)
+ celskb4 = 0.
+ else
+ celskb4 = celsk(ibarb4)
+c
+c Must dimension isysmb(0:*) just so I can execute this test!
+c
+ if (isfirst) then
+ if (nmovbrk.gt.0 .and. isyst.eq.isysmb(imovbrk)) then
+c
+c First syst after forced line break. There may be indentation.
+c
+ elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
+ * /(isysflb(iflb)-isyst-fracsys(imovbrk))
+ * *(1-fracsys(imovbrk))
+ else
+c
+c There is no indentation to deal with
+c
+ elsstarg = (celsk(ibarflb(iflb)-1)-celskb4)
+ * /(isysflb(iflb)-isyst)
+ end if
+ end if
+ end if
+ if (isfirst) then
+ diff1 = abs(elsstarg-elsk(ibarb4+1))
+ do 23 ibar = ibarb4+2 , ibarcnt
+ diff = elsstarg-(celsk(ibar)-celskb4)
+ if (abs(diff) .ge. diff1) go to 24
+ diff1 = abs(diff)
+23 continue
+24 ibar = ibar-1
+ lastbar(isyst) = ibar
+ nbarss(isyst) = ibar-ibarb4
+ else
+c
+c nbarss is given as an input, must compute lastbar and ibar
+c
+ lastbar(isyst) = nbarss(isyst)+ibarb4
+ ibar = lastbar(isyst)
+ end if
+c
+c elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's.
+c
+ elss(isyst) = celsk(ibar)-celskb4
+ write(12,'(i5)')lastbar(isyst-1)+1
+c
+c Transposed sigs are isig1, newkey(2,3,...).
+c
+ if (ikey .eq. 1) then
+ key1 = isig1
+ else
+ key1 = newkey(ikey)
+ end if
+ fsyst = wclef+abs(key1)*wkeysig+2./musize
+ xelsk = 0.
+1 if (ikey.lt.nkeys) then
+ if (ibrkch(ikey+1).le.lastbar(isyst)) then
+c
+c Add space for all key changes
+c
+ ikey = ikey+1
+ key2 = newkey(ikey)
+ naccs = max(abs(key2-key1),max(abs(key1),abs(key2)))
+ fsyst = fsyst+naccs*wkeysig
+c
+c Account for afterruleskips (fbar)
+c
+ xelsk = xelsk+fbar/2
+ if (ibrkch(ikey).lt.lastbar(isyst) .and. .not.kchmid(ikey))
+ * xelsk = xelsk-1.
+ key1 = key2
+ go to 1
+ end if
+ end if
+c
+c Add extra fixed space for double bar
+c
+ if (isyst .eq. nsyst) then
+ fsyst = fsyst+4.5/musize
+ end if
+c
+c Add extra fixed space for initial time signature
+c
+ if (isyst .eq. 1) then
+ fsyst = fsyst+wtimesig
+ end if
+c
+c Add extra fixed space for time signature changes & user-defined spaces
+c
+ do 26 ibars = ibarb4+1 , lastbar(isyst)
+ if (newmb(ibars)) fsyst = fsyst+wtimesig
+ fsyst = fsyst+udsp(ibars)/musize
+26 continue
+ if (isyst .eq. 1) then
+ wdpt = widthpt*(1-fracindent)
+ else
+ if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
+ * isyst.eq.isysmb(imovbrk)) then
+ wdpt = widthpt*(1-fracsys(imovbrk))
+ else
+ wdpt = widthpt
+ end if
+ end if
+ wsyspt = wdpt-fsyst*musize-0.4*nbarss(isyst)
+c
+c Checks for min spacing
+c Get min allowable space
+c
+ dtmin = 1000.
+ do 45 ibar = ibar1 , ibar1+nbarss(isyst)-1
+ dtmin = min(dtmin,tnminb(ibar))
+ if (wminnh(ibar).ge.0.) wmins = wminnh(ibar)
+45 continue
+ if (wmins .lt. 0) wmins = 0.3
+ wminpt = (1+wmins)*0.3*musize
+c
+c Find max duration & # of notes for this system
+c
+ dtmax = 0.
+ nns = 0
+ do 43 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
+ dtmax = max(dtmax,durb(iptr))
+ nns = nns + nnpd(iptr)
+43 continue
+ elmin0 = wsyspt*f1eon(dtmin)/(elss(isyst)+xelsk)
+ if (elmin0 .ge. wminpt) then
+c
+c Subtract out fbar stuff to keep old way of passing sumelsk to pmxb;
+c there is no need to "flatten"
+c
+ sumelsk = elss(isyst)-fbar*nbarss(isyst)
+ eonk = 0.
+ ewmxk = 1.
+ else
+ elmin1 = wsyspt/((fbar*nbarss(isyst)+xelsk)/f1eon(dtmax)+nns)
+ if (elmin1 .le. wminpt) then
+c print*
+c print*,'In system #',isyst,' cannot meet min. space rqmt'
+c write(15,'(/a,i5,a)')
+c * 'In system #',isyst,' cannot meet min. space rqmt'
+ eonk = 0.9
+ else
+c
+c Find eonk by Newton method
+c
+ call findeonk(nptr(ibar1),nptr(ibar1+nbarss(isyst))-1,
+ * wsyspt/wminpt,fbar*nbarss(isyst)+xelsk,dtmin,dtmax,
+ * (wminpt-elmin0)/(elmin1-elmin0))
+ eonk = min(.9,eonk)
+ end if
+ ewmxk = f1eon(dtmax)**eonk
+c
+c Recompute poenom!
+c
+ sumelsk = 0
+ do 44 iptr = nptr(ibar1) , nptr(ibar1+nbarss(isyst))-1
+ sumelsk = sumelsk
+ * + nnpd(iptr)*sqzb(iptr)*feon(durb(iptr)/sqzb(iptr))
+44 continue
+ end if
+ poenom = wsyspt/(sumelsk+fbar*nbarss(isyst)+xelsk)
+c
+c Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0
+c
+ if (isyst .gt. 0) then
+ if (nmovbrk.gt.0 .and. imovbrk.gt.0 .and.
+ * isyst.eq.isysmb(imovbrk)) then
+ fracindent = fracsys(imovbrk)
+ else
+ fracindent = 0.
+ end if
+ end if
+ write(12,'(1pe12.5/i5,5e12.3)') poenom,nbarss(isyst),
+ * sumelsk,fsyst,fracindent,eonk,ewmxk
+ ibar1 = ibar1+nbarss(isyst)
+22 continue
+ rewind(12)
+ open(13,status='SCRATCH')
+ write(13,'(i5)')ifig
+ rewind(13)
+ ilbuf = 1
+ ipbuf = 0
+ if (.not.optimize) then
+ write(*,'(/,a)')' Done with first pass'
+ print*
+ write(15,'(/,a)')' Done with first pass'
+ write(15,'()')
+ end if
+c
+c Following syntax is needed since pmxa is called with literal argument .false.
+c
+ if (isfirst) isfirst = .false.
+ return
+ end
+ subroutine pmxb(inlast,poevec,ncalls,optimize)
+cccccccccccccccccccccccccc
+cc
+cc To Do
+cc
+cc Resolve disagreement in final poe for 1st system, compared with *.mx2
+cc Shift slurs on right- or left-shifted main notes (2/7/99)
+cc Various end-of-input-block repeat problems (ick142.pmx).
+cc Force multiplicity for un-beamed xtups.
+cc Clef change at end of piece
+cc Global "A" option to maximize "X" at a given time tick.
+cc Tighten test for end-of-bar hardspace, flgndv(ivx) due to right-shifted
+cc note. See trubl18.pmx
+cc Tab character as space.
+cc Clef interference with second line of music.
+cc Add space for interferences between *different* lines of music?
+cc Shift arpeggios, both automatic and manual.
+cc Different musicsize for different instruments.
+cc Spacing checks for accid's on left-shifted chord notes
+cc Spacing checks for double dots
+cc Allow forced line breaks w/o setting nsyst.
+cc Cresc-Decresc. (Enhance MusiXTeX first?)
+cc Dynamic Marks.
+cc Bug with Voltas at line end (MusiXTeX problem?).
+cc Subtle bug w/ slur hgt over line brk, see trubl15.pmx
+cc Stem-end slurs.
+cc Allow units in indentation.
+cc Make inline TeX more context sensitive.
+cc Werner's 4/2/98 problem with "o?"
+cc Scor2prt converts e.g. "r0+0" into "r0 0", which seems to be wrong.
+cc converts e.g. "r2db" into "r2d", which might be wrong.
+cc Werner's generalsignature problem with Key change and new transposition.
+cc (wibug8.pmx)
+cc Unequal xtuplets
+cc Print both sets of bar #'s in tex file.
+cc Make barlines invisible \def\xbar{\empty} , fix fbar.
+cc Auto-tie slurs 'At'
+cc Forced line break anywhere (e.g. at a mid-bar repeat).
+cc Clef change at very start of file.
+cc Tighten test for M as macro terminator.
+cc Fix title so not separate limit on author length + composer length.
+cc Arpeggios in xtups.
+cc
+cc mx10b
+cc Option for instrument name at top center. Last item in P command:
+cc P[n]c text is instrument name (use in parts)
+cc P[n]cstuff text is stuff (up to 1st blank)
+cc P[n]c"stuff with spaces" text is stuff with spaces
+cc
+cc Post version 1.43
+cc Reduced space rqmt for multiplicity-0 graces (no flag)
+cc Removed last sepsym in centered whole-bar rests, fixes volta height bug.
+cc
+cc Version 1.43
+cc Fix spacing for end-of-line signature change.
+cc Adjust left-shift of grace group for shifted accidentals.
+cc Put in extra space for left-shifted accidentals.
+cc Fix bug with dot-shift before accid-shift on chord note.
+cc Space-check for right-shifted main notes.
+cc Enable forcing stem direction of single notes in non-beamed xtups.
+cc Disallow clef change after last note before end of input block (pmxa)
+cc Print meter change before page break
+cc increase length of strings for \titles macro
+cc version 1.42
+cc Loosen up input syntax for "X" commands. Subroutine getx()
+cc "B" and "P" in "X" commands
+cc mx09b
+cc Allow multiple rests at start of xtup
+cc Add 64th rest
+cc Fix xtup numbers over rests. (subroutine levrn)
+cc Initialize notcrd=.false. every gulp. Avoids undefined state with e.g.
+cc c za / ( c a ...
+cc Allow double dots to be shifted.
+cc Fix spacing with double dotted notes; permit splitting small note.
+cc Fix \dotted printout so it works with old compiler
+cc mx08b
+cc Automatic spaces if needed for shifted accidentals.
+cc Some Dynamics
+cc Increase accid. horiz. shift resolution to .o5 (use one more bit in nacc)
+cc version 1.41
+cc Allow ":" as last char of path name
+cc Dotted slurs "sb"
+cc Continue bar numbering at movement break "L[integer]Mc"
+cc mx07b
+cc Whole-bar rests with double lines of music. Fixed all options ?
+cc Shift accidentals, either [+|-][integer][+|-][number] or [<|>][number].
+cc Option to suppress centering full-bar rests. "o"
+cc mx06b
+cc Shift accid on left-shifted chord note.
+cc Rest as first note of xtup.
+cc Wrong slopes with small widths. Scale slfac1 by widthpt_default/widthpt
+cc Allow Rb for single bar at movemnet break or end of piece. (islur(25))
+cc Change # of inst at a movement break. noinst is total # and must be used
+cc in 1st movement. ninow is current. nspern(1,...,ninow) is current
+cc staves/inst, nsperi(1,...,noinst) is original. rename tells whether to
+cc reprint names in parindent at a movement break. Default is .false.
+cc unless ninow changes, then .true. But can force either with r+/- as
+cc option in 'M'
+cc mx04b
+cc Double-dotted notes, separate+beamed, main+chord, still no extra space.
+cc ??? Don't shift slur ends on whole notes.
+cc (pmxa) Write line number of error in pmxaerr.dat
+cc mx02b
+cc Admit "RD" before "/" (search for "rptfq2:" )
+cc In doslur, for multi-line staves, single notes, check forced stem dir'n
+cc before setting stemup (used to set horiz offset).
+ccccccccccccccccccccccccccccccc
+ parameter (nm=24,nks=125,mv=24576,maxblks=9600)
+c
+c FYI /all/ differs in appearance in function ncmid
+c
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ccccccccccccc
+cc islur cc
+ccccccccccccc
+c bit meaning
+c 0 slur activity on this note
+c 1 t-slur here.
+c 2 force 0-slope beam starting on this note
+c 3 Double dotted note!
+c 4 grace before main note
+c 5 left repeat
+c 6 right repeat
+c 7 start Volta
+c 8 doublebar
+c 9 end Volta
+c 10 on=>endvoltabox
+c 11 on=>clefchange
+c 12-14 0=>treble, ... , 6=>bass
+c 15 on=> start new block for clef change (maybe diff. voice)
+c 16 literal TeX string
+c 17 1=up, 0=down stem for single note (override) See bit 30!
+c 18 if on, prohibit beaming
+c 19 if on, full bar rest as pause
+c 20 Beam multiplicity down-up
+c 21 Forced multiplicity for any beam including xtups
+c 22-24 Value of forced multiplicity
+c 25 single barline at movement break
+c 26 doubleBAR (see bits 5,6,8)
+c 27-28 Forced beam fine-tune height (1 to 3)
+c 29 Blank rest
+c 30 If on, get stem dir'n from bit 17
+c 31 If on, suppress printing number with xtuplet starting here
+ccccccccccccc
+cc ipl cc
+ccccccccccccc
+c 0 blank barline (must be iv=1) (would have used islur but no room)
+c 1 look left for K rests, moved here from iornq(30)
+c 2 treblelowoct
+c 3 Open notehead in forced beam xtup
+c 4 Set if single stem tremolo
+c 5-6 termulo multiplicity - 1
+c 7 unused
+c 8 left offset main note one headwidth
+c 9 right offset main note one headwidth
+c 10 chord present?
+c 11-16 Forced beam height adjustment (-30 to +30)
+c 17-22 Forced beam slope adjustment (-30 to +30)
+c 23-26 Slur index for Way-after grace. Inserted when slur is started.
+c 27 5th bit for slur index for Way-after grace (100712)
+c 28 key change: only in voice 1
+c 29 Grace after main note. (Type A)
+c 30 In forced beam. Signals need to check beam heights
+c 31 Grace way after main note. (stretch to next note, type W)
+ccccccccccccc
+cc iornq cc
+ccccccccccccc
+c 0 Ornament "(". Was user-defined horizontal slur shift on this note
+c until 9/24/97; changed that to irest(21)
+c 1-13 stmgx+Tupf._)
+c 14 Down fermata, was F
+c 15 Trill w/o "tr", was U
+c 16-18 Editorial s,f,n
+c 19-20 >^
+c 21 "?" for editorial accid, w/ or w/o s,f,n
+c 22 Set if ihornb governs ornament height. Same in icrdorn.
+c 23 Set in getorn if ANY note at time of this main note has ornament.
+c This is ONLY used in beamstrt to signal whether to do more
+c tests for whether ihornb is needed. (ihornb is only needed
+c if nonchord+upbm, chord+upbm+top_note, chord+dnbm+bot_note)
+c (7/1/00)Also set if any dynamic, as ihornb will be needed when dnbm.
+c 24 Slur on after or way-after grace. Use as signal to START slur.
+c 25 Tweak orn ht. Same in icrdorn for chord note
+c 26 Insert user-defined space before this note (was 22)
+c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord
+c 28 caesura or breath
+cc 29 blank barline (must be iv=1) (would have used islur but no room)
+c 29 coda
+cc 30 "Look-left" option for keyboard rest
+c 30 Part-by-part segno oG
+c 31 Set if any note (main or chord) has cautionary accid, for space checks
+ccccccccccccc
+cc irest cc
+ccccccccccccc
+c 0 rest=1, no rest = 0
+c 1 There will be a vertical shift for number of this xtup
+c 2 Set if 2-note tremolo starts here
+c 3-4 nsolid, # of solid beams in 2-note tremolo
+c 5-6 nindent, # of indented beams in 2-note tremolo
+c 7 There is a horizontal shift for xtup number
+c 9-13 Horiz shift, 1=>-1.5, ... , 31=>+1.5
+c 14 Flip up/down-ness of xtup number
+c 15 Single-voice, single note shift X(...)[p]S
+c 16 Start single-voice, multinote shift with this note X(...)[p]:
+c 17 End single-voice, multinote shift after this note. Enter symbol
+c after note. X:
+c 18 User-defined hardspace after last note of bar, *after* this note.
+c Value still stored in udoff(ivx,nudoff(ivx)), not with other
+c hardspaces in udsp, to avoid confusion with time checks.
+c 19 Move the dot. Data stored in ndotmv,updot,rtdot
+c 20 Set if right-shifted main or chord note here. Use for space checks.
+c 21 User-defined hardspace in xtup
+c 22 User-defined slur shift horizontal slur shift.
+c 23 Set on last note before staff-jumping a beam.
+c 24 Set on first note after staff-jumping a beam
+c 25 Suppress rest centering. "ro"
+c 26 Dynamic on this note
+c 27 Set if left-shifted main or chord note here. Use for space checks.
+c 28 Set if xtup starts on this note.
+c 29 Set on lowest-voice note at same time as 1st note after jump-beam.
+c 30 Set on note after end of jump-beam segment, to force new note group
+c 31 Flag for cautionary accidental
+ccccccccccccc
+cc nacc cc
+ccccccccccccc
+c 0-1 0=no accid, 1=fl, 2=sh, 3=na
+c 2 double
+c 3 big
+c 4-9 vertshift-32
+c 10-16 20*(horiz. shift + 5.35) (Recentered ver 2.32)
+c 17 Midi-only accidental
+c 18 2:1 xtup
+c 19 Together with nacc(18), increase multiplicity by 1 and dot 1st note.
+c 20 Set on last note of each seg except last seg of single-slope beam.
+c 21 Set on 1st note of each seg except 1st seg of single-slope beam.
+c 22-26 If .ne.0, printed xtup number for xtup starting on this note.
+c 27 Set for dotted xtup note. Mult dur by 1.5, mult next by .5 & increase
+c multiplicity by 1
+c 28 Set on main note of chord if accidentals are ordered.
+c 29 Tag for chordal accidental shift...means add to autoshifts.
+c 30-31 Set 30|31 if main note in a chord is part of a 2nd and needs to be shifted.
+c If upstem|downstem, main is upper|lower member of 2nd
+c Action is to interchange pitches only when notes are placed.
+ccccccccccccc
+cc mult cc
+ccccccccccccc
+c 0-3 Multiplicity+8 (mult= # of flags)
+c 4 Set if slope adjustment for xtup bracket
+c 5-9 16+slope adjustment
+c 10-15 New stem length, [0-63] => (-4,0,+27.5)
+c 16-22 64+Vertical offset of xtup #
+c 27 Stemlength override
+cc 28-30 New stem length.
+ccccccccccccc
+cc isdat1 cc
+ccccccccccccc
+c 13-17 iv
+c 3-10 ip
+c 11 start/stop switch
+c 12 kv-1
+c 19-25 ichar(code$)
+c 26 force direction?
+c 27 forced dir'n = up if on, set in sslur; also
+c final direction, set in doslur when beam is started, used on term.
+c 28-31 ndxslur, set in doslur when beam is started, used on term.
+ccccccccccccc
+cc isdat2 cc
+ccccccccccccc
+c 0 Chord switch. Not set on main note.
+c 1-2 left/right notehead shift. Set only for chord note.
+c 3 tie positioning
+c 4 dotted slur
+c 6-11 voff1 1-63 => -31...+31
+c 12-18 hoff1 1-127 => -6.3...+6.3
+c 19-25 nolev
+c 26 \sluradjust (p+s)
+c 27 \nosluradjust (p-s)
+c 28 \tieadjust (p+t)
+c 29 \notieadjust (p-t)
+ccccccccccccc
+cc isdat3 cc
+ccccccccccccc
+c 0 set if midslur (at least one argument)
+c 1 set if curve (2 more args)
+c 2-7 32+first arg (height correction) (1st arg may be negative)
+c 8-10 second arg (initial slope)
+c 11-13 third arg (closing slope)
+c 14-21 tie level for use in LineBreakTies
+c 22-29 ncm for use in LineBreakTies
+ccccccccccccc
+cc isdat4 cc Set these all at turn-on using s option
+ccccccccccccc
+c 0-5 Linebreak seg 1 voff 1-63 => -31...+31
+c 6-12 Linebreak seg 1 hoff 1-127 => -6.3...+6.3
+c 16-21 Linebreak seg 2 voff 1-63 => -31...+31
+c 22-28 Linebreak seg 2 hoff 1-127 => -6.3...+6.3
+ccccccccccccc
+c icrdat c
+ccccccccccccc
+c 0-7 ip within voice
+c 8-11 ivx (together with 28th bit)
+c 12-18 note level
+c 19 accidental?
+c 20-22 accidental value (1=natural, 2=flat, 3=sharp, 6=dflat, 7=dsharp)
+c 23 shift left
+c 24 shift right
+c 25 arpeggio start or stop
+c 26 flag for moved dot (here, not icrdot, since this is always reset!)
+c 27 Midi-only accidental
+c 28 (6/27/10) 5th bit for ivx, to allow up to 24 voices
+c 29 Tag for accidental shift...means add to autoshifts.
+c 31 Flag for cautionary accidental on chord note
+ccccccccccccc
+c icrdot c:
+ccccccccccccc
+c 0-6 10*abs(vertical dot shift in \internote) + 64
+c 7-13 10*abs(horizontal dot shift in \internote) + 64
+c 14-19 vert accidental shift-32
+c 20-26 20*(horiz accidental shift+3.2)
+c 27-29 top-down level rank of chord note w/accid. Set in crdaccs.
+c
+c Bits in icrdorn are same as in iornq, even tho most orns won't go in crds.
+c
+cccccccccccccccccccccccccccccccc
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ character*10 figq
+ common /comignorenats/ mbrhgt,newmbrhgt,ignorenats
+ logical ignorenats,newmbrhgt
+ character*1 ulq,sepsymq,sq,chax
+ logical beamon,firstgulp,figbass,figchk,
+ * isfig,rptnd1,rptprev
+ logical loop,lastchar,slint,svolta,evolta,onvolt,
+ * cwrest(nm),islast,inlast,optimize
+ integer istop(80),numbms(nm),istart(80)
+ real*4 xnsttop(75),xintstaff(75),hesk(23),hpts(23),poevec(nks),
+ * tstart(80),squez(80)
+ character*1 clefq(nm),ulfbq,rptfq1,rptfq2,charq
+ character*79 notexq,inameq
+ character*40 pathnameq
+ character*44 basenameq
+ character*24 fmtq
+ character*20 voltxtq
+ character*120 instrq,titleq,compoq
+ common /comlast/ islast,usevshrink
+ logical usevshrink,stickyS,OptLineBreakTies,autofbon
+ common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2,multbj1
+ common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
+ * inhead
+ common /cominbot/ inbothd
+ common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ common /comnsp/ space(80),nb,prevtn(nm),
+ * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm)
+ common /comstart/ facmtr
+ common /comfb/ nfb(nm),t1fb(nm,40),t2fb(nm,40),ulfbq(nm,40),ifb,
+ * tautofb,autofbon,t1autofb
+ common /comget/ lastchar,rptnd1,sluron(nm,2),fbon,ornrpt,stickyS,
+ * movbrk,movnmp,movdnp,movgap,parmov,fintstf,gintstf,
+ * rptprev,equalize,rptfq1,rptfq2
+ common /combeam/ ibmtyp
+ common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd,
+ * npreslur,was2(nm),ninow,nobar1,nsystp(75),ipage,
+ * OptLineBreakTies,HeaderSpecial
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comas2/ nasksys,wasksys(800),elasksys(800)
+ common /comas3/ ask(2500),iask,topmods
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ common /comsln/ is1n1,is2n1,irzbnd,isnx
+ common /comgrace/ ivg(37),ipg(37),nolevg(74),itoff(2,74),aftshft,
+ * nng(37),ngstrt(37),ibarmbr,mbrest,xb4mbr,
+ * noffseg,ngrace,nvolt,ivlit(83),iplit(83),nlit,
+ * graspace(37),
+ * lenlit(83),multg(37),upg(37),slurg(37),slashg(37),
+ * naccg(74),voltxtq(6),litq(83)
+ logical upg,slurg,slashg,fbon,ornrpt,shifton,isbjmp,notcrd,was2,
+ * isbj2,fontslur,WrotePsslurDefaults,HeaderSpecial
+ common /comivxudorn/ivxudorn(63)
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ character*128 litq,lnholdq
+ logical upslur,bar1syst,vshrink,lrpt,rrpt,lrptpend,
+ * ispoi,bcspec,topmods,headlog,clchb,clchv(nm),flgndb,
+ * btest,sluron,setis,nobar1
+ common /comcc/ ncc(nm),tcc(nm,10),ncmidcc(nm,10),
+ * maxdotmv(nm),ndotmv(nm),updot(nm,20),rtdot(nm,20)
+ common /compoi/ ispoi
+ common /combc/ bcspec
+ common /comeon/ eonk,ewmxk
+ common /spfacs/ grafac,acgfac,accfac,xspfac,xb4fac,clefac,emgfac,
+ * flagfac,dotfac,bacfac,agc1fac,gslfac,arpfac,
+ * rptfac,lrrptfac,dbarfac,ddbarfac,dotsfac,upstmfac,
+ * rtshfac
+ common /comhsp/ hpttot(176)
+ common /combmh/ bmhgt,clefend
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ common /strtmid/ ihnum3,flipend(nm),ixrest(nm)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ common /commus/ musize,whead20
+ common /comtol/ tol
+ common /comdyn/ ndyn,idyndat(99),levdsav(nm),ivowg(12),hoh1(12),
+ * hoh2(12),hoh2h1(2),ntxtdyn,ivxiptxt(41),txtdynq(41),
+ * idynda2(99),levhssav(nm),listcresc,listdecresc
+ character*128 txtdynq
+ logical mrecord,mplay,endmac,flipend,istype0,lowdot,rename,ispstie
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc,equalize,
+ * ismbr,putmbr
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /comcb/ nbc,ibcdata(36)
+ common /comclefq/ clefq
+ common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
+ * ArpShift(20)
+ common /comligfont/ isligfont
+ logical isligfont
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /combibarcnt/ ibarcnt
+ character*40 nmq
+ common /commidisig/ midisig
+ common /comclefrests/ centrests
+ logical newclef, centrests
+ common /comlyr/ inputmlyr
+ logical inputmlyr
+ common /combottop/ botamt,topamt,bottopgap
+ logical bottopgap
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comhair/ idhairuse,idhair(nm)
+ common /comc8flag/ c8flag(nm)
+ logical c8flag
+ common /comshort/ shortfrac,codafrac,ishort,mbrsum,nmbr,nocodabn,
+ * poefa
+ real*4 poefa(125)
+ logical nocodabn
+ character*3 shortfraq,rendq
+ bottopgap = .false.
+ inputmlyr = .false.
+ idhairuse = 0
+ if (.not.optimize) then
+ print*
+ print*,'Starting second PMX pass'
+ print*
+ write(15,'(a)')'Starting second PMX pass'
+ end if
+ newclef = .false.
+ centrests = .false.
+ ncalls = ncalls+1
+ islast = inlast
+ macuse = 0
+ isyscnt = 0
+ stemmax = 8.2
+ stemmin = 3.9
+ stemlen = 6.0
+ sq = chax(92)
+ ignorenats = .false.
+ newmbrhgt = .false.
+ bcspec = .true.
+ topmods = .false.
+ ismbr = .false.
+ read(12,'(a)')basenameq
+ read(12,*)lbase
+ read(12,*)fbar,wheadpt,etait,etatc,etacs1,etatop,
+ * etabot,inbothd,inhnoh,isig
+ ilbuf = 1
+ ipbuf = 0
+ call getset(nv,noinst,mtrnuml,mtrdenl,mtrnmp,mtrdnp,xmtrnum0,
+ * npages,nsyst,musicsize,fracindent,istype0,inameq,
+ * clefq,sepsymq,pathnameq,lpath,isig0)
+ if (ismidi) then
+c
+c Initial key signature and meter for pickup bar
+c 130313 Unless explicit miditranspose for all parts (to be dealt with later),
+c want concert sig (isig0) here. K+n+m will have changed sig to isig
+c call midievent('k',isig,0)
+c 130316
+c call midievent('k',isig0,0)
+c call midievent('k',midisig,0)
+c
+c Above is probably cosmetic
+c call midievent('k',midisig,0)
+ if (xmtrnum0 .gt. tol) then
+c
+c We have a pickup. Some tricky stuff to get a meter:
+c
+ xntrial = xmtrnum0
+ do 5 ip2 = 0 , 5
+ if (abs(mod(xntrial,1.)) .lt. tol) go to 6
+ xntrial = xntrial*2
+5 continue
+ print*,'Problem finding meter for pickup bar'
+ xntrial = 1.
+ ip2 = 0
+6 continue
+ call midievent('m',nint(xntrial),2**ip2*mtrdenl)
+ else
+c
+c No pickup, enter the starting meter
+c
+ call midievent('m',mtrnuml,mtrdenl)
+ end if
+ end if
+c
+c Set musicsize from value passed in common, due to possible reset by S[n]m16
+c
+ musicsize = musize
+ read(12,*)npages,widthpt,height,hoffpt,voffpt,nsyst,
+ * (nsystp(ipa),xnsttop(ipa),xintstaff(ipa),ipa=1,npages),iauto
+c
+c If default width ever changes, must adjust this stmt.
+c
+ slfac1 = 0.00569*524./widthpt
+ figbass = .false.
+ read(13,*)ifig
+ if (ifig .eq. 1) then
+ figbass = .true.
+ open(14,status='SCRATCH')
+ write(14,'(a)')sq//'def'//sq//'fixdrop{'//sq//'advance'//sq//
+ * 'sysno by 1'//sq//'ifcase'//sq//'sysno%'
+ end if
+ lastchar = .false.
+ ibcoff = 0
+ if (xmtrnum0 .gt. 0.) ibcoff = -1
+ open(11,status='SCRATCH')
+c
+c vshrink for the first page is calculated in topfile,
+c and if true set interstaff=10. vshrink affects Titles.
+c Must also save vshrink for page ending.
+c
+ call topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
+ * xintstaff(1),mtrnmp,mtrdnp,vshrink,fbar,fontslur)
+c
+c ninow is working value of # of instruments. noinst is max #, and # at start.
+c
+ ninow = noinst
+c
+c Save original printed meter in case movement breaks
+c
+ movnmp = mtrnmp
+ movdnp = mtrdnp
+c
+ if (islast .and. figbass .and. musicsize.eq.16)
+ * write(11,'(a)')sq//'def'//sq//'figfont{'//sq//'eightrm}%'
+c
+ if (islast .and. isligfont) then
+ if (musicsize .eq. 16) then
+ write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 8pt%'
+ else
+ write(11,'(a)')sq//'font'//sq//'ligfont=cmrj at 10pt%'
+ end if
+ end if
+ lenbeat = ifnodur(mtrdenl,'x')
+ if (mtrdenl .eq. 2) lenbeat = 16
+ lenb1 = mtrnuml*lenbeat
+ if (mtrdenl .eq. 2) lenb1 = lenb1*2
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ lenb0 = nint(xmtrnum0*lenbeat)
+ if (mtrdenl .eq. 2) lenb0 = lenb0*2
+ if (lenb0 .ne. 0) then
+ if (islast) write(11,'(a)')sq//'advance'//sq//'barno by -1'
+ lenbar = lenb0
+ else
+ lenbar = lenb1
+ end if
+c
+c Initialize full-program variables
+c
+ fixednew = 0.
+ scaldold = 0.
+ fintstf = -1.
+ gintstf = 1.
+ nasksys = 0
+ ibarcnt = 0
+ iline = 0
+ movbrk = 0
+ isystpg = 0
+ ipage = 1
+ iccount = 128
+ iask = 0
+ nhstot = 0
+ nb = 1
+ if (.not.optimize) jprntb = 81
+ idsig = 0
+ iflagbot = 0
+c
+c Next 5 are raise-barno parameters. irzbnd is integer part of default level.
+c
+ irzbnd = 3
+ if (isig.eq.3 .and. clefq(nv).eq.'t') irzbnd = 4
+ is1n1 = 0
+ isnx = 0
+ SlurCurve = 0.
+ ishort = 0
+ nocodabn = .false.
+ mbrsum = 0
+ nmbr = 0
+c
+c 111109 Made global rather than per gulp
+c
+ ndyn = 0
+ ispoi = .false.
+ slint = .false.
+ lrptpend = .false.
+ rptnd1 = .false.
+ rptfq2 = 'E'
+ rptprev = .false.
+ onvolt = .false.
+ flgndb = .false.
+ fbon = .false.
+ shifton = .false.
+ ornrpt = .false.
+ setis = .false.
+ lowdot = .false.
+ rename = .false.
+ nobar1 = .false.
+ equalize = .false.
+ usevshrink = .true.
+ WrotePsslurDefaults = .false.
+ OptLineBreakTies = .false.
+ HeaderSpecial = .false.
+c
+c vshrink is initialized in topfile
+c
+ stickyS = .false.
+c
+c ixrest = 1 or 2 if xtup has started with a rest
+c
+ do 1 ivx = 1 , nm
+ ixrest(ivx) = 0
+ fullsize(ivx) = 1.
+c
+c Set legacy note level to middle c as default
+c
+ ndlev(ivx,1) = 29
+ ndlev(ivx,2) = 29
+1 continue
+ npreslur = 0
+ nhssys = 0
+ listslur = 0
+ do 31 i = 1 , 202
+ isdat1(i) = 0
+ isdat2(i) = 0
+31 continue
+ nsdat = 0
+c
+c Initialize flag for figures in any other voice than 1
+c
+ ivxfig2 = 0
+c
+c Initialize for loop over gulps
+c
+ firstgulp = .true.
+c
+c Start a gulp
+c
+30 loop = .true.
+ notcrd = .true.
+ isbjmp = .false.
+ isbj2 = .false.
+ autofbon = .false.
+ tautofb = 0.
+ nbars = 0
+ nfigs(1) = 0
+ nfigs(2) = 0
+ ngrace = 0
+ ntrill = 0
+ ncrd = 0
+ nudorn = 0
+ nlit = 0
+ nvolt = 0
+ ibarmbr = 0
+ nudsp = 0
+c ndyn = 0 ! 111109
+ ntxtdyn = 0
+ nbc = 0
+ NumArpShift = 0
+ do 3 i = 1 , 37
+ graspace(i) = 0.
+3 continue
+c
+c Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst.
+c and also if nv increases in an 'M' directive.
+c
+ do 4 iv = 1 , nv
+ call newvoice(iv,clefq(iv),.false.)
+4 continue
+c
+c Check if endsymbol was set earlier
+c
+ if (rptnd1) then
+ rptnd1 = .false.
+ rptfq2 = rptfq1
+ else
+c
+c Only use if movbrk>0, to signal default ('RD')
+c
+ rptfq2 = 'E'
+ end if
+ iv = 1
+ ivx = 1
+2 if (loop) then
+c
+c Within this loop, nv voices are filled up for the duration of the block.
+c On exit (loop=.false.) the following are set: nnl(nv),itsofar(nv)
+c nolev(nv,nnl(nv)),nodur(..),accq(..),irest(..).
+c nbars is for this input block.
+c Only at the beginning of an input block will there be a possible mtr change,
+c signalled by a nonzero mtrnuml. (which will be re-zeroed right after change)
+c
+ call getnote(loop)
+ if (lastchar) go to 40
+ go to 2
+ end if
+c
+c Finished an input block (gulp).
+c
+ if (ismidi) then
+c
+c Put rests into midi array for 2nd lines that were not used in this gulp.
+c
+ do 60 iv = 1 , nv
+ if (twoline(iv) .and. nvmx(iv).eq.1) then
+ if (firstgulp .and. lenb0.ne.0) then
+ call addmidi(midchan(iv,2),0,0,0,
+ * (nbars-1.)*lenbar+lenb0,.true.,.false.)
+ else
+ call addmidi(midchan(iv,2),0,0,0,1.*nbars*lenbar,.true.,
+ * .false.)
+ end if
+ end if
+60 continue
+ end if
+ nvolt = 0
+ do 28 iv = 1 , nm
+ nudoff(iv) = 0
+ maxdotmv(iv) = ndotmv(iv)
+ ndotmv(iv) = 0
+28 continue
+c
+c Put stuff at top of p.1. Must wait until now to have read title info.
+c
+ if (ibarcnt .eq. 0) then
+ call puttitle(inhnoh,xnsttop(ipage),
+ * etatop,sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
+ if (HeaderSpecial)
+c
+c Write special header for first page
+c
+ * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
+ end if
+ do 10 ibar = 1 , nbars
+ ibarcnt = ibarcnt+1
+ bar1syst = ibarcnt .eq. iauto
+ ndig = max(0,int(log10(.001+ibarcnt+ibcoff)))
+ if (islast)
+ * write(11,'(a11,i'//chax(50+ndig)//')')
+ * '% Bar count',ibarcnt+ibcoff
+ if (ibar .ne. ibarmbr) then
+ if (.not.optimize) call outbar(ibarcnt+ibcoff,jprntb)
+ else
+ if (.not.optimize) then
+ write(*,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
+ * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
+ write(15,'(/,a20,i4,a1,i4)')' Multibar rest, bars',
+ * ibarcnt+ibcoff,'-',ibarcnt+ibcoff+mbrest-1
+ jprntb = 0
+ end if
+ ibcoff = ibcoff+mbrest-1
+c if (ibar.eq.1 .and. firstgulp .and.
+c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize
+ if (ibar.eq.1 .and. firstgulp .and.
+ * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize
+ end if
+c
+c Move the read to after end-of-bar hardspace checks, so we get right poenom
+c at end of a line.
+c if (bar1syst) read(12,*) poenom
+c
+c Check for clef at start of bar. No slide yet. Also flags at end of prev.
+c bar. This block is run at the start of every bar. May fail for flag at
+c end of last bar. To account for necc. hardspaces, compute and store
+c nhssys = # of hard spaces for this system
+c hesk(nhssys) = elemskips avialable
+c hpts(nhssys) = hard points needed, including notehead
+c Here, merely insert placeholder into output. Later, when poe is computed,
+c compute additional pts and store them in hpttot(1...nhstot). Finally in
+c subroutine askfig, write true pts where placeholders are.
+c
+ ioff = 0
+ if (ibar .gt. 1) ioff = nib(1,ibar-1)
+ clchb = btest(islur(1,ioff+1),15)
+ putmbr = .false.
+ if (ismbr) then
+ if (clchb) then
+ccc
+ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest.
+ccc
+ write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest'
+ * //sq//'def'//sq//'mbrest#1#2#3{%'
+ write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55,
+ * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%'
+cc
+cc RDT suggestion is inset blank barline - 160103 Abandoned
+cc
+c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace'
+c * //sq//'advance'//sq//'barno-1'
+ end if
+ ismbr = .false.
+ putmbr = .true.
+ end if
+ if (ibar .eq. ibarmbr) ismbr = .true.
+c
+c Set flag here so at start of next bar, if there's a clef change, can add space
+c after the mbr with the above kluge
+c
+ if (.not.(clchb .or. flgndb)) go to 23
+c
+c Must check available space
+c
+ ptsndb = 0.
+c
+c Zero out block signal
+c
+ if (clchb) islur(1,ioff+1) = ibclr(islur(1,ioff+1),15)
+c
+c In this loop, we determine how much hardspace is needed (if any)
+c 9/7/97 Note that for last bar in input block, if number of lines of
+c music decreases in new block, highest numbered ones won't be checked
+c since the loop below covers the new nvmx(iv), not necessarily the old
+c one.
+c 4/18/98 Apparently nmxsav was a solution to the above problem
+c
+ do 16 iv = 1 , nv
+ do 1699 kv = 1 , nvmxsav(iv)
+ ivx = ivmxsav(iv,kv)
+ ptsndv = flgndv(ivx)*wheadpt
+ ioff = 0
+ if (ibar .gt. 1) then
+ ioff = nib(ivx,ibar-1)
+ ip = ioff
+ if (ibar.gt.2) ip = ioff-nib(ivx,ibar-2)
+c prevtn(ivx) = tnote(iand(ipl(ivx,ip),255))
+ prevtn(ivx) = tnote(ipl2(ivx,ip))
+c
+c If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar.
+c
+ end if
+c
+c Only allow clef changes when ivx <= nv
+c
+ if (ivx .le. nv) then
+ clchv(iv) = clchb .and. btest(islur(iv,ioff+1),11)
+ if (clchv(iv)) then
+c
+c Clef change in this voice. Turn off signal. Get space avail.
+c
+ islur(iv,ioff+1) = ibclr(islur(iv,ioff+1),11)
+ if (abs(prevtn(iv)-space(nb)).lt.tol) ptsndv =
+ * ptsndv+clefend*wheadpt
+ end if
+ end if
+ ptsndb = max(ptsndb,ptsndv+wheadpt*xspfac)
+1699 continue
+16 continue
+c
+c ???? where is nb set??? nb probably in left over from makeabar
+c
+ esk = feon(space(nb)*squez(nb))
+ ptsdflt = esk*poenom-wheadpt
+c if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then
+ if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0
+ * .and. .not.putmbr) then
+c
+c Must ADD hardspace! So put in a placeholder, and store params for later.
+c
+ if (islast) write(11,'(a)')sq//'xardspace{ pt}%'
+ nhssys = nhssys+1
+ if (ptsndb-ptsdflt .gt. ptsgnd-poenom*eskgnd) then
+ hesk(nhssys) = esk
+ hpts(nhssys) = ptsndb+wheadpt
+ else
+ hesk(nhssys) = eskgnd
+ hpts(nhssys) = ptsgnd+wheadpt
+ end if
+ fixednew = fixednew+hpts(nhssys)
+ scaldold = scaldold+hesk(nhssys)
+ end if
+ if (clchb) then
+ do 17 iv = 1 , nv
+ if (clchv(iv)) then
+ notexq = sq//'znotes'
+ lnote = 7
+ do 24 iiv = 2 , iv
+ notexq = notexq(1:lnote)//sepsymq(iiv-1)
+ lnote = lnote+1
+24 continue
+c
+c Recompute ioff since it will vary from voice to voice
+c
+ if (ibar .eq. 1) then
+ ioff = 0
+ else
+ ioff = nib(iv,ibar-1)
+ end if
+c
+c Must call clefsym to get nclef, even if there is a movement break
+c
+ call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef)
+c
+c If clefq = '8', must change '0' in pos'n 9 to '8'
+c
+ if (btest(ipl(iv,ioff+1),2)) fmtq =
+ * fmtq(1:8)//'8'//fmtq(10:10)
+ if (movbrk.eq.0 .and.
+ * islast)
+ * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%'
+ call wsclef(iv,ninow,nclef)
+c
+c Set new flag to be used just outside this loop, to kluge
+c any calls to \CenterBar for full-bar rests, to make room for clef.
+c
+ newclef = .true.
+c
+c 151220
+c wrong test:
+c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct%
+c Replaced with right one. But also, clefq(iv) seems to stay at 8 here,
+c and if we change from TLO to normal clef, need to resetclefsymbols
+c
+c if (clefq(iv) .eq. '8') then
+ if (btest(ipl(iv,ioff+1),2)) then
+c
+c Find instrument number for voice iv
+c
+ iv1 = 1
+ do 1111 iinst = 1 , ninow
+ if (iv .lt. iv1+nspern(iinst)) go to 2222
+ iv1 = iv1+nspern(iinst)
+1111 continue
+ print*
+ print*,'Should not be here in pmxb!'
+ call stop1()
+2222 continue
+ if (iinst .le. 9) then
+ write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',iinst,
+ * sq//'treblelowoct%'
+ else
+ write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',iinst,
+ * sq//'treblelowoct%'
+ end if
+ c8flag(iv) = .true.
+ else
+ if (clefq(iv) .eq. '8') then
+ write(11,'(a20)')sq//'resetclefsymbols'
+ end if
+ end if
+ end if
+17 continue
+ if (islast) write(11,'(a)')sq//'pmxnewclefs'
+ end if
+23 continue
+c
+c Kluge \CenterBar for whole bar rests if necessary
+c
+ if (newclef .and. centrests) then
+c write(11,'(a)')sq//'def'//sq//'value{11}%'
+ nvalue = nint(.55*musicsize)
+ if (nvalue .gt. 10) then
+ write(11,'(a11,i2,a2)')
+ * sq//'def'//sq//'value{',nvalue,'}%'
+ else
+ write(11,'(a11,i1,a2)')
+ * sq//'def'//sq//'value{',nvalue,'}%'
+ end if
+ end if
+ newclef = .false.
+ centrests = .false.
+c
+c End of loop for end-of-bar hardspaces and non-movbrk clef symbol.
+c
+ if (bar1syst) then
+ read(12,*) poenom
+ end if
+c
+c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1)
+c
+ if (ibar .eq. 1) then
+ islnow = islur(1,1)
+c iornqnow = iornq(1,1)
+ iplnow = ipl(1,1)
+ else
+ islnow = islur(1,nib(1,ibar-1)+1)
+c iornqnow = iornq(1,nib(1,ibar-1)+1)
+ iplnow = ipl(1,nib(1,ibar-1)+1)
+ end if
+c
+c Check for R-symbols set at end of prior input block
+c
+ if (movbrk.eq.0 .and. rptfq2.ne.'E') then
+ if (rptfq2 .eq. 'D') then
+ islnow = ibset(islnow,26)
+ else if (rptfq2 .eq. 'r') then
+ islnow = ibset(islnow,6)
+ else if (rptfq2 .eq. 'd') then
+ islnow = ibset(islnow,8)
+ else if (rptfq2 .eq. 'b') then
+ islnow = ibset(islnow,25)
+ else
+ print*
+ print*,'Illegal symbol with "R" at end of input block:',
+ * rptfq2
+ call stop1()
+ end if
+ rptfq2 = 'E'
+ end if
+ if (iand(islnow,352) .ne. 0) then
+c
+c Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set
+c
+ lrpt = btest(islnow,5)
+ rrpt = btest(islnow,6)
+ lrptpend = lrpt.and.bar1syst
+ if (lrpt .and. .not.lrptpend) then
+ if (rrpt) then
+ if (islast) write(11,'(a)')sq//'setleftrightrepeat'
+ fixednew = fixednew+wheadpt*lrrptfac-0.4
+ else
+ if (islast) write(11,'(a)')sq//'setleftrepeat'
+ fixednew = fixednew+wheadpt*rptfac-0.4
+ end if
+ else if (rrpt) then
+ if (islast) write(11,'(a)')sq//'setrightrepeat'
+ fixednew = fixednew+wheadpt*rptfac-0.4
+ else if (btest(islnow,8)) then
+ if (islast) write(11,'(a)')sq//'setdoublebar'
+ fixednew = fixednew+wheadpt*dbarfac-0.4
+ end if
+ else if (btest(islnow,26)) then
+c
+c doubleBAR
+c
+ if (islast) write(11,'(a)')sq//'setdoubleBAR'
+ fixednew = fixednew+wheadpt*ddbarfac-0.4
+c else if (btest(iornqnow,29)) then
+ else if (btest(iplnow,0)) then
+c
+c no bar line
+c
+c-- if (islast) write(11,'(a)')sq//'setzalaligne'
+c++
+ if (islast) then
+ if (movbrk .eq. 0) then
+ write(11,'(a)')sq//'setzalaligne'
+ else
+c
+c Encountered "Rz" at start of input block at start of new movement, Must
+c use newmovement macro with arg 4 rather than setzalaligne, since former
+c already redefines stoppiece.
+c
+ rptfq2 = 'z'
+ end if
+ end if
+c++
+ fixednew = fixednew-0.4
+ end if
+c
+c 1st and 2nd endings
+c
+ svolta = btest(islnow,7)
+ evolta = btest(islnow,9)
+ if (evolta) then
+ if (btest(islnow,10)) then
+ if (islast) write(11,'(a)')sq//'endvoltabox'
+ else
+ if (islast) write(11,'(a)')sq//'endvolta'
+ end if
+ onvolt = .false.
+ end if
+ if (svolta) then
+ nvolt = nvolt+1
+ lvoltxt = index(voltxtq(nvolt),' ')-1
+ if (lvoltxt .eq. 1) then
+ if (islast) write(11,'(a)')sq//'Setvolta'
+ * //voltxtq(nvolt)(1:1)//'%'
+ else
+ if (islast) write(11,'(a)')sq//'Setvolta'//'{'//
+ * voltxtq(nvolt)(1:lvoltxt)//'}%'
+ end if
+ onvolt = .true.
+ end if
+ if (ibar .gt. 1) then
+ ipnow = nib(1,ibar-1)+1
+ else
+ ipnow = 1
+ end if
+ iplnow = ipl(1,ipnow)
+ if (bar1syst) then
+c
+c If listslur>0, then there is at least one slur or tie carried over the break
+c
+ ispstie = .false.
+ if (OptLineBreakTies .and. .not.fontslur .and. listslur.ne.0
+ * .and. islast)
+ * call LineBreakTies(isdat1,isdat2,isdat3,isdat4, nsdat,
+ * ispstie,sepsymq)
+ iline = iline+1
+c
+c End an old system, Start a new system
+c
+c Reduce space before mbrest at start of system
+c Need this even if no accidentals in key signature
+c
+ if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize
+c
+ if (iline .ne. 1) then
+c
+c Not first line.
+c Get corrected poe = points/elemskip for *previous* system
+c
+ wdpt = widthpt*(1-fracindent)
+ poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
+ * (elsktot+fbar*nbarss-scaldold)
+ isyscnt = isyscnt+1
+ poevec(isyscnt) = poe
+c
+c Transfer data for system into global arrays to hold until very end
+c
+ do 9 ia = 1 , nasksys
+ iask = iask+1
+ ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))
+ * /poefa(iline-1)
+c
+c Only admit negative ask if it was user-defined space, signalled by elask<=0.
+c
+ if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
+9 continue
+ do 25 ia = 1 , nhssys
+ nhstot = nhstot+1
+ hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
+25 continue
+c
+c Reset counters for new system
+c
+ scaldold = 0.
+ fixednew = 0.
+ nasksys = 0
+ nhssys = 0
+ end if
+c
+c End of if block for first bar of non-first system. Still 1st bar, any system
+c
+ if (islast.and.figbass) write(11,'(a)')sq//'fixdrop%'
+ isystpg = isystpg+1
+c
+c Try moving the next stmt way down, to fix a bug and get \eject printed at
+c end of single-system page.
+c if (isystpg .eq. nsystp(ipage)) isystpg = 0
+ read(12,*)nbarss,elsktot,fsyst,frac,eonk,ewmxk
+ if (iline .gt. 1) fracindent=frac
+ if (figbass) then
+ ifigdr(1,iline) = 4
+ ifigdr(2,iline) = 4
+ end if
+ slfac = slfac1*musicsize*elsktot
+ if (iline .ne. 1) then
+c
+c For the line just _finished_, put figdrop in separate file.
+c
+ if (figbass) write(14,'(a9,i2,a10,i2,1x,a4)')
+ * sq//'figdrop=',ifigdr(1,iline-1),
+ * ' '//sq//'figdtwo=',ifigdr(2,iline-1),sq//'or%'
+c
+c Check slurs in top staff for interference w/ barno. Only check when
+c # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS
+c keep track of ons and offs when |isig|<=3.
+c
+ ndigbn = int(alog10(ibarcnt+ibcoff+.01))+1
+ isnx = 0
+ if (ndigbn.ge.iabs(isig) .and. is1n1.gt.0) then
+c
+c There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1
+c Look for termination in remainder of this input block. If not found,
+c just use is1n1. Remember, haven't slid down yet.
+c
+ ioff = 0
+ if (ibar .gt. 1) ioff = nib(ivmx(nv,nvmx(nv)),ibar-1)
+ do 50 isdat = 1 , nsdat
+ if (igetbits(isdat1(isdat),5,13).eq.ivmx(nv,nvmx(nv))
+ * .and. .not.btest(isdat1(isdat),11)
+ * .and. igetbits(isdat1(isdat),7,19).eq.is2n1) then
+c
+c Found slur ending. Just check note height, can't do fine adjustments.
+c
+c is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19))
+ is1n1 = max(is1n1,igetbits(isdat2(isdat),7,19))
+ go to 51
+ end if
+50 continue
+c
+c If exiting loop normally, did not find end of slur. c'est la vie.
+c
+51 continue
+ isnx = idim(is1n1,ncmid(nv,1)+1+irzbnd)
+ if (isnx .gt. 0) then
+c
+c AHA! Slur likely to interfere with barno.
+c
+c Modified 090525 to use \bnrs
+c
+ slint = .true.
+ fmtq = '(a16,i1,a14)'
+ if (irzbnd+isnx .gt. 9) fmtq = '(a16,i2,a14)'
+ if (islast) write(11,fmtq)sq//'def'//sq//'raisebarno{',
+ * irzbnd+isnx,'.5'//sq//'internote}%'
+c if (islast) then
+c if (isnx .le. 9) then
+c write(11,'(a5,i1,a2)')sq//'bnrs',isnx,'0%'
+c else
+c write(11,'(a6,i2,a3)')sq//'bnrs{',isnx,'}0%'
+c end if
+c end if
+c
+ end if
+ end if
+ if (movbrk .gt. 0) then
+c
+c movbrk = 0
+c Move the reset down, so can use movbrk>0 to stop extra meter prints.
+c
+c New movement. Redefine stoppiece, contpiece. These will be called either
+c explicitly or as part of alaligne.
+c indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat.
+c This is passed to \newmovement.
+c
+ if (rptfq2 .eq. 'E') rptfq2 = 'D'
+ indsym = index('Ddrbz',rptfq2)-1
+ rptfq2 = 'E'
+c
+c Also check for Rd or Rr set the normal way
+c
+ if (btest(islnow,8)) then
+ indsym = 1
+ else if (btest(islnow,6)) then
+ indsym = 2
+ end if
+ if (indsym .lt. 0) then
+ print*
+ print*,'Illegal end symbol before "/"'
+ call stop1()
+ end if
+c
+c Check for continuation (no bar number reset)
+c
+ if (islast.and.nobar1) then
+ write(11,'(a)')sq//'advance'//sq//'barno1'
+ * //sq//'global'//sq//'startbarno'//sq//'barno%'
+c
+c Need above for shortening case mcm with Mc
+c
+ end if
+c
+c Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement
+c
+c if (movgap .lt. 10) then
+c if (islast) write(11,'(a12,2i1,a1)')
+c * sq//'newmovement',movgap,indsym,'%'
+c else
+c if (islast) write(11,'(a13,i2,a1,i1,a1)')
+c * sq//'newmovement{',movgap,'}',indsym,'%'
+c end if
+ if (islast) then
+ nmq = sq//'newmovement'
+ lnmq = 12
+ if (movgap .lt. 10) then
+ lnmq = 14
+ write(nmq(13:14),'(2i1)')movgap,indsym
+ else
+ lnmq = 17
+ write(nmq(13:17),'(a1,i2,a1,i1)')'{',movgap,'}',indsym
+ end if
+ if (ninow .lt. 10) then
+ lnmq = lnmq+1
+ write(nmq(lnmq:lnmq),'(i1)')ninow
+ else
+ lnmq = lnmq+4
+ write(nmq(lnmq-3:lnmq),'(a1,i2,a1)')'{',ninow,'}'
+ end if
+ lnmq = lnmq+1
+ write(nmq(lnmq:lnmq),'(a1)')'%'
+ if (ishort .eq. 4) then
+c
+c Ending Short-blank-coda
+c
+ write(11,'(a)')sq//'Endpiece}}%'
+ end if
+ write(11,'(a)')nmq(1:lnmq)
+ if (ishort .eq. 2) then
+ write(11,'(a)')sq//'stoppiece}}%'
+ ishort = 5
+ else if (ishort .eq. 4) then
+ write(11,'(a)')sq//'let'//sq//'stoppiece'//sq//
+ * 'holdstop%'
+c
+c Since we bypass newmovement, need to set the vertical gap.
+c
+ if (movgap .gt. 10) then
+ write(11,'(a6,i2,a11)')
+ * sq//'vskip',movgap,sq//'internote%'
+ else if (movgap .gt. 0) then
+ write(11,'(a6,i1,a11)')
+ * sq//'vskip',movgap,sq//'internote%'
+ end if
+ ishort = 6
+ end if
+ if ((ishort.eq.5.or.ishort.eq.6).and..not.rename) then
+ do 62 iinst = 1 , ninow
+ if (islast) then
+ if (iinst .lt. 10) then
+ write(11,'(a8,i1,a3)')sq//'setname',iinst,'{}%'
+ else
+ write(11,'(a9,i2,a4)')sq//'setname{',iinst,
+ * '}{}%'
+ end if
+ end if
+62 continue
+ end if
+ rename = .false.
+ end if
+c
+c Change generalmeter if necessary
+c
+ if (islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ end if
+c Removed next line 211207 to fix beaming problem at new movement+meter change.
+c mtrnuml = 0
+c
+c (Moved all name-writing to getnote, right when 'M' is detected)
+c
+ if (btest(iplnow,28)) then
+c
+c Key signature at movement break
+c
+ iplnow = ibclr(iplnow,28)
+ if (isig .gt. 0) then
+ if (islast) write(11,'(a18,i1,a2)')
+ * sq//'generalsignature{',isig,'}%'
+ else
+ if (islast) write(11,'(a18,i2,a2)')
+ * sq//'generalsignature{',isig,'}%'
+ end if
+ if (islast .and. LaterInstTrans) then
+ call Writesetsign(nInstTrans,iInstTrans,iTransKey,
+ * LaterInstTrans)
+ end if
+ end if
+ if (parmov .ge. -.1) then
+c
+c Resent paragraph indentation
+c
+ ipi = parmov*widthpt+.1
+ if (ipi .lt. 10) then
+ if (islast) write(11,'(a11,i1,a2)')
+ * sq//'parindent ',ipi,'pt'
+ else if (ipi .lt. 100) then
+ if (islast)
+ * write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
+ else
+ if (islast)
+ * write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
+ end if
+ end if
+ if (ishort .eq. 6) then
+ if (iflagbot .eq. 1) then
+ write(11,'(a)')sq//'vfill'//sq//'eject'
+c iflagbot = 0
+c ishort = 0
+ else
+ write(11,'(a)')sq//'contpiece'
+ end if
+c
+c Zero ishort later trying to write alaligne
+c
+ end if
+ end if ! End of movement break stuff
+ if (isystpg .eq. 1) then
+c
+c First line on a page (not 1st page, still first bar). Tidy up old page
+c then eject.
+c
+c Removed this 5/13/01 as it was causing double endvoltas. This probably
+c is only needed at the end in case there is no endvolta specified.
+c if (onvolt) then
+cc if (islast) write(11,'(a)')sq//'endvoltabox%'
+cc onvolt = .false.
+c end if
+c
+c
+c Check for meter change at start of a new PAGE
+c
+ if (mtrnuml .gt. 0) then
+c
+c Meter change at start of a new page. Ugly repeated coding here.
+c
+ mtrnms = mtrnuml
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ mtrnuml = mtrnms
+ if (movbrk .eq. 0 .and. islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ end if
+ end if
+c
+c Key signature change?
+c
+ if (btest(iplnow,28) .and. movbrk.eq.0) then
+ notexq = sq//'xbar'//sq//'addspace{-'//sq//
+ * 'afterruleskip}'//sq//'generalsignature{'
+ lnote = 49
+ if (isig .lt. 0) then
+ notexq = notexq(1:49)//'-'
+ lnote = 50
+ end if
+ if (islast) write(11,'(a)')
+ * notexq(1:lnote)//chax(48+abs(isig))//'}%'
+ if (islast .and. LaterInstTrans) then
+ call Writesetsign(nInstTrans,iInstTrans,iTransKey,
+ * LaterInstTrans)
+ end if
+ if (islast .and. ignorenats)
+ * write(11,'(a)')sq//'ignorenats%'
+ if (islast) write(11,'(a)')sq//'zchangecontext'//sq
+ * //'addspace{-'//sq//'afterruleskip}'
+ * //sq//'zstoppiece'//sq//'PMXbarnotrue%'
+ else if (mtrnuml.gt.0 .and. movbrk.eq.0) then
+c
+c Meter change but no signature change
+c
+ if (islast)
+ * write(11,'(a)')sq//'xchangecontext'//sq//'addspace{-'//
+ * sq//'afterruleskip}'//sq//'let'//sq//'bnat'//sq//
+ * 'barnoadd%'
+ if (islast)
+ * write(11,'(a)')sq//'def'//sq//'barnoadd{'//sq//'let'//
+ * sq//'barnoadd'//sq//'bnat}'//sq//'zstoppiece%'
+ else
+ if (islast) then
+ if ((ishort.eq.4.or.ishort.eq.2)
+ * .and. iflagbot.eq.1) then
+ ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
+ if (ntmp .le. 9) then
+ shortfraq(1:1) = char(48+ntmp)
+ lntmp = 1
+ else
+ write(shortfraq(1:2),'(i2)')ntmp
+ lntmp = 2
+ end if
+ write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq
+ * //'barno'//shortfraq(1:lntmp)
+c
+c Move down so can insert fil@begin
+c iflagbot = 0
+c ishort = 0
+c
+ else if ((ishort.ne.6.and.ishort.ne.2) .or.
+ * iflagbot.ne.1) then
+ write(11,'(a)')sq//'stoppiece%'
+ end if
+ end if
+ end if
+c
+c This is the key spot when vshrink is used. Value of vshrink here comes from
+c just after the prior pagebreak, i.e., it is not affected by "Av"
+c that may have been entered at this pagebreak, since that only affects usevshrink.
+c So choose page *ending* (with or without \vfill) depending on old vshrink. Then
+c check value of usevshrink to reset vshrink if necessary for the new page, where
+c we have to set \interstaff and later call puttitle.
+c Top of first page needs special treatment. For this we use
+c novshrinktop, which was set in g1etnote on the first pass, since on
+c second pass, vshrink at top of page one is dealt with in topfile, which is called
+c *before* any reading in any "Av" at the top of the first input block.
+c
+ if (.not.vshrink) then
+ if (islast .and. bottopgap) then
+ if (abs(botamt) .gt. 1.e-6) then
+ if (botamt .gt. 9.95) then
+ fmtq = '(a,f4.1,a)'
+ else if (botamt .gt. 0.) then
+ fmtq = '(a,f3.1,a)'
+ else if (botamt .gt. -9.95) then
+ fmtq = '(a,f4.1,a)'
+ else
+ fmtq = '(a,f5.1,a)'
+ end if
+ write(11,fmtq)sq//'null'//sq//'vskip',botamt,
+ * sq//'Internote%'
+ end if
+ end if
+ xnstbot = xnsttop(ipage)*etabot/etatop
+ if (xnstbot .lt. 9.95) then
+ fmtq = '(a,f3.1,a)'
+ else
+ fmtq = '(a,f4.1,a)'
+ end if
+ if (islast) write(11,fmtq)sq//'vskip',xnstbot,
+ * sq//'Interligne'//sq//'eject%'
+ if (islast .and. bottopgap) then
+ if (abs(topamt) .gt. 1.e-6) then
+ if (topamt .gt. 9.95) then
+ fmtq = '(a,f4.1,a)'
+ else if (topamt .gt. 0.) then
+ fmtq = '(a,f3.1,a)'
+ else if (topamt .gt. -9.95) then
+ fmtq = '(a,f4.1,a)'
+ else
+ fmtq = '(a,f5.1,a)'
+ end if
+ write(11,fmtq)sq//'null'//sq//'vskip',topamt,
+ * sq//'Internote%'
+ end if
+ bottopgap = .false.
+ end if
+ else
+ if (islast) then
+ if (iflagbot.eq.1.and.ishort.eq.6)then
+c
+c cleanup for case bcm only
+c
+ iflagbot = 0
+ ishort = 0
+ else
+ write(11,'(a)') sq//'vfill'//sq//'eject%'
+ if (iflagbot.eq.1.and.ishort.eq.2) then
+c Clean up case bsl only
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ iflagbot = 0
+ ishort = 0
+ end if
+ end if
+ end if
+ end if
+ ipage = ipage+1
+c
+c Now that page is ejected, compute new vshrink
+c
+ vshrink = xintstaff(ipage).gt.20 .and. usevshrink
+ if (vshrink) then
+ xinsnow = 10
+ else
+ xinsnow = xintstaff(ipage)
+ end if
+ if (fintstf.gt.0 .and. ipage.gt.1) then
+ xinsnow = xinsnow*fintstf/gintstf
+ fintstf = -1.
+ end if
+ if (xinsnow .lt. 9.95) then
+ fmtq = '(a,f3.1,a)'
+ else if (xinsnow .lt. 99.95) then
+ fmtq = '(a,f4.1,a)'
+ else
+ fmtq = '(a,f5.1,a)'
+ end if
+c
+c Vertical spacing parameters, then restart
+c
+ if (is4bignv) xinsnow = .95*xinsnow
+ if (islast) then
+ write(11,fmtq)sq//'interstaff{',xinsnow,
+ * '}'//sq//'contpiece'
+ end if
+c
+c Check for meter change at start of a new PAGE
+c
+ if (mtrnuml .gt. 0) then
+c
+c Meter change at start of a new page
+c
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ if (movbrk .eq. 0) then
+ if (islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ end if
+ if (mtrdnp .gt. 0) then
+ if (islast) write(11,'(a)')sq//'newtimes2%'
+ if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
+ end if
+ end if
+ end if
+c
+c If no real titles here, which there probably will never be, make vertical
+c space at page top with \titles{...}. headlog=.false.<=>no real titles
+c
+ if (ishort.eq.4 .and. iflagbot.eq.1) then
+ ishort = 0
+ iflagbot = 0
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'//sq//
+ * 'makeatother'
+ end if
+ call puttitle(inhnoh,xnsttop(ipage),etatop,
+ * sq,etait,etatc,etacs1,nv,vshrink,sepsymq)
+ if (HeaderSpecial)
+c
+c Write special header for first page
+c
+ * write(11,'(a)')chax(92)//'special{header=psslurs.pro}%'
+ else
+c
+c First bar of system, not a new page, force line break
+c
+ if (btest(iplnow,28)) then
+c
+c Signature change
+c
+ notexq = sq//'xbar'//sq//'addspace{-'//sq//
+ * 'afterruleskip}'//sq//'generalsignature{'
+ lnote = 49
+ if (isig .lt. 0) then
+ notexq = notexq(1:49)//'-'
+ lnote = 50
+ end if
+ if (islast) write(11,'(a)')notexq(1:lnote)
+ * //chax(48+abs(isig))//'}%'
+ if (islast .and. LaterInstTrans) then
+ call Writesetsign(nInstTrans,iInstTrans,iTransKey,
+ * LaterInstTrans)
+ end if
+ if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1%'
+ if (mtrnuml .ne. 0) then
+c
+c Meter+sig change, new line, may need mods if movement break here.
+c
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ if (islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ if (ignorenats) write(11,'(a)')sq//'ignorenats%'
+ write(11,'(a)')sq//'xchangecontext'//sq//
+ * 'addspace{-'//sq//'afterruleskip}'
+ * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
+ write(11,'(a)')sq//'addspace{-'//sq
+ * //'afterruleskip}%'
+ call wgmeter(mtrnmp,mtrdnp)
+ if (ignorenats) write(11,'(a)')sq//'ignorenats%'
+ write(11,'(a)')sq//'zchangecontext'
+ end if
+ else
+ if (islast .and. ignorenats)
+ * write(11,'(a)')sq//'ignorenats%'
+ if (islast) write(11,'(a)')sq//'xchangecontext'//sq//
+ * 'addspace{-'//sq//'afterruleskip}'
+ * //sq//'zstoppiece'//sq//'PMXbarnotrue'//sq//'contpiece%'
+ end if
+ else if (mtrnuml.eq.0.and.(ishort.eq.0.or.ishort.eq.6))
+ * then
+c
+c No meter change
+c
+ if (islast) then
+ if (ishort .ne. 6) then
+ write(11,'(a)')sq//'alaligne'
+ else
+ ishort = 0
+ end if
+ end if
+ else if (ishort .ne. 0) then
+ if (ishort .eq. 1) then ! Start short line
+ write(shortfraq,'(f3.2)')shortfrac
+ write(11,'(a)')sq//'stoppiece'//sq//'parindent 0pt'
+ write(11,'(a)')sq//'vskip'//sq//'parskip'
+ write(11,'(a)')sq//'hbox to'//sq//
+ * 'hsize{'//sq//'vbox{'//
+ * sq//'hsize='//shortfraq//sq//'hsize%'
+ write(11,'(a)')sq//'contpiece'
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ ibarcnt0 = ibarcnt
+ mbrsum = 0
+ ishort = 2
+ nmbr = 0
+ else if (ishort .eq. 2) then ! End short line, no new mvt
+ ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
+ if (ntmp .le. 9) then
+ shortfraq(1:1) = char(48+ntmp)
+ lntmp = 1
+ else
+ write(shortfraq(1:2),'(i2)')ntmp
+ lntmp = 2
+ end if
+ write(11,'(a)')sq//'stoppiece}}'//sq//'advance'//sq
+ * //'barno'//shortfraq(1:lntmp)
+c
+c Not clear why we needed this
+c //sq//'startbarno'//sq//'barno%'
+ write(11,'(a)')sq//'contpiece'
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ ishort = 0
+ else if (ishort .eq. 5) then ! End short line, new mvt
+ if (nobar1) then ! Continue bar numbering
+ write(11,'(a)')sq//'advance'//sq
+ * //'barno'//char(ibarcnt-ibarcnt0+48)
+ * //sq//'startbarno'//sq//'barno%'
+c
+c Must leave in \startbarno to get msm with LMc to work.
+c
+ end if
+ write(11,'(a)')sq//'startpiece'//sq//'addspace'//sq
+ * //'afterruleskip%'
+ ishort = 0
+ else if (ishort .eq. 3) then ! Mid line gap, start coda
+c May never come thru here. Stuff is done later at least for mcl.pmx
+ write(shortfraq,'(f3.2)')codafrac
+ write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq
+ * //'barno'//char(ibarcnt-ibarcnt0+48)//sq//
+ * 'startbarno'//sq//'barno%'
+ write(11,'(a)')sq//'hfill'//sq//
+ * 'vbox{'//sq//'hsize='//shortfraq//'%'
+ write(11,'(a)')sq//'contpiece'
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ ishort = 4
+ else if (ishort .eq. 4) then ! End coda
+ ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
+ if (ntmp .le. 9) then
+ shortfraq(1:1) = char(48+ntmp)
+ lntmp = 1
+ else
+ write(shortfraq(1:2),'(i2)')ntmp
+ lntmp = 2
+ end if
+ write(11,'(a)')sq//'endpiece}}'//sq//'advance'//sq
+ * //'barno'//shortfraq(1:lntmp)
+ write(11,'(a)')sq//'contpiece'
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ ishort = 0
+ mbrsum = 0
+ nmbr = 0
+ end if
+ else if (mtrnuml .ne. 0) then
+
+c
+c New meter, no new sig, end of line, not new page.
+c
+c \generalmeter{\meterfrac{3}{4}}%
+c \xchangecontext\addspace{-\afterruleskip}%
+c \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}%
+c \zchangecontext
+c
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ if (movbrk .eq. 0) then
+ if (islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ end if
+ if (mtrdnp .gt. 0) then
+ if (islast) then
+ write(11,'(a)')
+ * sq//'let'//sq//'bnat'//sq//'barnoadd'
+ * //sq//'def'//sq//'barnoadd{'//sq//'empty}%'
+ write(11,'(a)')sq//'xchangecontext'//sq//
+ * 'addspace{-'//sq//'afterruleskip}'//sq//
+ * 'zalaligne'//sq//'let'//sq//'barnoadd'//sq//'bnat'
+ call wgmeter(mtrnmp,mtrdnp)
+ write(11,'(a)')sq//'addspace{-'//sq//
+ * 'afterruleskip}'//sq//'zchangecontext'
+ end if
+ if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
+ else
+ if (islast) write(11,'(a)')sq//'alaligne'
+ end if
+ else
+ if (islast) write(11,'(a)')sq//'alaligne'
+ end if
+ end if
+ end if
+c
+c Modified 090525 to use \bnrs
+c
+ if (slint) then
+ slint = .false.
+ if (islast) write(11,'(a16,i1,a14)')sq//'def'//sq//
+ * 'raisebarno{',irzbnd,'.5'//sq//'internote}%'
+ end if
+ movbrk = 0
+ end if
+c
+c Clean up if we squelched bar number reset at movement break
+c
+ if (nobar1) then
+ if (islast) write(11,'(a)')sq//'startbarno1'
+ nobar1 = .false.
+ end if
+ read(12,*,end=14)iauto
+14 continue
+c
+c We come thru here for the 1st bar of every system, so initialize is1n1
+c
+ is1n1 = 0
+c
+c Brought down from above
+c
+ if (isystpg .eq. nsystp(ipage)) then
+ isystpg = 0
+c
+c The following is to avoid moving this reset of isystpg, but still send a signal
+c down below for last system shortening events
+c
+ if (ishort.eq.2) iflagbot = 1
+ end if
+c
+c Check for linebreak ties
+c
+ if (ispstie)
+ * call LineBreakTies(isdat1,isdat2,isdat3,isdat4,nsdat,
+ * ispstie,sepsymq)
+ else
+c
+c Not first bar of system
+c
+ if (btest(iplnow,28)) then
+c
+c Signature change
+c
+ if (mtrnuml .ne. 0) then
+c
+c Meter+signature change mid line, assume no movement break
+c
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ if (islast) call wgmeter(mtrnmp,mtrdnp)
+ notexq = sq//'generalsignature{'
+ lnote = 18
+ if (isig .lt. 0) then
+ notexq = notexq(1:18)//'-'
+ lnote = 19
+ end if
+ if (islast) then
+ iptemp = 48+abs(isig)
+ charq = chax(iptemp)
+ notexq = notexq(1:lnote)//charq//'}%'
+ lnote = lnote+3
+ write(11,'(a)')notexq(1:lnote)
+ if (islast .and. LaterInstTrans) then
+ call Writesetsign(nInstTrans,iInstTrans,iTransKey,
+ * LaterInstTrans)
+ end if
+ if (ignorenats) write(11,'(a)')sq//'ignorenats%'
+ write(11,'(a)')sq//'xchangecontext%'
+ end if
+ if (ibar .eq. ibarmbr) then
+c
+c Compute space for multibar rest
+c
+ if (lastisig*isig .ge. 0) then
+ naccs = max(abs(lastisig),abs(isig))
+ else
+ naccs = abs(lastisig-isig)
+ end if
+c xb4mbr = (facmtr+naccs*.24)*musicsize
+ xb4mbr = -.2*musicsize
+ end if
+ else
+c
+c Signature change only
+c
+ notexq = sq//'xbar'//sq//'addspace{-'//sq//
+ * 'afterruleskip}'//sq//'generalsignature{'
+ lnote = 49
+ if (isig .lt. 0) then
+ notexq = notexq(1:49)//'-'
+ lnote = 50
+ end if
+ if (islast)
+ * write(11,'(a)')notexq(1:lnote)//chax(48+abs(isig))//'}%'
+ if (islast .and. LaterInstTrans) then
+ call Writesetsign(nInstTrans,iInstTrans,iTransKey,
+ * LaterInstTrans)
+ end if
+ if (islast .and. ignorenats)
+ * write(11,'(a)')sq//'ignorenats%'
+ if (islast) write(11,'(a)')sq//'zchangecontext'//sq
+ * //'addspace{-.5'// sq//'afterruleskip}%'
+ if (ibar .eq. ibarmbr) then
+c
+c Compute space for multibar rest
+c
+ if (lastisig*isig .ge. 0) then
+ naccs = max(abs(lastisig),abs(isig))
+ else
+ naccs = abs(lastisig-isig)
+ end if
+c xb4mbr = naccs*.24*musicsize
+ xb4mbr = -.2*musicsize
+ end if
+ end if
+ else if (ishort .eq. 3) then
+c
+c Gap before coda, assumed no signature change!
+c
+ ntmp = ibarcnt-ibarcnt0-nmbr+mbrsum
+ if (ntmp .le. 9) then
+ shortfraq(1:1) = char(48+ntmp)
+ lntmp = 1
+ else
+ write(shortfraq(1:2),'(i2)')ntmp
+ lntmp = 2
+ end if
+ write(11,'(a)')sq//'endpiece}'//sq//'advance'//sq
+ * //'barno'//shortfraq(1:lntmp)
+ if (nocodabn) then
+ write(11,'(a)')sq//'nobarno'
+ nocodabn = .false.
+ end if
+ write(shortfraq,'(f3.2)')codafrac
+ write(11,'(a)')sq//'hfill'//sq//
+ * 'vbox{'//sq//'hsize='//shortfraq//sq//'hsize%'
+ write(11,'(a)')sq//'contpiece'
+ write(11,'(a)')sq//'makeatletter'//sq//'fil@begin'
+ * //sq//'makeatother'
+ ishort = 4
+ else if (mtrnuml .eq. 0) then
+c
+c No meter change
+c
+ if (islast) write(11,'(a)')sq//'xbar'
+ else
+c
+c Change meter midline
+c
+ call setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+ if (movbrk .eq. 0) then
+ if (islast) then
+ call wgmeter(mtrnmp,mtrdnp)
+ end if
+ if (mtrdnp .gt. 0) then
+ if (islast) then
+ write(11,'(a,2i1,a)')sq//'newtimes0%'
+ end if
+c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize
+ if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize
+ else
+ if (islast) write(11,'(a)')sq//'xbar'
+ end if
+ end if
+ end if
+ end if
+c
+c Now that xbar's are written, can put in left-repeats at line beginnings
+c
+ if (lrptpend) then
+ if (islast) write(11,'(a)')sq//'advance'//sq//'barno-1'
+ * //sq//'leftrepeat'
+ lrptpend = .false.
+ end if
+ if (ibar .gt. 1) then
+c
+c For bars after first, slide all stuff down to beginning of arrays
+c
+ do 11 iv = 1 , nv
+ do 1199 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ ioff = nib(ivx,ibar-1)
+ do 12 ip = 1 , nib(ivx,ibar)-ioff
+ nolev(ivx,ip) = nolev(ivx,ip+ioff)
+ nodur(ivx,ip) = nodur(ivx,ip+ioff)
+ nacc(ivx,ip) = nacc(ivx,ip+ioff)
+ irest(ivx,ip) = irest(ivx,ip+ioff)
+ islur(ivx,ip) = islur(ivx,ip+ioff)
+ ipl(ivx,ip) = ipl(ivx,ip+ioff)
+ iornq(ivx,ip) = iornq(ivx,ip+ioff)
+ mult(ivx,ip) = mult(ivx,ip+ioff)
+ if (figbass .and. ivx.eq.1 .or. ivx.eq.ivxfig2) then
+ if (ivx.eq.1) then
+ isfig(1,ip) = isfig(1,ip+ioff)
+ else
+ isfig(2,ip) = isfig(2,ip+ioff)
+ end if
+ end if
+12 continue
+ if (ivx.le.nv .and. ncc(iv).gt.1) then
+ islide = 0
+ do 13 icc = 1 , ncc(iv)
+ if (tcc(iv,icc) .le. lenbar) then
+c
+c This time will drop <=0 when slid.
+c
+ islide = icc-1
+ ncmidcc(iv,1) = ncmidcc(iv,icc)
+ else
+ tcc(iv,icc-islide) = tcc(iv,icc)-lenbar
+ ncmidcc(iv,icc-islide) = ncmidcc(iv,icc)
+ end if
+13 continue
+ ncc(iv) = ncc(iv)-islide
+ tcc(iv,1) = 0.
+ end if
+1199 continue
+11 continue
+ do 15 ig = 1 , ngrace
+ ipg(ig) = ipg(ig)-nib(ivg(ig),ibar-1)
+ if (ibar .gt. 2) ipg(ig) = ipg(ig)+nib(ivg(ig),ibar-2)
+15 continue
+ do 21 il = 1 , nlit
+ iplit(il) = iplit(il)-nib(ivlit(il),ibar-1)
+ if (ibar .gt. 2) iplit(il) = iplit(il)+nib(ivlit(il),ibar-2)
+21 continue
+ do 22 it = 1 , ntrill
+ iptrill(it) = iptrill(it)-nib(ivtrill(it),ibar-1)
+ if (ibar .gt. 2) iptrill(it) =
+ * iptrill(it)+nib(ivtrill(it),ibar-2)
+22 continue
+ do 27 icrd = 1 , ncrd
+ ivx = iand(15,ishft(icrdat(icrd),-8))
+ * +16*igetbits(icrdat(icrd),1,28)
+ ipnew = iand(255,icrdat(icrd))-nib(ivx,ibar-1)
+ if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
+ icrdat(icrd) = iand(not(255),icrdat(icrd))
+ icrdat(icrd) = ior(max(0,ipnew),icrdat(icrd))
+27 continue
+ do 29 iudorn = 1 , nudorn
+ ivx = ivxudorn(iudorn)
+ ipnew = iand(255,kudorn(iudorn))-nib(ivx,ibar-1)
+ if (ibar .gt. 2) ipnew = ipnew+nib(ivx,ibar-2)
+ kudorn(iudorn) = iand(not(255),kudorn(iudorn))
+ kudorn(iudorn) = ior(max(0,ipnew),kudorn(iudorn))
+29 continue
+ do 42 idyn = 1 , ndyn
+ idynd = idyndat(idyn)
+ ivx = iand(15,idynd)+16*igetbits(idynda2(idyn),1,10)
+ ipnew = igetbits(idynd,8,4)-nib(ivx,ibar-1)
+c
+c The following construction avoids array bound errors in some compilers
+c
+ if (ibar .gt. 2) then
+ ipnew = ipnew+nib(ivx,ibar-2)
+ end if
+ ipnew = dim(ipnew,0)
+ call setbits(idynd,8,4,ipnew)
+ idyndat(idyn) = idynd
+42 continue
+ do 43 itxtdyn = 1 , ntxtdyn
+ idynd = ivxiptxt(itxtdyn)
+ ivx = iand(31,idynd)
+ ipnew = igetbits(idynd,8,5)-nib(ivx,ibar-1)
+ if (ibar .gt. 2) then
+ ipnew = ipnew+nib(ivx,ibar-2)
+ end if
+ ipnew = dim(ipnew,0)
+c call setbits(idynd,8,4,ipnew)
+ call setbits(idynd,8,5,ipnew)
+ ivxiptxt(itxtdyn) = idynd
+43 continue
+ do 41 isdat = 1 , nsdat
+ isdata = isdat1(isdat)
+ ivx = ivmx(igetbits(isdata,5,13),igetbits(isdata,1,12)+1)
+ ipnew = igetbits(isdata,8,3)-nib(ivx,ibar-1)
+ if (ibar .gt. 2) then
+ ipnew = ipnew+nib(ivx,ibar-2)
+ end if
+ ipnew = dim(ipnew,0)
+ call setbits(isdata,8,3,ipnew)
+ isdat1(isdat) = isdata
+41 continue
+ do 44 ibc = 1 , nbc
+ ivx = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
+ ipnew = igetbits(ibcdata(ibc),8,4)-nib(ivx,ibar-1)
+ if (ibar .gt. 2) then
+ ipnew = ipnew+nib(ivx,ibar-2)
+ end if
+ ipnew = dim(ipnew,0)
+ call setbits(ibcdata(ibc),8,4,ipnew)
+44 continue
+ do 45 iarps = 1 , NumArpShift
+ IpArpShift(iarps) =
+ * IpArpShift(iarps)-nib(IvArpShift(iarps),ibar-1)
+ if (ibar .gt. 2) then
+ IpArpShift(iarps) =
+ * IpArpShift(iarps)+nib(IvArpShift(iarps),ibar-2)
+ end if
+45 continue
+c
+c Bookkeeping for figures. This will set nfigs = 0 if there are no figs left.
+c If there are figs left, it will reset all times relative to start of
+c current bar.
+c
+ do 46 ivx = 1 , 2
+ if (figbass) then
+ islide = 0
+ do 20 jfig = 1 , nfigs(ivx)
+ if (itfig(ivx,jfig) .lt. lenbar) then
+c
+c This figure was already used
+c
+ islide = jfig
+ else
+ itfig(ivx,jfig-islide) = itfig(ivx,jfig)-lenbar
+ figq(ivx,jfig-islide) = figq(ivx,jfig)
+ itoff(ivx,jfig-islide) = itoff(ivx,jfig)
+ ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig)
+ ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig)
+ end if
+20 continue
+ nfigs(ivx) = nfigs(ivx)-islide
+ end if
+ if (nfigs(2) .eq. 0) go to 47
+46 continue
+47 continue
+ end if
+c
+c End of sliding down for bars after first in gulp.
+c
+c The following may not be needed by makeabar, but just in case...
+c
+ if (firstgulp .and. lenb0.ne.0) then
+ if (ibar .eq. 1) then
+ lenbar = lenb0
+ else
+ lenbar = lenb1
+ end if
+ end if
+c
+c Equal line spacing stuff
+c
+ if (equalize .and. bar1syst) then
+ if (isystpg .eq. 1) then
+ write(11,'(a)')sq//'starteq%'
+ else if (isystpg .eq. nsystp(ipage)-1) then
+ write(11,'(a)')sq//'endeq%'
+ end if
+ end if
+ call make1bar(ibmrep,tglp1,tstart,cwrest,squez,
+ * istop,numbms,istart)
+ call make2bar(ninow,tglp1,tstart,cwrest,squez,
+ * istop,numbms,istart,clefq)
+c
+c Hardspace before barline?
+c
+ hardb4 = 0.
+ do 35 iv = 1 , nv
+ do 3599 kv = 1 , nvmx(iv)
+ ivx = ivmx(iv,kv)
+ if (btest(irest(ivx,nn(ivx)),18)) then
+ nudoff(ivx) = nudoff(ivx)+1
+ hardb4 = max(hardb4,udoff(ivx,nudoff(ivx)))
+ end if
+3599 continue
+35 continue
+ if (hardb4 .gt. 0.) then
+ if (islast) write(11,'(a11,f5.1,a4)')sq
+ * //'hardspace{',hardb4,'pt}%'
+c
+c This was causing an incorrect poe in an example, which did not affect main
+c spacing, but did cause an extra accidental space to be too small
+c
+ fixednew = fixednew-hardb4
+ end if
+10 continue
+ firstgulp = .false.
+ lenb0 = 0
+ go to 30
+40 close(12)
+ close(13)
+ ilbuf = 1
+ ipbuf = 0
+ wdpt = widthpt
+ if (iline .eq. 1) wdpt = widthpt*(1-fracindent)
+ poe = (wdpt-fsyst*musicsize-0.4*nbarss-fixednew)/
+ * (elsktot+fbar*nbarss-scaldold)
+ poevec(nsyst) = poe
+ if (.not.islast) then
+ close(11)
+ close(16)
+ if (figbass) close(14)
+ return
+ end if
+ do 19 ia = 1 , nasksys
+ iask = iask+1
+ ask(iask) = (wasksys(ia)/poe-abs(elasksys(ia)))/poefa(iline)
+ if (elasksys(ia).gt.0) ask(iask)=dim(ask(iask),0.)
+19 continue
+ do 26 ia = 1 , nhssys
+ nhstot = nhstot+1
+ hpttot(nhstot) = max(hpts(ia)-hesk(ia)*poe,0.)
+26 continue
+ if (islast .and.
+ * onvolt) write(11,'(a)')sq//'endvoltabox'
+ rendq = '% '
+ if (ishort .ne. 0) rendq = '}}%'
+ if (rptfq2 .ne. 'E') then
+c
+c Terminal repeat. Right or double?
+c
+ if (rptfq2 .eq. 'r') then
+ if (islast) write(11,'(a)')sq//'setrightrepeat'
+ * //sq//'endpiece'//rendq
+ else if (rptfq2 .eq. 'd') then
+ if (islast) write(11,'(a)')sq//'setdoublebar'//sq//'endpiece'
+ * //rendq
+ else if (rptfq2 .eq. 'b') then
+ if (islast) write(11,'(a)')sq//'endpiece'//rendq
+ else if (rptfq2 .eq. 'z') then
+ if (islast) write(11,'(a)')sq//'setzalaligne'//sq//'Endpiece'
+ * //rendq
+ else
+ print*
+ print*,'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
+ write(15,*)'R? , ? not "d","r",or"b","z"; rptfq2:',rptfq2
+ if (islast) write(11,'(a)')sq//'Endpiece'
+ end if
+ else
+ write(11,'(a)')sq//'Endpiece'//rendq
+ end if
+ if (.not.vshrink) then
+ if (islast .and. bottopgap) then
+ if (abs(botamt) .gt. 1.e-6) then
+ if (botamt .gt. 9.95) then
+ fmtq = '(a,f4.1,a)'
+ else if (botamt .gt. 0.) then
+ fmtq = '(a,f3.1,a)'
+ else if (botamt .gt. -9.95) then
+ fmtq = '(a,f4.1,a)'
+ else
+ fmtq = '(a,f5.1,a)'
+ end if
+ write(11,fmtq)sq//'null'//sq//'vskip',botamt,
+ * sq//'Internote%'
+ end if
+ end if
+ xnstbot = xnsttop(ipage)*etabot/etatop
+ if (xnstbot .lt. 9.95) then
+ fmtq = '(a,f3.1,a)'
+ else
+ fmtq = '(a,f4.1,a)'
+ end if
+ if (islast) write(11,fmtq)sq//'vskip',xnstbot,
+ * sq//'Interligne'//sq//'eject'//sq//'endmuflex'
+ if (islast) write(11,'(a)')sq//'bye'
+ else
+ if (islast) write(11,'(a)')
+ * sq//'vfill'//sq//'eject'//sq//'endmuflex'
+ if (islast) write(11,'(a)')sq//'bye'
+ end if
+ rewind(11)
+ if (figbass) then
+ write(14,'(a9,i2,a10,i2,1x,a5)')
+ * sq//'figdrop=',ifigdr(1,iline),
+ * ' '//sq//'figdtwo=',ifigdr(2,iline),sq//'fi}%'
+ rewind(14)
+ end if
+ call askfig(pathnameq,lpath,basenameq,lbase,figbass,istype0)
+ if (.not.optimize) then
+ print*
+ print*,'Writing '
+ * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
+ print*,'Done with second PMX pass.'
+ write(15,'(/,a)')'Writing '
+ * //pathnameq(1:lpath)//basenameq(1:lbase)//'.tex'
+ write(15,'(a)')' Done with second PMX pass. Now run TeX'
+ end if
+ return
+ end
+ subroutine poestats(nsyst,poe,poebar,devnorm)
+ parameter (nks=125)
+c
+c Compute avg. & norm. std. dev. of poe.
+c
+ real*4 poe(nks)
+ sumx = 0.
+ sumxx = 0.
+ do 1 isyst = 1 , nsyst
+ sumx = sumx+poe(isyst)
+ sumxx = sumxx+poe(isyst)**2
+1 continue
+ devnorm = sqrt(nsyst*sumxx/sumx**2-1)
+ poebar = sumx/nsyst
+ return
+ end
+ subroutine precrd(ivx,ip,nolevm,nacc,ipl,irest,udq,
+ * twooftwo,icashft)
+c
+c Analyzes chords, data to be used with slurs on chords and plain chords.
+c Check for 2nds, shift notes if neccesary.
+c ipl(10) chord present
+c irest(20) set if any note is right shifted
+c irest(27) set if any note is left shifted
+c ipl(8|9) left|right shift main note
+c icrdat(23|24) ditto chord note
+c udq is updown-ness, needed to analyze 2nds.
+c levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note.
+c icrdot(icrd)(27-29) sequence order of chord note if accid, top down
+c
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ logical btest,is2nd,twooftwo
+ integer*4 kicrd(10),levtabl(88)
+ character*1 udq
+ do 11 i = 1 , 88
+ levtabl(i) = 0
+11 continue
+ do 1 icrd1 = 1 , ncrd
+ ivx1 = iand(15,ishft(icrdat(icrd1),-8))
+ * +16*igetbits(icrdat(icrd1),1,28)
+ ip1 = iand(255,icrdat(icrd1))
+ if (ip1.eq.ip .and. ivx1.eq.ivx) go to 2
+1 continue
+ print*
+ print*,
+ * 'Cannot find first chord note in precrd. Send source to Dr. Don!'
+ call stop1()
+2 continue
+ maxlev = nolevm
+ minlev = nolevm
+ levtabl(nolevm) = -1
+ is2nd = .false.
+ naccid = 0
+ levmaxacc = -100
+ levminacc = 1000
+c
+c Check 1st 3 bits of nacc for accid on main note of chord.
+c
+ if (iand(7,nacc) .gt. 0) then
+ naccid = 1
+c
+c Start list of notes with accid's. There will be naccid of them. kicrd=0 if main,
+c otherwise icrd value for note with accidental.
+c
+ kicrd(1) = 0
+ levmaxacc = nolevm
+ levminacc = nolevm
+c
+c Start the level-ranking
+c
+ icrdot0 = 1
+ end if
+ do 3 icrd2 = icrd1 , ncrd
+ nolev = igetbits(icrdat(icrd2),7,12)
+ levtabl(nolev) = icrd2
+ maxlev = max(maxlev,nolev)
+ minlev = min(minlev,nolev)
+c
+c Check for accidental
+c
+ if (btest(icrdat(icrd2),19)) then
+ naccid = naccid+1
+ levmaxacc = max(levmaxacc,nolev)
+ levminacc = min(levminacc,nolev)
+c
+c Add this icrd to list of values for notes with accid's.
+c
+ kicrd(naccid) = icrd2
+ if (.not.btest(nacc,28)) then
+c
+c Order not forced, so get the level-ranking, top down
+c
+ iorder = 1
+ do 12 iaccid = 1 , naccid-1
+ if (kicrd(iaccid) .eq. 0) then
+ if (nolevm .gt. nolev) then
+ iorder = iorder+1
+ else
+ icrdot0 = icrdot0+1
+ end if
+ else
+ if (igetbits(icrdat(kicrd(iaccid)),7,12)
+ * .gt. nolev) then
+ iorder = iorder+1
+ else
+ iold = igetbits(icrdot(kicrd(iaccid)),3,27)
+ call setbits(icrdot(kicrd(iaccid)),3,27,iold+1)
+ end if
+ end if
+12 continue
+ call setbits(icrdot(icrd2),3,27,iorder)
+ end if
+ end if
+c
+c Exit loop if last note in this chord
+c
+ if (icrd2 .eq. ncrd) go to 4
+ if (igetbits(icrdat(icrd2+1),8,0) .ne. ip .or.
+c * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4
+ * igetbits(icrdat(icrd2+1),4,8)
+ * +16*igetbits(icrdat(icrd2+1),1,28) .ne. ivx) go to 4
+3 continue
+ print*
+ print*,'Failed to find last chord note. Send source to Dr. Don!'
+ call stop1()
+4 continue
+c
+c Now icrd1, icrd2 define range of icrd for this chord.
+c
+c Bypass autos-shifting if any manual shifts are present
+c
+ if (btest(irest,20) .or. btest(irest,27)) go to 10
+c
+c Check for 2nds
+c
+ do 5 ilev = 1 , 87
+ if (levtabl(ilev).ne.0 .and. levtabl(ilev+1).ne.0) then
+c
+c There is at least one 2nd..
+c
+ if (udq .eq. 'u') then
+c
+c Upstem. Start with 2nd just found and go up, rt-shifting upper
+c member of each pair
+c
+ ile = ilev
+c
+c Set main-note flag for ANY right-shift
+c
+ irest = ibset(irest,20)
+7 continue
+ if (levtabl(ile+1) .lt. 0) then
+c
+c Upstem, & upper member is main so must be rt-shifted. This would move
+c stem too, so we rt-shift the OTHER note, and set flag that signals
+c to interchange pitches just when these two notes are placed.
+c
+ nacc = ibset(nacc,30)
+ icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),24)
+ else
+c
+c Upper member is chord note, must be rt-shifted
+c
+ icrdat(levtabl(ile+1)) = ibset(icrdat(levtabl(ile+1)),24)
+ end if
+ ile = ile+1
+8 continue
+ ile = ile+1
+ if (ile .lt. 87) then
+ if (levtabl(ile).ne.0 .and. levtabl(ile+1).ne.0) then
+ go to 7
+ else
+ go to 8
+ end if
+ end if
+ go to 10
+ else
+c
+c Downstem. Start at top and work down, left-shifting lower member of each pair.
+c We know that lowest pair is at (ilev,ilev+1).
+c
+ ile = 88
+c
+c Set main-note flag for ANY right-shift
+c
+ irest = ibset(irest,27)
+9 continue
+ if (levtabl(ile).ne.0 .and. levtabl(ile-1).ne.0) then
+ if (levtabl(ile-1) .lt. 0) then
+c ipl = ibset(ipl,8)
+c
+c Dnstem, & lower member is main so must be left-shifted. This would move
+c stem too, so we left-shift the OTHER note, and set flag that signals
+c to interchange pitches just when these two notes are placed.
+c
+ nacc = ibset(nacc,31)
+ icrdat(levtabl(ile)) = ibset(icrdat(levtabl(ile)),23)
+ else
+c
+c Lower member is chord note, must be shifted
+c
+ icrdat(levtabl(ile-1)) =
+ * ibset(icrdat(levtabl(ile-1)),23)
+ end if
+ ile = ile-1
+ end if
+ ile = ile-1
+ if (ile .ge. ilev+1) go to 9
+ go to 10
+ end if
+ end if
+5 continue
+10 continue
+c
+c Done with 2nds, now do accid's. Call even if just one, in case left shifts.
+c
+c if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid,
+ if (naccid .ge. 1) call crdaccs(nacc,ipl,irest,naccid,
+ * kicrd,nolevm,levmaxacc,levminacc,icrdot0,twooftwo,icashft)
+ return
+ end
+ subroutine printl(string)
+ character*(*) string
+c
+c Send string to console and to log file
+c
+ print*,string
+ write(15,'(a)')string
+ return
+ end
+ subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout)
+ parameter (nm=24)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comtol/ tol
+ common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20),
+ * ArpShift(20)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ logical lowdot,IsArpShift
+ character*80 soutq
+ character*79 notexq
+ character*8 symq(2)
+ character*1 chax
+ data symq /'raisearp','arpeggio'/
+c
+c NOTE iv in arg list is really ivx, referring to voice rather than staff.
+c
+c Find which iarp, if any
+c
+ do 1 iarp = 1 , narp
+ if (abs(tnow-tar(iarp)).lt.tol) go to 2
+1 continue
+c
+c If here, this is the *first* call for this arp.
+c
+ narp = narp+1
+ tar(narp) = tnow+tol*.5
+ ivar1(narp) = iv
+ ipar1(narp) = ip
+ levar1(narp) = nolev
+ ncmar1(narp) = ncm
+ return
+2 continue
+c
+c If here, this is *second* call at this time, narp points to values from 1st.
+c
+c Check for shift. Set IsArpShift and iarps
+c
+ do 3 iarps = 1 , NumArpShift
+ if (IvArpShift(iarps) .eq. ivar1(iarp) .and.
+ * IpArpShift(iarps) .eq. ipar1(iarp)) then
+ IsArpShift = .true.
+ notexq = chax(92)//'loffset{'
+ write(notexq(10:14),'(f3.1,a2)') Arpshift(iarps),'}{'
+ lnote = 14
+ go to 4
+ end if
+3 continue
+ IsArpShift = .false.
+ lnote = 0
+4 continue
+ if (iv .eq. ivar1(iarp)) then
+c
+c Arp is in a single voice.
+c
+ levbot = min(levar1(iarp),nolev)-ncm+3
+ invert = abs(levar1(iarp)-nolev)+1
+ else
+c
+c Arp covers >1 voice. Lower voice has to be the first, upper is current and
+c is where the symbol will be written.
+c Check whether ivx's ivar1(iarp) & iv are in same staff
+c
+ do 5 iiv = 1 , nm
+ if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and.
+ * ivmx(iiv,2).eq.ivar1(iarp))) then
+ iivivx1 = iiv
+ go to 6
+ end if
+5 continue
+ print*,'Screwup#1 in putarp'
+ stop
+6 continue
+ do 7 iiv = 1 , nm
+ if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and.
+ * ivmx(iiv,2).eq.iv)) go to 8
+c
+c Found iv for both voices (iivivx1, iiv), done looking
+c
+7 continue
+ print*,'Screwup#2 in putarp'
+ stop
+8 continue
+ if (iivivx1 .eq. iiv) then
+ nstaffshift = 0
+ else
+ nstaffshift = -nint(2*xinsnow)
+ end if
+c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp)
+ levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp)
+ invert = -levbot+4+nolev-ncm
+ end if
+c
+c isym will be (1,2) if invert is (even,odd). If even, raise .5\internote
+c
+ isym = mod(invert,2)+1
+ ilvert = (invert+1)/2
+ if (levbot .ge. 0 .and. levbot .le. 9) then
+c
+c Single digit
+c
+ if (.not.IsArpShift) then
+ notexq = chax(92)//symq(isym)//chax(48+levbot)
+ else
+ notexq = notexq(1:lnote)//
+ * chax(92)//symq(isym)//chax(48+levbot)
+ end if
+ lnote = lnote+10
+ else
+ if (.not.IsArpShift) then
+ notexq = chax(92)//symq(isym)//'{'
+ else
+ notexq = notexq(1:lnote)//chax(92)//symq(isym)//'{'
+ end if
+ lnote = lnote+10
+ if (levbot .ge. -9) then
+c
+c Need two spaces for number
+c
+ write(notexq(lnote+1:lnote+3),'(i2,a1)')levbot,'}'
+ lnote = lnote+3
+ else
+ write(notexq(lnote+1:lnote+4),'(i3,a1)')levbot,'}'
+ lnote = lnote+4
+ end if
+ end if
+c if (ilvert .le. 9) then
+c call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1,
+c * soutq,lsout)
+c else
+c write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
+c call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout)
+c end if
+
+ if (ilvert .gt. 9) then
+ write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//chax(48+ilvert)
+ lnote = lnote+1
+ end if
+ if (IsArpShift) then
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ call addstr(notexq(1:lnote),lnote,soutq,lsout)
+c
+c cancel out the stored time, to permit two arps at same time!
+c
+ tar(iarp) = -1.
+ return
+ end
+ subroutine putast(elask,indxask,outq)
+ character*129 outq,tag
+ character*9 fmtq
+ if (elask .ge. 0.) then
+ if (elask.lt.0.995) then
+ lp = 3
+ else if (elask .lt. 9.995) then
+ lp = 4
+ else
+ lp = 5
+ end if
+ write(fmtq,'(a5,i1,a3)')'(a2,f',lp,'.2)'
+ else
+ lp = 5
+ fmtq = '(a2,f5.1)'
+ end if
+c
+c Overwrite as follows: ...xyz*ask *lmnop... ->
+c ...xyz*ast{.nn}*lmnop...
+c ...xyz*ast{n.nn}*lmnop...
+c ...xyz*ast{nn.nn}*lmnop...
+c or for negative, ...xyz*ast{-nn.n}*lmnop...
+ tag = outq(indxask+9:)
+ write(outq(indxask+3:),fmtq)'t{',elask
+ outq = outq(1:indxask+4+lp)//'}'//tag
+ return
+ end
+ subroutine putcb(ivx,ip,notexq,lnote)
+ common /comcb/ nbc,ibcdata(36)
+ character*79 notexq
+ logical btest
+c ivxip = ivx+16*ip
+ do 1 ibc = 1 , nbc
+c if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2
+c if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
+c * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2
+ ivxbc = iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28)
+ ipbc = igetbits(ibcdata(ibc),8,4)
+ if (ivx .eq. ivxbc .and. ip .eq.ipbc) go to 2
+1 continue
+ call printl('Error in putbc, Call Dr. Don')
+ stop
+2 continue
+ if (btest(ibcdata(ibc),27)) then
+ lnote = 8
+ notexq = char(92)//'pbreath'
+ else
+ lnote = 9
+ notexq = char(92)//'pcaesura'
+ end if
+ ivshft = igetbits(ibcdata(ibc),6,13)
+c?? ivshft = igetbits(ibcdata(ibc),6,13)-32
+ if (ivshft .gt. 0) ivshft = ivshft-32
+ if (ivshft.lt.0 .or. ivshft.gt.9) then
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ if (ivshft .lt. -9) then
+ write(notexq(lnote+1:lnote+3),'(i3)')ivshft
+ lnote = lnote+3
+ else
+ write(notexq(lnote+1:lnote+2),'(i2)')ivshft
+ lnote = lnote+2
+ end if
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ else
+ notexq = notexq(1:lnote)//char(48+ivshft)
+ lnote = lnote+1
+ end if
+ ihshft = igetbits(ibcdata(ibc),8,19)
+ if (ihshft .eq. 0) then
+ notexq = notexq(1:lnote)//'0'
+ lnote = lnote+1
+ else
+ hshft = .1*(ihshft-128)
+c
+c -12.8<hshft<12.8
+c
+ notexq = notexq(1:lnote)//'{'
+ lnote = lnote+1
+ if (hshft .lt. -9.95) then
+ write(notexq(lnote+1:lnote+5),'(f5.1)')hshft
+ lnote = lnote+5
+ else if (hshft.lt.-0.05 .or. hshft.gt.9.95) then
+ write(notexq(lnote+1:lnote+4),'(f4.1)')hshft
+ lnote = lnote+4
+ else
+ write(notexq(lnote+1:lnote+3),'(f3.1)')hshft
+ lnote = lnote+3
+ end if
+ notexq = notexq(1:lnote)//'}'
+ lnote = lnote+1
+ end if
+ return
+ end
+ subroutine putfig(ivx,ifig,offnsk,figcheck,soutq,lsout)
+ parameter (nm=24)
+ common /comfig/ itfig(2,74),figqq(2,74),ivupfig(2,74),nfigs(2),
+ * fullsize(nm),ivxfig2,ivvfig(2,74)
+ character*10 figqq,figq
+ character*80 soutq,notexq
+ character*1 ch1q,ch2q,sq,chax
+ character*5 nofq,nofaq
+ character*4 Figutq,Conttq
+ logical figcheck
+ if (ivx .eq. 1) then
+ Figutq = 'Figu'
+ Conttq = 'Cont'
+ else
+ Figutq = 'Figt'
+ Conttq = 'Cott'
+ end if
+ sq = chax(92)
+ if (ivvfig(ivx,ifig) .ne. 0) then
+c
+c Alter figdrop
+c
+ notexq = sq//'global'//sq//'advance'//sq//'figdrop'
+ lnote = 23
+ if (ivvfig(ivx,ifig) .lt. 0) then
+ notexq = notexq(1:lnote)//'-'
+ lnote = lnote+1
+ endif
+ notexq = notexq(1:lnote)//char(48+abs(ivvfig(ivx,ifig)))
+ lnote = lnote+1
+ call addstr(notexq,lnote,soutq,lsout)
+ end if
+ if (abs(offnsk) .gt. .0001) then
+c
+c Write offset for floating figure, to two decimal places
+c
+ notexq = sq//'off{'
+ if (-offnsk .lt. -9.995) then
+ write(notexq(6:11),'(f6.2)')-offnsk
+ lnote = 11
+ else if (-offnsk.lt.-.995 .or. -offnsk.gt.9.995) then
+ write(notexq(6:10),'(f5.2)')-offnsk
+ lnote = 10
+ else if (-offnsk.lt.-.0001 .or. -offnsk.gt..995) then
+ write(notexq(6:9),'(f4.2)')-offnsk
+ lnote = 9
+ else
+ write(notexq(6:8),'(f3.2)')-offnsk
+ lnote = 8
+ end if
+ notexq = notexq(1:lnote)//sq//'noteskip}'
+ call addstr(notexq,lnote+10,soutq,lsout)
+ end if
+ figq = figqq(ivx,ifig)
+ ic = 1
+c nof = 0
+c nofa = -1
+ nof = -ivupfig(ivx,ifig)
+ nofa = -ivupfig(ivx,ifig)-1
+c
+c Beginning of manual loop
+c
+1 ch1q = figq(ic:ic)
+c
+c Exit when first blank is encountered
+c
+ if (ch1q .eq. ' ') go to 2
+c
+c Starting a level. Set up vertical offset.
+c
+c lnof = 1
+c nofq = chax(nof+48)
+c if (nof .gt. 9) then
+c lnof = 2
+c nofq = '1'//chax(nof-10+48)
+c end if
+c if (nofa .eq.-1) then
+c lnofa = 2
+c nofaq = '-1'
+c else if (nofa .lt. 10) then
+c lnofa = 1
+c nofaq = chax(nofa+48)
+c else
+c lnofa = 2
+c nofaq = '1'//chax(nofa+38)
+c end if
+ call istring(nof,nofq,lnof)
+ call istring(nofa,nofaq,lnofa)
+ if (ch1q .eq. '0') then
+c
+c Continuation figure. Next number is length (in noteskips). The number will
+c end at the first blank or char that is not digit or decimal point. If
+c colon, it is a separator and must be skipped
+c
+ icnum = ic+1
+3 continue
+ ic = ic+1
+ if (index('0123456789.',figq(ic:ic)) .gt. 0) go to 3
+ lnum = ic-icnum
+ call addstr(sq//Conttq//nofq(1:lnof)//'{'
+ * //figq(icnum:ic-1)//'}',7+ic-icnum+lnof,soutq,lsout)
+ if (figq(ic:ic) .ne. ':') ic=ic-1
+ else if (ch1q.eq.'#'.or.ch1q.eq.'-'.or.ch1q.eq.'n') then
+ ic = ic+1
+ ch2q = figq(ic:ic)
+ if (ch2q .eq. ' ') then
+c
+c Figure is a stand-alone accidental, so must be centered
+c
+ if (ch1q .eq. '#') then
+ call addstr(sq//Figutq//nofaq(1:lnofa)//
+ * '{'//sq//'sharpfig}',16+lnofa,soutq,lsout)
+ else if (ch1q .eq. '-') then
+ call addstr(sq//Figutq//nofaq(1:lnofa)//
+ * '{'//sq//'flatfig}',15+lnofa,soutq,lsout)
+ else if (ch1q .eq. 'n') then
+ call addstr(sq//Figutq//nofaq(1:lnofa)//
+ * '{'//sq//'natfig}',14+lnofa,soutq,lsout)
+ end if
+ go to 2
+ else
+c
+c Figure is an accidental followed by a number
+c First put the accidental (offset to the left)
+c
+ if (ch1q .eq. '#') then
+ call addstr(sq//Figutq//
+ * nofaq(1:lnofa)//'{'//sq//'fsmsh}',
+ * 13+lnofa,soutq,lsout)
+ else if (ch1q .eq. '-') then
+ call addstr(sq//Figutq//
+ * nofaq(1:lnofa)//'{'//sq//'fsmfl}',
+ * 13+lnofa,soutq,lsout)
+ else if (ch1q .eq. 'n') then
+ call addstr(sq//Figutq//
+ * nofaq(1:lnofa)//'{'//sq//'fsmna}',
+ * 13+lnofa,soutq,lsout)
+ end if
+c
+c Now put the number
+c
+ call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch2q//'}',
+ * 8+lnof,soutq,lsout)
+ endif
+ else if (ch1q .eq. '_') then
+c
+c Placeholder only (for lowering a figure). Don't do anything!
+c
+ continue
+ else
+c
+c Figure is a single number, maybe with s after
+c
+ call addstr(sq//Figutq//nofq(1:lnof)//'{',
+ * 6+lnof,soutq,lsout)
+ ch2q = figq(ic+1:ic+1)
+ if (ch2q .eq. 's') then
+c
+c Use a special character. Insert font call
+c
+ ic = ic+1
+ call addstr(sq//'ligfont',8,soutq,lsout)
+ end if
+ call addstr(ch1q//'}',2,soutq,lsout)
+c call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}',
+c * 8+lnof,soutq,lsout)
+ end if
+ if (ic .ge. 10) go to 2
+ ic = ic+1
+ nof = nof+4
+ nofa = nofa+4
+ go to 1
+2 continue
+ if (abs(offnsk) .gt. .0001) then
+ notexq = sq//'off{'
+ if (offnsk .lt. -9.995) then
+ write(notexq(6:11),'(f6.2)')offnsk
+ lnote = 11
+ else if (offnsk.lt.-.995 .or. offnsk.gt.9.995) then
+ write(notexq(6:10),'(f5.2)')offnsk
+ lnote = 10
+ else if (offnsk.lt.-.0001 .or. offnsk.gt..995) then
+ write(notexq(6:9),'(f4.2)')offnsk
+ lnote = 9
+ else
+ write(notexq(6:8),'(f3.2)')offnsk
+ lnote = 8
+ end if
+ notexq = notexq(1:lnote)//sq//'noteskip}'
+ call addstr(notexq,lnote+10,soutq,lsout)
+ end if
+ if (ifig .lt. nfigs(ivx)) then
+ ifig = ifig+1
+ else
+ nfigs(ivx) = 0
+ figcheck = .false.
+ end if
+ return
+ end
+ subroutine putorn(iornq,nolev,nolevm,nodur,nornb,ulq,ibmcnt,ivx,
+ * ncm,islur,nvmx,nv,ihornb,stemlin,outq,lout,ip,islhgt,
+ * beamon,iscrd)
+c
+c All args are individual array element *values* except nornb,ihornb,ulq.
+c notcrd = .true. if ornament is on main note.
+c nolevm is level of main note (for chords)
+c
+ parameter (nm=24)
+ character*1 ulpzq,ulq(nm,9),udqq,sq,chax
+ character*8 noteq
+ character*79 notexq,outq
+ integer*4 ihornb(nm,24),nornb(nm)
+ logical btest,iscrd,usehornb,beamon
+ common /comivxudorn/ivxudorn(63)
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ sq = chax(92)
+ lout = 0
+ usehornb = .false.
+ if (nodur .lt. 64) then
+ stemlen = stemlin
+ else
+ stemlen = 0.
+ end if
+c
+c Get up-downness. ulpzq is opposite from stem direction for both beams and
+c non beams. Can use in name of ornament [ . or _ ]
+c
+ if (beamon) then
+ if (ulq(ivx,ibmcnt) .eq. 'u') then
+ ulpzq = 'l'
+ else
+ ulpzq = 'u'
+ end if
+ else
+ if (udqq(nolevm,ncm,islur,nvmx,ivx,nv).eq.'l' ) then
+ ulpzq = 'u'
+ else
+ ulpzq = 'l'
+ end if
+ end if
+c
+c To enable >1 ornament on a note, next line is top of manual loop.
+c
+2 continue
+c
+cc Bit # of last ornament (last of bits 0-21)
+cc Bit # of last ornament (last of bits 0-24)
+c Bit # of last ornament (last of bits 0-24,29-30)
+ if (btest(iornq,29)) then
+ ibit = 29
+ else if (btest(iornq,30)) then
+ ibit = 30
+ else
+ ibit = log2(iand(iornq,4194303))
+c ibit = log2(iand(iornq,33554431))
+ end if
+ iornt = 2**ibit
+c
+c Begin routine to set height. Bits 0-13: (stmgx+Tupf._)
+c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n
+c 19-20: >^, 21: ? (with or w/o 16-18)
+c and 29-30: C (coda), G (new segno)
+c
+c Do not use beam height for . or _
+c
+ if (btest(iornq,22) .and. iand(iornt,6144).eq.0) then
+c
+c Height is set by special beam stuff.
+c Do not leave ihorn set, do separately for every ornament
+c
+ ihorn = ihornb(ivx,nornb(ivx))
+ if (ulpzq .eq. 'u') ihorn = ihorn-2
+c
+c Following flag tells whether to increment nornb when exiting the subroutine.
+c
+ usehornb = .true.
+ else if (ibit .eq. 14) then
+c
+c Down fermata. Don't worry about upper chord notes.
+c
+ if (ulpzq .eq. 'l') then
+ ihorn = min(nolev,ncm-3)
+ else
+ ihorn = min(nolev-stemlen,ncm-3.)
+ end if
+ else if (btest(iornt,13) .or. btest(iornt,0)) then
+c
+c ( or )
+c
+ ihorn = nolev
+ else if (iand(iornt,6144) .gt. 0) then
+c
+cc Staccato . or tenuto _ , but not special beam stuff. Need up-down info
+c NOTE: removed .&_ from special beam treatment.
+c Staccato . or tenuto _ Need up-down info
+c
+ if (.not.iscrd .or. (maxlev.ne.nolev.and.ulpzq.eq.'l') .or.
+ * (minlev.ne.nolev.and.ulpzq.eq.'u')) then
+ ihorn = nolev
+ else if (maxlev .eq. nolev) then
+ ulpzq = 'u'
+ ihorn = max(nolev+stemlen,ncm+3.)
+ else
+ ulpzq = 'l'
+ ihorn = min(nolev-stemlen,ncm-3.)
+ end if
+ else if (iscrd .and. nolev .eq. minlev) then
+ if (ulpzq .eq. 'l') then
+ ihorn = min(nolev-3,ncm-6)
+ else
+ ihorn = min(nolev-nint(stemlen)-3,ncm-6)
+ end if
+ else if (ibit.eq.10 .and. nolev.gt.90) then
+c
+c Special treatment for fermata on a shifted rest
+c
+ ihorn = ncm+5
+ else if (ulpzq.eq.'l') then
+c
+c (iscrd and nolev=maxlev) or (.not.iscrd)
+c
+ ihorn = max(nolev+stemlen+2,ncm+5.)
+ else if (ibit.eq.29 .or. ibit.eq.30) then
+c
+c coda or new segno, no height tweak
+c
+ ihorn = ncm+5
+ else
+ ihorn = max(nolev+2,ncm+5)
+ end if
+ ioff = 0
+ iclracc = 0
+c
+c Begin routine to set name. Bits 0-13: (stmgx+Tupf._)
+c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n
+c
+ if (btest(iornt,2)) then
+ notexq = sq//'shake'
+ lnote = 6
+ else if (btest(iornt,3)) then
+ notexq = sq//'mordent'
+ lnote = 8
+ else if (btest(iornt,1)) then
+ notexq = sq//'mtr'
+ lnote = 4
+ else if (btest(iornt,5)) then
+ notexq = sq//'xtr'
+ lnote = 4
+ else if (btest(iornt,6)) then
+ notexq = sq//'ptr'
+ lnote = 4
+ else if (btest(iornt,13)) then
+ notexq = sq//'rpn'
+ lnote = 4
+ else if (btest(iornt,0)) then
+ notexq = sq//'lpn'
+ lnote = 4
+ else if (btest(iornt,12)) then
+ notexq = sq//ulpzq//'st'
+ lnote = 4
+ else if (btest(iornt,11)) then
+ notexq = sq//ulpzq//'pz'
+ lnote = 4
+ else if (btest(iornt,8)) then
+ notexq = sq//'upz'
+ lnote = 4
+ ioff = -2
+ else if (btest(iornt,9)) then
+ notexq = sq//'uppz'
+ lnote = 5
+ ioff = -2
+ else if (btest(iornt,10)) then
+ if (nodur .lt. 48) then
+ notexq = sq//'fermataup'
+ else
+ notexq = sq//'Fermataup'
+ end if
+ lnote = 10
+ ioff = -2
+ else if (btest(iornt,14)) then
+ if (nodur .lt. 48) then
+ notexq = sq//'fermatadown'
+ else
+ notexq = sq//'Fermatadown'
+ end if
+ lnote = 12
+ else if (btest(iornt,21)) then
+c
+c "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21
+c
+ if (btest(iornq,16)) then
+ notexq = sq//'qsharp'
+ lnote = 7
+ ioff = 2
+ iornq = ibclr(iornq,16)
+ iclracc = 16
+ else if (btest(iornq,17)) then
+ notexq = sq//'qflat'
+ lnote = 6
+ ioff = 1
+ iornq = ibclr(iornq,17)
+ iclracc = 17
+ else if (btest(iornq,18)) then
+ notexq = sq//'qnat'
+ lnote = 5
+ ioff = 2
+ iornq = ibclr(iornq,18)
+ iclracc = 18
+ else
+ notexq = sq//'qedit'
+ lnote = 6
+ ioff = 0
+ end if
+ else if (btest(iornt,16)) then
+ notexq = sq//'esharp'
+ lnote = 7
+ ioff = 2
+ else if (btest(iornt,17)) then
+ notexq = sq//'eflat'
+ lnote = 6
+ ioff = 1
+ else if (btest(iornt,18)) then
+ notexq = sq//'enat'
+ lnote = 5
+ ioff = 2
+ else if (btest(iornt,19)) then
+ notexq = sq//'usf'
+ lnote = 4
+ ioff = -2
+ else if (btest(iornt,20)) then
+ notexq = sq//'usfz'
+ lnote = 5
+ ioff = -2
+ else if (btest(iornt,29)) then
+ notexq = sq//'ccoda'
+ lnote = 6
+ else if (btest(iornt,30)) then
+ notexq = sq//'ssegno'
+ lnote = 7
+ end if
+ iudorn = 0
+c
+c User-defined level shift of ornament from default?
+c
+ if (btest(iornq,25)) then
+c
+c Find which (if any) element of kudorn has the shift.
+c
+ do 3 iudorn = 1 , nudorn
+c if (ibit .lt. 21) then
+c if (ibit.lt.21 .or. ibit.eq.29) then
+ if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then
+ ibitt = ibit
+c
+c Could have oes, but not oe? or oes?
+c
+ else if (iclracc .gt. 0) then
+c
+c Earlier cleared edit. accid, meaning it was oes?
+c
+ ibitt = iclracc+6
+ else
+ ibitt = 21
+ end if
+ ibitt=ip+ishft(mod(ivx,16),8)+ishft(nolev,12)+ishft(ibitt,19)
+c if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4
+ if (ibitt .eq. iand(33554431,kudorn(iudorn))
+ * .and. ivx.eq.ivxudorn(iudorn)) go to 4
+3 continue
+c
+c Nothing shifted on this note; exit this if block
+c
+ iudorn = 0
+ go to 5
+4 continue
+ ioffinc = iand(63,ishft(kudorn(iudorn),-25))-32
+ if (ibit.eq.19 .and. ioffinc .lt. -7) then
+c
+c Convert usf to lsf. The reason has to do with positioning being impossile
+c for some mysterious reason when you drop \usf below the staff
+c
+ notexq = sq//'lsf'
+ ioffinc = ioffinc+6
+ end if
+ ioff = ioff+ioffinc
+ end if
+5 continue
+c
+c Shift level to avoid slur. Conditions are
+c 1. There is a slur
+c 2. No user-defined orn height shift (btest(iornq,25))
+c 3. upslur (islhgt>0)
+c 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737
+c 5. islhgt+3 >= height already computed.
+c
+ if (.not.btest(iornq,25) .and.
+ * islhgt.gt.0 .and. iand(iornt,30737).eq.0)
+ * ioff = ioff+dim(islhgt+3,ihorn )
+ call notefq(noteq,lnoten,ihorn+ioff,ncm)
+ if (lnoten.eq.1) call addblank(noteq,lnoten)
+ if (iand(iornt,32896) .gt. 0) then
+c
+c T-trill or trill w/o "tr"
+c
+ call dotrill(ivx,ip,iornt,noteq,lnoten,notexq,lnote)
+ else
+ notexq = notexq(1:lnote)//noteq(1:lnoten)
+ lnote = lnote+lnoten
+ end if
+ if (iudorn .gt. 0) then
+ if (btest(kudorn(iudorn),31)) then
+c
+c Horizontal shift
+c
+ lform = lfmt1(ornhshft(iudorn))
+ write(noteq(1:lform),'(f'//chax(48+lform)//'.1)')
+ * ornhshft(iudorn)
+ notexq = sq//'roffset{'//noteq(1:lform)//'}{'
+ * //notexq(1:lnote)//'}'
+ lnote = lnote+lform+12
+ ornhshft(iudorn) = 0.
+ kudorn(iudorn) = ibclr(kudorn(iudorn),31)
+ end if
+ end if
+c
+c Zero out the bit for ornament just dealt with.
+c
+ iornq = ibclr(iornq,ibit)
+ if (lout .eq. 0) then
+ outq = notexq(1:lnote)
+ else
+ outq = outq(1:lout)//notexq(1:lnote)
+ end if
+ lout = lout+lnote
+c
+c Check bits 0-21, go back if any are still set
+c If bit 29 or 30 had been set, would have been used first time thru,
+c and you wouldn't use both coda and segno on same note
+c
+ if (iand(iornq,4194303) .gt. 0) go to 2
+ if (usehornb) nornb(ivx) = nornb(ivx)+1
+ return
+ end
+ subroutine putshft(ivx,onoff,soutq,lsout)
+ parameter (nm=24)
+ common /comudsp/udsp(50),tudsp(50),nudsp,udoff(nm,20),nudoff(nm)
+ character*80 soutq,notexq
+ character*1 sq,chax
+ logical onoff
+ sq = chax(92)
+c
+c Start user-defined offsets X(...): or X(...)S
+c
+ if (onoff) nudoff(ivx) = nudoff(ivx)+1
+c
+c Xoff is in pts. Round off to nearest .1. Will use at end of shift.
+c
+ xoff = udoff(ivx,nudoff(ivx))
+ xoff = sign(int(10.*abs(xoff)+.5)/10.,xoff)
+ if (.not.onoff) xoff = -xoff
+ if (xoff .lt. -9.95) then
+ ifmt = 5
+ else if (xoff.lt.-.95 .or. xoff.gt.9.95) then
+ ifmt = 4
+ else
+ ifmt = 3
+ end if
+ write(notexq,'(f'//chax(48+ifmt)//'.1)')xoff
+ call addstr(sq//'off{'//notexq(1:ifmt)//'pt}',8+ifmt,
+ * soutq,lsout)
+ return
+ end
+ subroutine puttitle(inhnoh,xnsttop,etatop,sq,etait,etatc,
+ * etacs1,nv,vshrink,sepsymq)
+c
+c Called once per page, at top of page! If vshrink, only called for p.1.
+c Actual titles only allowed on p.1. (set by headlog).
+c 3/18/01: The above comment is probably bogus...can use Tt on later pages.
+c
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink
+ common /comtitl/ instrq,titleq,compoq,headlog,inskip,ncskip,
+ * inhead
+ common /cominbot/ inbothd
+ character*127 notexq
+ character*120 instrq,titleq,compoq
+ parameter (nm=24)
+ character*1 sq,sepsymq(nm),chax
+ logical headlog,vshrink
+ notexq = sq//'znotes'
+ lenline = 7
+ do 22 iv = 1 , nv-1
+ notexq = notexq(1:lenline)//sepsymq(iv)
+ lenline = lenline+1
+22 continue
+ notexq = notexq(1:lenline)//sq//'zcharnote{'
+ lenline = lenline+11
+ if (.not.headlog) then
+ inhead = inhnoh
+ end if
+ if (vshrink .and. usevshrink) then
+ inhead = 16
+ end if
+ ndig = int(alog10(inhead+.01))+1
+ write(notexq(lenline+1:lenline+ndig+10),'(i'//chax(48+ndig)//
+ * ',a10)')inhead,'}{'//sq//'titles{'
+ lenline = lenline+ndig+10
+c
+c Vertical skip at top of page (\Il) = etatop*glueil. Needed whether
+c headers are present or not.
+c
+ glueil = xnsttop/etatop
+ vskil = etatop*glueil
+ if (vshrink .and. usevshrink) vskil = 2
+ call writflot(vskil,notexq,lenline)
+ if (.not.headlog) then
+ if (islast) write(11,'(a)')notexq(1:lenline)
+ * //'}{}{0}{}{0}{}{0}}'//sq//'en%'
+ else
+ notexq = notexq(1:lenline)//'}{'
+ lenline = lenline+2
+ lcq = lenstr(instrq,120)
+ if (lcq .gt. 0) then
+ xitil = etait*glueil
+ if (vshrink .and. usevshrink) xitil = 2
+ notexq = notexq(1:lenline)//instrq(1:lcq)//'}{'
+c
+c Null out instrument once used
+c
+ instrq = ' '
+ lenline = lenline+lcq+2
+ call writflot(xitil,notexq,lenline)
+ else
+ notexq = notexq(1:lenline)//'}{0'
+ lenline = lenline+3
+ end if
+ if (islast) write(11,'(a)')notexq(1:lenline)//'}%'
+ notexq = '{'
+ lenline = 1
+ lcq = lenstr(titleq,120)
+ if (lcq .gt. 0) then
+ notexq = notexq(1:lenline)//titleq(1:lcq)
+ lenline = lenline+lcq
+ else
+ call printl(' ')
+ call printl('WARNING')
+ call printl(
+ * ' In a title block, you have specified instrument and/or')
+ call printl(
+ * ' composer but no title for the piece.')
+ end if
+ notexq = notexq(1:lenline)//'}{'
+ lenline = lenline+2
+ xtcil = etatc*glueil
+ lcq = lenstr(compoq,120)
+ if (lcq .eq. 0) xtcil = 2*xtcil
+ if (vshrink .and. usevshrink) xtcil = 2
+ call writflot(xtcil,notexq,lenline)
+ notexq = notexq(1:lenline)//'}{'
+ lenline = lenline+2
+ if (lcq .gt. 0) then
+ notexq = notexq(1:lenline)//compoq(1:lcq)//'}{'
+ lenline = lenline+2+lcq
+c
+c Null out compoq so it does not get written later
+c
+ compoq = ' '
+ xcsil = etacs1*glueil
+ if (vshrink .and. usevshrink) xcsil = 2
+ call writflot(xcsil,notexq,lenline)
+ else
+ notexq = notexq(1:lenline)//'}{0'
+ lenline = lenline+3
+ end if
+ if (islast) write(11,'(a)')notexq(1:lenline)//'}}'//sq//'en%'
+ headlog = .false.
+ end if
+ return
+ end
+ subroutine putxtn(ntupv,iflop,multb,iud,wheadpt,poenom,
+ * nolev1,islope,slfac,xnlmid,islur,lnote,notexq,ncmid,nlnum,
+c * eloff,iup,irest,usexnumt)
+ * eloff,iup,irest,mult,usexnumt)
+c
+c Places digit for xtuplet.
+c
+ character*1 chax
+ character*8 noteq
+ character*79 notexq
+ logical btest,usexnumt
+ if (iflop.ne.0 .and. multb.gt.0) then
+c
+c Number goes on beam side, move R/L by .5 wheadpt for upper/lower
+c
+ eloff = eloff-0.5*iud*wheadpt/poenom
+c
+c Number goes on beam side, must use beam parameters to set pos'n
+c
+ nlnum = nolev1+islope/slfac*eloff+iup*(multb+8)
+ if (multb .ge. 2) nlnum = nlnum+iup
+ else
+ nlnum = nint(xnlmid-1+3*iud+iflop*11)
+ end if
+ if (.not.btest(islur,31)) then
+c
+c Only print number when wanted. First check vert, horiz offset
+c
+ if (btest(irest,1)) nlnum = nlnum+igetbits(mult,8,16)-64
+ if (btest(irest,7)) eloff = eloff+
+ * (.1*iand(31,ishft(irest,-9))-1.6)*wheadpt/poenom
+ if (.not.usexnumt) then
+ notexq = chax(92)//'xnum{'
+ lnote = 10
+ istrtn = 7
+ else
+ notexq = chax(92)//'xnumt{'
+ lnote = 11
+ istrtn = 8
+ end if
+ if (eloff .lt. 0.995) then
+ write(notexq(istrtn:istrtn+3),'(i1,f3.2)')0,eloff
+ else if (eloff .lt. 9.995) then
+ write(notexq(istrtn:istrtn+3),'(f4.2)')eloff
+ else
+ write(notexq(istrtn:istrtn+4),'(f5.2)')eloff
+ lnote = lnote+1
+ end if
+ call notefq(noteq,lnoten,nlnum,ncmid)
+ notexq = notexq(1:lnote)//'}'//noteq(1:lnoten)
+ lnote = lnote+1+lnoten
+ if (ntupv .lt. 10) then
+ write(notexq(lnote+1:lnote+1),'(i1)')ntupv
+ lnote = lnote+1
+ else
+ notexq = notexq(1:lnote)//'{'
+ write(notexq(lnote+2:lnote+3),'(i2)')ntupv
+ notexq = notexq(1:lnote+3)//'}'
+ lnote = lnote+4
+ end if
+ end if
+ return
+ end
+ subroutine read10(string,lastchar)
+ parameter (maxblks=9600)
+ character*131072 bufq
+ integer*2 lbuf(maxblks)
+ common /inbuff/ ipbuf,ilbuf,nlbuf,lbuf,bufq
+ character*(*) string
+ character*128 lnholdq
+ logical lastchar
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ logical mrecord,mplay,endmac
+ common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
+ * ic1mac(20),ilmac,iplmac
+ if (.not.mplay) then
+ if (ilbuf .gt. nlbuf) go to 999
+ call getbuf(string)
+ return
+999 lastchar = .true.
+ return
+ else
+c
+c Play a macro. Set pointer to first character needed in buffer
+c
+ if (ilmac .eq. il1mac(macnum)) then
+c
+c Getting first line of macro
+c
+ ip1 = ip1mac(macnum)
+ iplmac = ip1-ic1mac(macnum)
+ else if (ilmac .le. il2mac(macnum)) then
+c
+c Beyond first line of macro. Advance line-start pointer.
+c
+ iplmac = iplmac+lbuf(ilmac-1)
+ ip1 = iplmac+1
+ else
+c
+c Beyond last line of macro. Terminate it!
+c
+ mplay = .false.
+ endmac = .true.
+ return
+ end if
+ if (ilmac .eq. il2mac(macnum)) then
+c
+c Getting last line of macro.
+c
+ ip2 = ip2mac(macnum)
+ else
+c
+c Getting line before last line of macro.
+c
+ ip2 = iplmac+lbuf(ilmac)
+ end if
+ if (ip2 .ge. ip1) then
+ string = bufq(ip1:ip2)
+ else
+c
+c Kluge for when macro start is on a line by itself
+c
+ string = ' '
+ end if
+ ilmac = ilmac+1
+ return
+ end if
+ end
+ function readin(lineq,iccount,nline)
+c
+c Reads a piece of setup data from file lineq, gets a new lineq from
+c file 10 (jobname.pmx) and increments nline if needed, passes over
+c comment lines
+c
+ character*128 lineq
+ character*1 durq,chax
+4 if (iccount .eq. 128) then
+1 call getbuf(lineq)
+ nline = nline+1
+ if (lineq(1:1) .eq. '%') go to 1
+ iccount = 0
+ end if
+ iccount = iccount+1
+c
+c Find next non-blank or end of line
+c
+ do 2 iccount = iccount , 127
+ if (lineq(iccount:iccount) .ne. ' ') go to 3
+2 continue
+c
+c If here, need to get a new line
+c
+ iccount = 128
+ go to 4
+3 continue
+c
+c iccount now points to start of number to read
+c
+ i1 = iccount
+5 call getchar(lineq,iccount,durq)
+c
+c Remember that getchar increments iccount, then reads a character.
+c
+ if (index('0123456789.-',durq) .gt. 0) go to 5
+ i2 = iccount-1
+ if (i2 .lt. i1) then
+ print*,'Found "'//durq//'" instead of number'
+ call stop1()
+ end if
+ icf = i2-i1+49
+ read(lineq(i1:i2),'(f'//chax(icf)//'.0)')readin
+ return
+ end
+ subroutine readmeter(lineq,iccount,mtrnum,mtrden)
+ character*128 lineq
+ character*1 durq,chax
+ if (index(lineq(iccount+1:iccount+3),chax(47)) .eq. 0) then
+c
+c No slashes, so use old method
+c
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. '-') then
+c
+c Negative numerator is used only to printed; signals vertical slash
+c
+ call getchar(lineq,iccount,durq)
+ mtrnum = -(ichar(durq)-48)
+ else if (durq .eq. 'o') then
+c
+c Numerator is EXACTLY 1
+c
+ mtrnum = 1
+ else
+ mtrnum = ichar(durq)-48
+ if (mtrnum .eq. 1) then
+c
+c Numerator is >9
+c
+ call getchar(lineq,iccount,durq)
+ mtrnum = 10+ichar(durq)-48
+ end if
+ end if
+ call getchar(lineq,iccount,durq)
+ if (durq .eq. 'o') then
+ mtrden = 1
+ else
+ mtrden = ichar(durq)-48
+ if (mtrden .eq. 1) then
+ call getchar(lineq,iccount,durq)
+ mtrden = 10+ichar(durq)-48
+ end if
+ end if
+ else
+c
+c Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm'
+c
+ iccount = iccount+1
+ ns = index(lineq(iccount:128),chax(47))
+ read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrnum
+c
+c Reset iccount to start of second integer
+c
+ iccount = iccount+ns
+c
+c There must be either a slash or a blank at pos'n 2 or 3
+c
+ ns = index(lineq(iccount:iccount+2),chax(47))
+ if (ns .eq. 0) ns = index(lineq(iccount:iccount+2),' ')
+ read(lineq(iccount:iccount+ns-2),'(i'//chax(47+ns)//')')mtrden
+c
+c Set iccount to last character used
+c
+ iccount = iccount+ns-1
+ end if
+ return
+ end
+ subroutine readnum(lineq,iccount,durq,fnum)
+c
+c This reads a number starting at position iccount. Remember that on exit,
+c getchar leaves iccount at the last character retrieved. So must only
+c call this routine *after* detecting a number or decimal.
+c On exit, durq is next character after end of number.
+c
+ character*128 lineq
+ character*1 durq,chax
+ i1 = iccount
+1 call getchar(lineq,iccount,durq)
+ if (index('0123456789.',durq) .gt. 0) go to 1
+ i2 = iccount-1
+ if (i2 .lt. i1) then
+ print*,'Found "'//durq//'" instead of number'
+ call stop1()
+ else if (lineq(i1:i1).eq.'.'.and.lineq(i2:i2).eq.'.') then
+ i2 = i2-1
+ iccount = iccount-1
+ end if
+ icf = i2-i1+49
+ read(lineq(i1:i2),'(f'//chax(icf)//'.0)')fnum
+ return
+ end
+ subroutine setbits(isdata,iwidbit,ishift,ivalue)
+c
+c Sets iwidbits of isdata, shifted by ishift, to ivalue
+c
+ ibase = 2**iwidbit-1
+ isdata = iand(not(ishft(ibase,ishift)),isdata)
+ isdata = ior(isdata,ishft(ivalue,ishift))
+ return
+ end
+ subroutine setbm2(xelsk,nnb,sumx,sumy,ipb,islope,nolev1)
+c
+c The MEAN SQUARE slope algorithm
+c
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,
+ * isfig
+ real*4 xelsk(24)
+ integer ipb(24)
+ ibc = ibmcnt(ivx)
+ sumxx = 0.
+ sumxy = 0.
+ do 2 inb = 1 , nnb
+ sumxx = sumxx+xelsk(inb)**2
+ sumxy = sumxy+xelsk(inb)*nolev(ivx,ipb(inb))
+2 continue
+ delta = nnb*sumxx-sumx*sumx
+ em = (nnb*sumxy-sumx*sumy)/delta
+ islope = nint(0.5*em*slfac)
+ if (iabs(islope) .gt. 9) islope = isign(9,islope)
+ beta = (sumy-islope/slfac*sumx)/nnb
+ nolev1 = nint(beta)
+c
+c Check if any stems are too short
+c
+ smin = 100.
+ iul = -1
+ if (ulq(ivx,ibc) .eq. 'u') iul = 1
+ do 4 inb = 1 , nnb
+ ybeam = nolev1+iul*stemlen+islope*xelsk(inb)/slfac
+ ynote = nolev(ivx,ipb(inb))
+ smin = min(smin,iul*(ybeam-ynote))
+4 continue
+ if (smin .lt. stemmin) then
+ deficit = stemmin-smin
+ nolev1 = nint(nolev1+iul*deficit)
+ end if
+ return
+ end
+ subroutine setmac(lineq,iccount,ibarcnt,ibaroff,nbars,charq,durq,
+ * ivx,nline)
+ character*1 charq,durq
+ common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac
+ logical mrecord,mplay,endmac,btest
+ character*128 lnholdq,lineq
+ common /c1ommac/ ip1mac(20),il1mac(20),ip2mac(20),il2mac(20),
+ * ic1mac(20),ilmac,iplmac
+c
+c Macro action
+c
+ call g1etchar(lineq,iccount,charq)
+ if (charq.eq.'S' .and. ivx.ne.1) then
+ print*
+ print*
+ print*,'*********WARNING*********'
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * '"MS..." only put in parts by scor2prt if in voice #1!')
+ end if
+ if (index('RSP ',charq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Illegal character after "M" (macro)!')
+ call stop1()
+ else if (charq .ne. ' ') then
+c
+c Record or playback a macro. Get the number of the macro.
+c
+ call g1etchar(lineq,iccount,durq)
+ if (index('123456789',durq) .eq. 0) then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Must input number after "MR","MP", or "MS"!')
+ call stop1()
+ end if
+ call readnum(lineq,iccount,durq,fnum)
+ macnum = nint(fnum)
+ if (durq .ne. ' ') then
+ call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1,
+ * 'Macro number must be followed by a blank!')
+ call stop1()
+ end if
+ if (index('RS',charq ).gt. 0) then
+c
+c Record or save a macro
+c
+ if (macnum.lt.1 .or. macnum.gt.20) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Macro number not in range 1-20!')
+ call stop1()
+ end if
+ macuse = ibset(macuse,macnum)
+ if (charq .eq. 'R') then
+ call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
+ else if (charq .eq. 'S') then
+c
+c Save (Record but don't activate)
+c
+1 call m1rec1(lineq,iccount,ibarcnt,ibaroff,nbars,ndxm)
+ if (mrecord) then
+ call getbuf(lineq)
+ nline = nline+1
+ iccount = 0
+ go to 1
+ end if
+ iccount = iccount+ndxm+1
+ end if
+ else
+c
+c Playback the macro
+c
+ if (.not.btest(macuse,macnum)) then
+ call errmsg(lineq,iccount-1,ibarcnt-ibaroff+nbars+1,
+ * 'Cannot play a macro that has not been recorded!')
+ call stop1()
+ end if
+ icchold = iccount
+ lnholdq = lineq
+ iccount = 128
+ mplay = .true.
+ ilmac = il1mac(macnum)
+ end if
+ end if
+ return
+ end
+ subroutine setmeter(mtrnuml,mtrdenl,ibmtyp,ibmrep)
+c
+c Sets last 2 args depending on 1st 2, (logical) num, denom.
+c ibmtyp = 1, 2, or 3 defines set of masks for beam groupings.
+c 1: all duple meters
+c 2: triple w/ denom=4, subdivide in groups of 2 8ths
+c 3: triple w/ denom=8, subdivide in groups of 3 8ths
+c Note that lenbar is set at top or when 'm' symbol is read in getnote
+c
+ if (mtrdenl .eq. 4) then
+ if (mod(mtrnuml,3) .eq. 0) then
+ ibmtyp = 2
+ ibmrep = mtrnuml/3
+ else
+ ibmtyp = 1
+ ibmrep = mtrnuml/2
+ end if
+ else if (mtrdenl .eq. 2) then
+ ibmtyp = 1
+ if (mtrnuml .eq. 3) then
+ ibmrep = 3
+ else
+ ibmrep = 2*mtrnuml/mtrdenl
+ end if
+ else if (mtrdenl.eq.8 .and. (mtrnuml.eq.8.or.mtrnuml.eq.4)) then
+c
+c Added 170726
+c
+ ibmtyp = 1
+ ibmrep = mtrnuml/4
+ else
+c
+c Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8
+c
+ ibmtyp = 3
+ ibmrep = mtrnuml/3
+ end if
+c
+c Reset so we don't keep writing new meters
+c
+ mtrnuml = 0
+c
+c Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter
+c
+ ibmrep = max(ibmrep,1)
+ return
+ end
+ subroutine SetupB(xelsk,nnb,sumx,sumy,ipb,smed,ixrest)
+c
+c The outer combo algorithm
+c
+ parameter (nm=24)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ common /comipl2/ ipl2(nm,200)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,btest,
+ * isfig,vxtup,l1ng,l2ng,bar1syst,drawbm
+ common /comeskz2/ eskz2(nm,200)
+ real*4 slope(800),xelsk(24)
+ integer ipb(24)
+ common /comask/ bar1syst,fixednew,scaldold,
+ * wheadpt,fbar,poenom
+ common /comas1/ naskb,task(40),wask(40),elask(40)
+ common /comxtup/ ixtup,vxtup(nm),ntupv(nm,9),nolev1(nm),
+ * mtupv(nm,9),nxtinbm(nm),
+ * islope(nm),xels11(24),eloff(nm,9),
+ * nssb(nm),issb(nm),lev1ssb(nm,20)
+ common /comdraw/ drawbm(nm)
+ common /combmh/ bmhgt,clefend
+ common /commvl/ nvmx(nm),ivmx(nm,2),ivx
+ common /comtol/ tol
+ ibc = ibmcnt(ivx)
+ nxtinbm(ivx) = 0
+ n1 = ipl2(ivx,ibm1(ivx,ibc))
+c
+c Initialize counters used in this subroutine, and then later during actual
+c beam drawing, to count later segments of single-slope beam groups
+c
+ nssb(ivx) = 0
+ issb(ivx) = 0
+c
+c Set flag for xtup beam starting with rest (no others can start with rest)
+c
+ if (btest(irest(ivx,ipo(n1)),0)) ixrest = 1
+c
+c Figure how many elemskips to each note. Use the list, counting only non-rests.
+c
+ eskz0 = eskz(ivx,ibm1(ivx,ibc))
+ nnb = 0
+ sumx = 0.
+ sumy = 0.
+ ipxt1 = 0
+ iplast = ibm2(ivx,ibc)
+ do 2 ip = ibm1(ivx,ibc) , iplast
+ if (.not.btest(irest(ivx,ip),0)) then
+ nnb = nnb+1
+ ipb(nnb) = ip
+ xelsk(nnb) = eskz(ivx,ip)-eskz0
+ sumx = sumx+xelsk(nnb)
+ sumy = sumy+nolev(ivx,ipb(nnb))
+ if (btest(nacc(ivx,ip),21)) then
+c
+c This is the starting note of later segment of single-slope beam group
+c Temporarily store ip here.
+c
+ nssb(ivx) = nssb(ivx)+1
+ lev1ssb(ivx,nssb(ivx)) = nnb
+ end if
+ end if
+c
+c New xtup stuff here. Final object is to get distance from start of xtup
+c to number. xtinbm counts xtups in this beam only. mtupv is the printed
+c number. ntupv is number of notes in xtup, and is only used to get
+c eloff, the distance from start of xtup to the number.
+c
+ if (btest(nacc(ivx,ip),18)) ndoub = ndoub+1
+ if (ipxt1.eq.0 .and. nodur(ivx,ip).eq.0) then
+c
+c Xtup is starting here
+c
+ nxtinbm(ivx) = nxtinbm(ivx)+1
+ ipxt1 = ip
+ if (btest(nacc(ivx,ip),18)) then
+ ndoub = 1
+ else
+ ndoub = 0
+ end if
+ else if (ipxt1.gt.0 .and. nodur(ivx,ip).gt.0) then
+c
+c Xtup ends here. Set total number of notes in xtup.
+c
+ ntupv(ivx,nxtinbm(ivx)) = ip+1-ipxt1
+c
+c Set printed number for embedded xtup.
+c
+ mtupv(ivx,nxtinbm(ivx)) = ntupv(ivx,nxtinbm(ivx))+ndoub
+c
+c Middle note of xtup if ntupv odd, note to left of gap if even.
+c
+ ipxtmid = (ip+ipxt1)/2
+ eloff(ivx,nxtinbm(ivx)) = eskz2(ivx,ipxtmid)-eskz2(ivx,ipxt1)
+ if (mod(ntupv(ivx,nxtinbm(ivx)),2) .eq. 0)
+ * eloff(ivx,nxtinbm(ivx)) = eloff(ivx,nxtinbm(ivx))+
+ * .5*(eskz2(ivx,ipxtmid+1)-eskz2(ivx,ipxtmid))
+ ipxt1 = 0
+ end if
+2 continue
+c
+c Reset nxtinbm for use as counter as #'s are posted by putxtn(..)
+c
+ nxtinbm(ivx) = 0
+ smed = 0.
+c if (.not.btest(islur(ivx,ipb(1)),2)) then
+ if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.gt.1) then
+c
+c No forced 0 slope
+c
+c if (nnb .eq. 1) go to 6
+ nsc = 0
+ do 5 inb = 1 , nnb-1
+ do 5999 jnb = inb+1 , nnb
+ nsc = nsc+1
+ slope(nsc) = (nolev(ivx,ipb(jnb))-nolev(ivx,ipb(inb)))/
+ * (xelsk(jnb)-xelsk(inb))
+ if (abs(slope(nsc)) .lt. 1.e-4) then
+ nsc = nsc+1
+ slope(nsc) = slope(nsc-1)
+ nsc = nsc+1
+ slope(nsc) = slope(nsc-1)
+ end if
+5999 continue
+5 continue
+ if (nsc .eq. 1) then
+ smed = slope(1)
+ go to 6
+ end if
+ nscmid = nsc/2+1
+ do 7 i = 1 , nscmid
+ do 7999 j = i+1 , nsc
+ if (slope(j) .lt. slope(i)) then
+ t = slope(j)
+ slope(j) = slope(i)
+ slope(i) = t
+ end if
+7999 continue
+7 continue
+ smed = slope(nscmid)
+ if (nsc .eq. 2*(nsc/2)) then
+c
+c Even number of slopes in the list, so median is ambiguous
+c
+ if (abs(slope(nscmid-1)) .lt. abs(slope(nscmid))-tol) then
+c
+c Lower-numbered one is truly less in absolute value, so use it
+c
+ smed=slope(nscmid-1)
+ else if (abs(slope(nscmid-1)+slope(nscmid)) .lt. tol) then
+c
+c Two slopes are effectively equal. Take the one with sign of the average
+c
+ sum = 0.
+ do 1 i = 1 , nsc
+ sum = sum+slope(i)
+1 continue
+ smed = sign(smed,sum)
+ end if
+ end if
+6 continue
+ islope(ivx) = nint(0.5*smed*slfac)
+ if (iabs(islope(ivx)) .gt. 9)
+ * islope(ivx) = isign(9,islope(ivx))
+ else
+c
+c Forced horizontal beam
+c
+ islope(ivx) = 0
+ end if
+ beta = (sumy-islope(ivx)/slfac*sumx)/nnb
+c
+c If ixrest>0, this is a virtual nolev1 at location of rest. Will first use
+c as is for placing xtup number and/or bracket, then reset it for start of
+c actual beam
+c
+ nolev1(ivx) = nint(beta)
+c
+c Check if any stems are too short
+c
+ smin = 100.
+ iul = -1
+ if (ulq(ivx,ibc) .eq. 'u') iul = 1
+ ssq = 0.
+ syb = 0.
+ yb1 = nolev1(ivx)
+ * +iul*(stemlen+bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1))
+ do 4 inb = 1 , nnb
+ ybeam = yb1+islope(ivx)*xelsk(inb)/slfac
+ * -iul*bmhgt*(iand(15,mult(ivx,ipb(inb)))-8-1)
+ syb = syb+ybeam
+ ynote = nolev(ivx,ipb(inb))
+ off = ybeam-ynote
+ if (inb .eq. 1) then
+ off1 = off
+ else if (inb .eq. nnb) then
+ off2 = off
+ end if
+ ssq = ssq+off*off
+ smin = min(smin,iul*off)
+4 continue
+ dnolev = 0.
+ if (smin .lt. stemmin) then
+ deficit = stemmin-smin
+ nolevo = nolev1(ivx)
+ nolev1(ivx) = nint(nolev1(ivx)+iul*deficit)
+ dnolev = nolev1(ivx)-nolevo
+ off1 = off1+dnolev
+ off2 = off2+dnolev
+ end if
+ ssq = ssq+2*dnolev*(syb-sumy)+dnolev**2
+ if (.not.vxtup(ivx) .and. sqrt(ssq/nnb) .gt. stemmax .and.
+ * (abs(off1).lt.stemmax .or. abs(off2).lt.stemmax)
+c * .and. .not.btest(islur(ivx,ipb(1)),2)) then
+ * .and. .not.btest(islur(ivx,ipb(1)),2)
+ * .and. nnb.ne.1) then
+c
+c The first check is to save trouble of putting xtup's in setbm2.
+c The penultimate check is that first and last stems aren't both excessive.
+c The last check is that a 0 slope has not been forced
+c
+ call setbm2(xelsk,nnb,sumx,sumy,ipb,islope(ivx),nolev1(ivx))
+ end if
+c
+c Check if beam starts or ends too high or low.
+c
+ xboff = bmhgt*(iand(15,mult(ivx,ipb(1)))-8-1)
+ l1ng = iul*(nolev1(ivx)-ncmid(iv,ipb(1)))+xboff+7 .lt. 0.
+ xnolev2 = nolev1(ivx)+islope(ivx)/slfac*xelsk(nnb)
+ l2ng = iul*(xnolev2-ncmid(iv,ipb(nnb)))+xboff+7 .lt. 0
+ if (l1ng .or. l2ng) then
+c
+c Need to correct start or stop, also slope
+c
+ if (l1ng) then
+ nolev1(ivx) = nint(ncmid(iv,ipb(1))-(7.+xboff)*iul)
+ end if
+ if (l2ng) then
+ xnolev2 = nint(ncmid(iv,ipb(nnb))-(7.+xboff)*iul)
+ end if
+c
+c Since one or the other end has changed, need to change slope
+c
+c if (.not.btest(islur(ivx,ipb(1)),2))
+ if (.not.btest(islur(ivx,ipb(1)),2) .and. nnb.ne.1)
+ * islope(ivx) = nint(slfac*(xnolev2-nolev1(ivx))/xelsk(nnb))
+ end if
+ if (nssb(ivx) .gt. 0) then
+c
+c This is a single-slope beam group. Store start heights for later segs.
+c
+ do 3 issbs = 1 , nssb(ivx)
+ lev1ssb(ivx,issbs) = nolev1(ivx)+islope(ivx)/slfac*
+ * xelsk(lev1ssb(ivx,issbs))
+3 continue
+ end if
+ return
+ end
+ subroutine sortpoe(nsyst,poe,ipoe)
+ parameter (nks=125)
+ real*4 poe(nks)
+ integer*4 ipoe(nks)
+c
+c Initialize ipoe:
+c
+ do 3 iord = 1 , nsyst
+ ipoe(iord) = iord
+3 continue
+c
+c Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will
+c be index of smallest poe, and ipoe(nsyst) will be index of biggest poe.
+c
+ do 4 io1 = 1 , nsyst-1
+ do 5 io2 = io1+1 , nsyst
+ if (poe(ipoe(io1)) .gt. poe(ipoe(io2))) then
+c
+c Interchange the indices
+c
+ itemp = ipoe(io1)
+ ipoe(io1) = ipoe(io2)
+ ipoe(io2) = itemp
+ end if
+5 continue
+4 continue
+ return
+ end
+ subroutine spsslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
+ * isdat4,nsdat,notcrd,nolev,starter)
+ parameter (nm=24)
+c
+c Reads in slur data. Record all h/v-shifts for non-chords, user-specified
+c ones for chords.
+c 5/26/02 This subr is called ONLY for postscript slurs.
+c
+c See subroutine doslur for bit values in isdat1,2,3
+c
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ integer*4 isdat1(202),isdat2(202),isdat3(202),isdat4(202)
+ logical notcrd,btest
+ character*128 lineq
+ character*1 durq,dumq,starter
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ logical upslur,fontslur,WrotePsslurDefaults
+c
+c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve
+c
+ numint = 0
+ ivoff = 0
+ ihoff = 0
+ nsdat = nsdat+1
+ if (starter.eq.'{' .or. starter.eq.'}')
+ * isdat2(nsdat)=ibset(isdat2(nsdat),3)
+ call setbits(isdat1(nsdat),5,13,iv)
+ call setbits(isdat1(nsdat),1,12,kv-1)
+ call setbits(isdat1(nsdat),8,3,ip)
+ isdat3(nsdat) = 0
+ isdat4(nsdat) = 0
+ ilb12 = 0 ! flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur
+c
+c Get ID code
+c
+ call getchar(lineq,iccount,durq)
+c if (index('uldtb+-hfnHps ',durq) .gt. 0) then
+ if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then
+c
+c Null id. Note for ps slurs, 'H' cannot be an ID
+c
+ iccount = iccount-1
+ if (lineq(iccount:iccount) .eq. 't') then
+ idcode = 1
+ else
+ idcode = 32
+ end if
+ else
+c
+c Set explicit idcode
+c
+ idcode = ichar(durq)
+ if (lineq(iccount-1:iccount-1) .eq. 't') then
+c
+c Make t[ID] look like s[ID]t
+c
+ isdat2(nsdat) = ibset(isdat2(nsdat),3)
+ end if
+ if (lineq(iccount+1:iccount+1).eq.'x') then
+c
+c Flag for 2-voice, indexed slurs
+c
+ iccount = iccount+1
+ call setbits(isdat1(nsdat),1,1,1)
+ end if
+ end if
+ call setbits(isdat1(nsdat),7,19,idcode)
+c
+c Set start/stop: look thru list from end for same idcode,iv,kv
+c
+ do 2 isdat = nsdat-1 , 1 , -1
+ if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
+ * iv .eq. igetbits(isdat1(isdat),5,13) .and.
+c * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
+ * (kv-1 .eq. igetbits(isdat1(isdat),1,12)
+ * .or. btest(isdat1(isdat),1))) then
+c
+c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0.
+c
+ if (btest(isdat1(isdat),11)) go to 3
+c
+c Found slur is a turnoff, so new one is a turnon. Jump down to set bit
+c
+ go to 4
+ end if
+2 continue
+c
+c If here, this is turnon.
+c
+4 continue
+ isdat1(nsdat) = ibset(isdat1(nsdat),11)
+3 continue
+c
+c Now done with initial turnon- or turnoff-specifics.
+c
+ if (nint(SlurCurve).ne.0 .and. btest(isdat1(nsdat),11)) then
+c
+c There's a default curvature tweak
+c
+ icurv1 = nint(SlurCurve)+3
+ if (icurv1 .eq. 2) icurv1 = 1
+ isdat3(nsdat) = ibset(isdat3(nsdat),0)
+ call setbits(isdat3(nsdat),6,2,32+icurv1)
+ end if
+c
+c Loop for rest of input
+c
+1 call getchar(lineq,iccount,durq)
+ if (index('uld',durq) .gt. 0) then
+c
+c Force direction
+c
+ isdat1(nsdat) = ibset(isdat1(nsdat),26)
+ if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
+ go to 1
+ else if (index('+-',durq) .gt. 0) then
+ numint = numint+1
+ if (numint .eq. 1) then
+c
+c Vertical offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ iccount = iccount-1
+ ivoff = nint(fnum)
+ if (durq .eq. '-') ivoff = -ivoff
+ else if (numint .eq. 2) then
+c
+c Horizontal offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ iccount = iccount-1
+c
+c fnum is abs(hshift), must be 0 to 6.3
+c
+ ihoff = fnum*10 + .5
+ if (durq .eq. '-') ihoff = -ihoff
+c
+c Later will set bits to 1...127 to represent -6.3,...+6.3
+c
+ else
+c
+c Must be the 3rd signed integer, so it's a curve specification
+c
+ isdat3(nsdat) = ibset(isdat3(nsdat),0)
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ icurv1 = nint(fnum)
+ if (durq .eq. '-') icurv1 = -icurv1
+ call setbits(isdat3(nsdat),6,2,32+icurv1)
+ if (dumq .ne. ':') then
+c
+c Back up the pointer and loop for more input
+c
+ iccount = iccount-1
+ else
+c
+c Expect two single digits as parameters for curve
+c
+ isdat3(nsdat) = ibset(isdat3(nsdat),1)
+ call setbits(isdat3(nsdat),3,8,
+ * ichar(lineq(iccount+1:iccount+1))-48)
+ call setbits(isdat3(nsdat),3,11,
+ * ichar(lineq(iccount+2:iccount+2))-48)
+ iccount = iccount+2
+ end if
+ end if
+ go to 1
+ else if (durq .eq. 't') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),3)
+ go to 1
+ else if (durq .eq. 'b') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),4)
+ go to 1
+ else if (durq .eq. 's') then
+c
+c Endpoint tweaks for linebreak slurs.
+c
+ call getchar(lineq,iccount,durq) ! Must be +|-
+c
+c Next is vertical offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ if (durq .eq. '-') fnum=-fnum
+ call setbits(isdat4(nsdat),6,ilb12*16,nint(fnum)+32)
+ if (index('+-',dumq) .gt. 0) then
+c
+c Also a horizontal offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,durq,fnum)
+ if (dumq .eq. '-') fnum=-fnum
+ call setbits(isdat4(nsdat),7,ilb12*16+6,nint(10*fnum)+64)
+ end if
+ iccount = iccount-1
+ ilb12 = 1
+ go to 1
+ else if (index('fnhH',durq).gt.0) then
+c
+c Special ps slur curvatures.
+c Translate to old \midslur args (1,4,5,6)
+c
+ icurv1 = index('fnxhH',durq)
+ if (icurv1 .eq. 5) then
+c
+c check for 2nd H
+c
+ if (lineq(iccount+1:iccount+1) .eq. 'H') then
+ iccount = iccount+1
+ icurv1 = 6
+ end if
+ end if
+ isdat3(nsdat) = ibset(isdat3(nsdat),0)
+ call setbits(isdat3(nsdat),6,2,32+icurv1)
+ go to 1
+ else if (durq .eq. 'p') then ! Local adjustment
+ call getchar(lineq,iccount,durq) ! +|-
+ call getchar(lineq,iccount,dumq) ! s|t
+c 26 \sluradjust (p+s)
+c 27 \nosluradjust (p-s)
+c 28 \tieadjust (p+t)
+c 29 \notieadjust (p-t)
+ if (durq .eq. '+') then
+ if (dumq .eq. 's') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),26)
+ else
+ isdat2(nsdat) = ibset(isdat2(nsdat),28)
+ end if
+ else
+ if (dumq .eq. 's') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),27)
+ else
+ isdat2(nsdat) = ibset(isdat2(nsdat),29)
+ end if
+ end if
+ go to 1
+ else if (durq .eq. 'v') then ! Stem slur
+ isdat1(nsdat) = ibset(isdat1(nsdat),2)
+ go to 1
+ end if
+c
+c Record shifts
+c
+ call setbits(isdat2(nsdat),6, 6,ivoff+32)
+ call setbits(isdat2(nsdat),7,12,ihoff+64)
+c
+c Record chord flag, note level, notehead shift
+c
+ if (notcrd) then
+ call setbits(isdat2(nsdat),7,19,nolev)
+ else
+ nolevc = igetbits(icrdat(ncrd),7,12)
+ call setbits(isdat2(nsdat),7,19,nolevc)
+ isdat2(nsdat) = ibset(isdat2(nsdat),0)
+ call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
+ end if
+ return
+ end
+ subroutine sslur(lineq,iccount,iv,kv,ip,isdat1,isdat2,isdat3,
+ * nsdat,notcrd,nolev,starter)
+ parameter (nm=24)
+c
+c Reads in slur data. Record all h/v-shifts for non-chords, user-specified
+c ones for chords.
+c 5/26/02 now only for non-postscript slurs, use spsslur() for postscript
+c
+c See subroutine doslur for bit values in isdat1,2,3
+c
+ common /comtrill/ ntrill,ivtrill(24),iptrill(24),xnsktr(24),
+ * ncrd,icrdat(193),icrdot(193),icrdorn(193),nudorn,
+ * kudorn(63),ornhshft(63),minlev,maxlev,icrd1,icrd2
+ integer*4 isdat1(202),isdat2(202),isdat3(202)
+ logical notcrd,btest
+ character*128 lineq
+ character*1 durq,dumq,starter
+ common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur
+ * ,WrotePsslurDefaults,SlurCurve
+ logical upslur,fontslur,WrotePsslurDefaults
+c
+c Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve
+c
+ numint = 0
+ ivoff = 0
+ ihoff = 0
+ nsdat = nsdat+1
+ if (starter.eq.'{' .or. starter.eq.'}')
+ * isdat2(nsdat)=ibset(isdat2(nsdat),3)
+ call setbits(isdat1(nsdat),5,13,iv)
+ call setbits(isdat1(nsdat),1,12,kv-1)
+ call setbits(isdat1(nsdat),8,3,ip)
+ isdat3(nsdat) = 0
+c
+c Get id letter
+c
+ if (lineq(iccount:iccount) .eq. 't') then
+c
+c Old-style t-slur. Use special idcode = 1
+c
+ idcode = 1
+ else
+ call getchar(lineq,iccount,durq)
+ if (index('uldtb+-hf ',durq) .gt. 0) then
+c
+c Null id
+c
+ idcode = 32
+ iccount = iccount-1
+ else if (durq.eq.'H') then
+c
+c Postscript slur, cannot use 'H' as code, must check for 2nd 'H'
+c
+ idcode = 32
+ iccount = iccount-1
+c
+c There may be another "H", but no need to deal with it yet
+c
+ else
+c
+c Set explicit idcode
+c
+ idcode = ichar(durq)
+ end if
+ end if
+ call setbits(isdat1(nsdat),7,19,idcode)
+c
+c Set start/stop: look thru list from end for same idcode,iv,kv
+c
+ do 2 isdat = nsdat-1 , 1 , -1
+ if (idcode .eq. igetbits(isdat1(isdat),7,19) .and.
+ * iv .eq. igetbits(isdat1(isdat),5,13) .and.
+ * kv-1 .eq. igetbits(isdat1(isdat),1,12)) then
+c
+c Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0.
+c
+ if (btest(isdat1(isdat),11)) go to 3
+c
+c Found slur is a turnoff, so new one is a turnon. Jump down to set bit
+c
+ go to 4
+ end if
+2 continue
+c
+c If here, this is turnon.
+c
+4 continue
+ isdat1(nsdat) = ibset(isdat1(nsdat),11)
+3 continue
+c
+c Now done with initial turnon- or turnoff-specifics. Loop for rest of input
+c
+1 call getchar(lineq,iccount,durq)
+ if (index('uld',durq) .gt. 0) then
+c
+c Force direction
+c
+ isdat1(nsdat) = ibset(isdat1(nsdat),26)
+ if (durq .eq. 'u') isdat1(nsdat) = ibset(isdat1(nsdat),27)
+ go to 1
+ else if (index('+-',durq) .gt. 0) then
+ numint = numint+1
+ if (numint .eq. 1) then
+c
+c Vertical offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ iccount = iccount-1
+ ivoff = nint(fnum)
+ if (durq .eq. '-') ivoff = -ivoff
+ else if (numint .eq. 2) then
+c
+c Horizontal offset
+c
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ iccount = iccount-1
+c
+c fnum is abs(hshift), must be 0 to 6.3
+c
+ ihoff = fnum*10 + .5
+ if (durq .eq. '-') ihoff = -ihoff
+c
+c Later will set bits to 1...127 to represent -6.3,...+6.3
+c
+ else
+c
+c Must be the 3rd signed integer, so it's a curve specification
+c
+ isdat3(nsdat) = ibset(isdat3(nsdat),0)
+ iccount = iccount+1
+ call readnum(lineq,iccount,dumq,fnum)
+ icurv1 = nint(fnum)
+ if (durq .eq. '-') icurv1 = -icurv1
+ call setbits(isdat3(nsdat),6,2,32+icurv1)
+ if (dumq .ne. ':') then
+c
+c Back up the pointer and loop for more input
+c
+ iccount = iccount-1
+ else
+c
+c Expect two single digits as parameters for curve
+c
+ isdat3(nsdat) = ibset(isdat3(nsdat),1)
+ call setbits(isdat3(nsdat),3,8,
+ * ichar(lineq(iccount+1:iccount+1))-48)
+ call setbits(isdat3(nsdat),3,11,
+ * ichar(lineq(iccount+2:iccount+2))-48)
+ iccount = iccount+2
+ end if
+ end if
+ go to 1
+ else if (durq .eq. 't') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),3)
+ go to 1
+ else if (durq .eq. 'b') then
+ isdat2(nsdat) = ibset(isdat2(nsdat),4)
+ go to 1
+ else if (index('fhH',durq) .gt. 0) then
+c
+c Special ps slur curvatures. Translate to old \midslur args (1,4,5,6)
+c
+ icurv1 = 2+index('fhH',durq)
+ if (icurv1 .eq. 3) then
+ icurv1 = 1
+ else if (icurv1 .eq. 5) then
+c
+c check for 2nd H
+c
+ if (lineq(iccount+1:iccount+1) .eq. 'H') then
+ iccount = iccount+1
+ icurv1 = 6
+ end if
+ end if
+ isdat3(nsdat) = ibset(isdat3(nsdat),0)
+c
+c Must change sign if downslur, but cannot do it now since we don't know
+c slur direction for sure.
+c
+ call setbits(isdat3(nsdat),6,2,32+icurv1)
+ go to 1
+ end if
+c
+c Record shifts
+c
+ call setbits(isdat2(nsdat),6, 6,ivoff+32)
+ call setbits(isdat2(nsdat),7,12,ihoff+64)
+c
+c Record chord flag, note level, notehead shift
+c
+ if (notcrd) then
+ call setbits(isdat2(nsdat),7,19,nolev)
+ else
+ nolevc = igetbits(icrdat(ncrd),7,12)
+ call setbits(isdat2(nsdat),7,19,nolevc)
+ isdat2(nsdat) = ibset(isdat2(nsdat),0)
+ call setbits(isdat2(nsdat),2,1,igetbits(icrdat(ncrd),2,23))
+ end if
+ return
+ end
+ subroutine stop1()
+ call exit(1)
+ end
+ subroutine topfile(basenameq,lbase,nv,clefq,noinst,musicsize,
+ * xinstf1,mtrnmp,mtrdnp,vshrink,fbar,fontslur)
+ parameter (nm=24)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink,fontslur
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8),
+ * xinsnow,lowdot
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ character*79 inameq
+ character*44 basenameq
+ character*24 fmtq
+ character*5 fbarq
+ character*1 clefq(nm),sq,chax,clefqiv
+ common /comstart/ facmtr
+ logical vshrink,lowdot,rename
+ logical novshrinktop,cstuplet
+ common /comnvst/ novshrinktop,cstuplet
+ common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm),
+ * instno(nm),nInstTrans,EarlyTransOn,LaterInstTrans
+ logical EarlyTransOn,LaterInstTrans
+ common /comsize/ isize(nm)
+ common /comis4bignv/ is4bignv,AIset
+ logical is4bignv,AIset
+ common /comc8flag/ c8flag(nm)
+ logical c8flag
+ sq = chax(92)
+ vshrink = xinstf1.gt.20. .and. .not.novshrinktop
+ if (vshrink) then
+ xinsnow = 10.
+ else
+ xinsnow = xinstf1
+ end if
+ if (.not.islast) return
+c
+c Initialize octave treble clef tracker
+c
+ do 6 im = 1 , nm
+ c8flag(im) = .false.
+6 continue
+ write(11,'(a)')'%%%%%%%%%%%%%%%%%'
+ write(11,'(a)')'%'
+ write(11,'(a)')'% '//basenameq(1:lbase)//'.tex'
+ write(11,'(a)')'%'
+ write(11,'(a)')'%%%%%%%%%%%%%%%%'
+ write(11,'(a)')sq//'input musixtex'
+ write(11,'(a)')sq//'input pmx'
+ write(11,'(a)')
+ * sq//'setmaxslurs{24}'//sq//'setmaxinstruments{24}%'
+ if (.not.fontslur) write(11,'(a)')sq//'input musixps'
+c
+c Need to input musixmad to permit more slurs.
+c
+ if (musicsize .eq. 20) then
+ write(11,'(a)')sq//'normalmusicsize%'
+ else if (musicsize .eq. 16) then
+ write(11,'(a)')sq//'smallmusicsize%'
+ else if (musicsize .eq. 24) then
+ write(11,'(a)')sq//'largemusicsize%'
+c
+c Eliminate, per Tennent's analysis and musixtex changes since first input
+c
+c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
+c * 'meterlargefont}%'
+ else if (musicsize .eq. 29) then
+ write(11,'(a)')sq//'Largemusicsize%'
+c write(11,'(a)')sq//'def'//sq//'meterfont{'//sq//
+c * 'meterLargefont}%'
+ end if
+c
+c Set sizes. Have sizes per staff in isize(.) and noinst per staff in
+c nsperi(.)
+c
+c 130324
+c iiv = 1
+ do 5 iinst = 1 , noinst
+c if (isize(iiv) .eq. 1) then
+ if (isize(iinst) .eq. 1) then
+ if(iinst.le.9) then
+ write(11,'(a8,i1,a)')
+ * sq//'setsize',iinst,sq//'smallvalue%'
+ else
+ write(11,'(a9,i2,a)')
+ * sq//'setsize{',iinst,'}'//sq//'smallvalue%'
+ end if
+c else if (isize(iiv) .eq. 2) then
+ else if (isize(iinst) .eq. 2) then
+ if(iinst.le.9) then
+ write(11,'(a8,i1,a)')
+ * sq//'setsize',iinst,sq//'tinyvalue%'
+ else
+ write(11,'(a9,i2,a)')
+ * sq//'setsize{',iinst,'}'//sq//'tinyvalue%'
+ end if
+ end if
+c iiv = iiv+nsperi(iinst)
+5 continue
+ write(fbarq,'(f5.3)')fbar
+ write(11,'(a)')sq//'nopagenumbers'
+ write(11,'(a)')sq//'tracingstats=2'//sq//'relax'
+ write(11,'(a7,i3,a2)')sq//'hsize=',nint(widthpt),'pt'
+ write(11,'(a6,i'//chax(49+int(log10(height+.1)))//',a2)')
+ * sq//'vsize',int(height+.1),'pt'
+ if (abs(hoffpt) .gt. 0.1) then
+ if (hoffpt .le. -10.) then
+ write(11,'(a8,i3,a2)')sq//'hoffset',nint(hoffpt),'pt'
+ else if (hoffpt .lt. 0.) then
+ write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
+ else if (hoffpt .lt. 10.) then
+ write(11,'(a8,i1,a2)')sq//'hoffset',nint(hoffpt),'pt'
+ else
+ write(11,'(a8,i2,a2)')sq//'hoffset',nint(hoffpt),'pt'
+ end if
+ end if
+ if (abs(voffpt) .gt. 0.1) then
+ if (voffpt .le. -10.) then
+ write(11,'(a8,i3,a2)')sq//'voffset',nint(voffpt),'pt'
+ else if (voffpt .lt. 0.) then
+ write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
+ else if (voffpt .lt. 10.) then
+ write(11,'(a8,i1,a2)')sq//'voffset',nint(voffpt),'pt'
+ else
+ write(11,'(a8,i2,a2)')sq//'voffset',nint(voffpt),'pt'
+ end if
+ end if
+c
+c The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if
+c 3 sharps and treble clef, to avoid vertical clash with top space g#
+c
+ if (isig.eq.3 .and. clefq(nv).eq.'t') write(11,'(a)')
+ * sq//'def'//sq//'raisebarno{4.5'//sq//'internote}'
+ if (noinst .lt. 10) then
+ write(11,'(a19,i1,a1)')sq//'def'//sq//'nbinstruments{',
+ * noinst,'}'
+ else
+ write(11,'(a19,i2,a1)')sq//'def'//sq//'nbinstruments{',
+ * noinst,'}'
+ end if
+ iv = 0
+ do 1 iinst = 1 , noinst
+ nstaves = nsperi(iinst)
+ if (iinst .lt. 10) then
+ write(11,'(a)')sq//'setstaffs'//chax(48+iinst)
+ * //chax(48+nstaves)
+ else
+ write(11,'(a11,i2,a)')sq//'setstaffs{',iinst,'}'
+ * //chax(48+nstaves)
+ end if
+ iv = iv+1
+ clefqiv = clefq(iv)
+ if (clefqiv.eq.'8') then
+ clefqiv='t'
+ iTransAmt(instno(iv)) = 7+iTransAmt(instno(iv))
+ c8flag(iv) = .true.
+ end if
+ if (nstaves .eq. 1) then
+ fmtq = chax(48+numclef(clefq(iv)))
+ lfmtq = 1
+ else
+ fmtq = '{'//chax(48+numclef(clefq(iv)))
+ lfmtq = 2
+ do 2 k = 2 , nstaves
+ iv = iv+1
+ fmtq = fmtq(1:lfmtq)//chax(48+numclef(clefq(iv)))
+ lfmtq = lfmtq+1
+2 continue
+ fmtq = fmtq(1:lfmtq)//'}'
+ lfmtq = lfmtq+1
+ end if
+ if (iinst .lt. 10) then
+ write(11,'(a)')sq//'setclef'//chax(48+iinst)//fmtq(1:lfmtq)
+ else
+ write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq)
+ end if
+ if (clefq(iv) .eq. '8') then
+ if (iinst .lt. 10) then
+ write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)//
+ * sq//'treblelowoct%'
+ else
+ write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'//
+ * sq//'treblelowoct%'
+ end if
+ c8flag(iv) = .true.
+ end if
+ do 3 lname = 79 , 2 , -1
+ if (inameq(iinst)(lname:lname) .ne. ' ') go to 4
+3 continue
+4 continue
+ lnam(iinst) = lname
+ if (iinst .lt. 10) then
+ write(11,'(a8,i1,a)')sq//'setname',iinst,
+ * '{'//inameq(iinst)(1:lname)//'}'
+ else
+ write(11,'(a9,i2,a)')sq//'setname{',iinst,
+ * '}{'//inameq(iinst)(1:lname)//'}'
+ end if
+1 continue
+ write(11,'(a18,i2,a2)')sq//'generalsignature{',isig,'}%'
+ if (EarlyTransOn)
+ * call Writesetsign(nInstTrans,iInstTrans,iTransKey,EarlyTransOn)
+ call wgmeter(mtrnmp,mtrdnp)
+ ipi = nint(fracindent*widthpt)
+ if (ipi .lt. 10) then
+ write(11,'(a11,i1,a2)')sq//'parindent ',ipi,'pt'
+ else if (ipi .lt. 100) then
+ write(11,'(a11,i2,a2)')sq//'parindent ',ipi,'pt'
+ else
+ write(11,'(a11,i3,a2)')sq//'parindent ',ipi,'pt'
+ end if
+ write(11,'(a)')sq//'elemskip1pt'//sq//'afterruleskip'
+ * //fbarq//'pt'//sq//'beforeruleskip0pt'//sq//'relax'
+ if (.not.vshrink) then
+ if (xinstf1 .lt. 9.95) then
+ fmtq = '(a,f3.1,a)'
+ else
+ fmtq = '(a,f4.1,a)'
+ end if
+ facis = 1.
+ if (is4bignv) facis = .95
+ write(11,fmtq)sq//'stafftopmarg0pt'//sq//'staffbotmarg0pt'
+ * //sq//'interstaff{',xinstf1*facis,'}'//sq//'relax'
+ else
+ write(11,'(a)')sq//'stafftopmarg0pt'//
+ * sq//'staffbotmarg5'//sq//'Interligne'//sq//
+ * 'interstaff{10}'//sq//'relax'
+ end if
+ if (nv.eq.1) write(11,'(a)')sq//'nostartrule'
+ write(11,'(a)')sq//'readmod{'//basenameq(1:lbase)//'}'
+ if (cstuplet) then
+ write(11,'(a)')sq//'input tuplet'
+ * //sq//'def'//sq//'xnumt#1#2#3{'//sq//'zcharnote{#2}{~}'
+ * //sq//'def'//sq//'tuplettxt{'//sq//'smalltype'//sq//'it{#3}'
+ * //sq//chax(47)//sq//'/}}%'
+ write(11,'(a)')sq//'let'//sq//'ovbkt'//sq//'uptuplet'
+ * //sq//'let'//sq//'unbkt'//sq//'downtuplet%'
+ end if
+ write(11,'(a)')sq//'startmuflex'//sq//'startpiece'//sq//
+ * 'addspace'//sq//'afterruleskip%'
+ return
+ end
+ character*1 function udfq(nolev,ncm)
+c
+c Slur directions
+c
+ common /combc/ bcspec
+ logical bcspec
+ ntest = nolev-ncm
+ if (ntest.lt.0 .or.
+ * (ntest.eq.0 .and. bcspec .and. ncm.eq.23) ) then
+ udfq = 'd'
+ else
+ udfq = 'u'
+ end if
+ return
+ end
+ character*1 function udqq(nole,ncm,isl,nvmx,ivx,nv)
+c
+c Stem direction for single notes
+c
+ character*1 ulfq
+ character*1 udqqq
+ logical btest
+ if (btest(isl,30)) then
+c
+c Absolute override
+c
+ if (btest(isl,17)) then
+ udqqq = 'u'
+ else
+ udqqq = 'l'
+ end if
+ else if (nvmx .eq. 1) then
+c
+c Single voice per staff, default
+c
+ udqqq = ulfq(1.*nole,ncm)
+ else
+c
+c Multi-voice per staff, 1st is lower, 2nd upper
+c
+ if (ivx .le. nv) then
+ udqqq = 'l'
+ else
+ udqqq = 'u'
+ end if
+ end if
+ udqq = udqqq
+ return
+ end
+ character*1 function ulfq(xnolev,ncm)
+c
+c Stem directions
+c
+ common /combc/ bcspec
+ logical bcspec
+ test = xnolev-ncm
+ if (test.lt.-.001 .or.
+ * (test.lt..001.and.bcspec.and.ncm.eq.23) ) then
+ ulfq = 'u'
+ else
+ ulfq = 'l'
+ end if
+ return
+ end
+ function upcaseq(chq)
+ character*1 chq,upcaseq,chax
+ if (ichar(chq).ge.61.and.ichar(chq).lt.122) then
+ upcaseq = chax(ichar(chq)-32)
+ else
+ upcaseq = chq
+ print*,'Warning, upcaseq was called with improper argument: '
+ * //chq
+ stop
+ end if
+ return
+ end
+ subroutine wgmeter(mtrnmp,mtrdnp)
+c
+c Writes meter stuff to file 11, so only called if islast=.true.
+c
+ character*1 sq,chax
+ if (mtrdnp .eq. 0) return
+ sq=chax(92)
+ if (mtrnmp.gt.0 .and. mtrnmp.le.9) then
+ if (mtrdnp .lt. 10) then
+ write(11,'(a25,i1,a2,i1,a3)')
+ * sq//'generalmeter{'//sq//'meterfrac{',
+ * mtrnmp,'}{',mtrdnp,'}}%'
+ else
+ write(11,'(a25,i1,a2,i2,a3)')
+ * sq//'generalmeter{'//sq//'meterfrac{',
+ * mtrnmp,'}{',mtrdnp,'}}%'
+ end if
+ else if (mtrnmp .ge. 10) then
+ if (mtrdnp .lt. 10) then
+ write(11,'(a25,i2,a2,i1,a3)')
+ * sq//'generalmeter{'//sq//'meterfrac{',
+ * mtrnmp,'}{',mtrdnp,'}}%'
+ else
+ write(11,'(a25,i2,a2,i2,a3)')
+ * sq//'generalmeter{'//sq//'meterfrac{',
+ * mtrnmp,'}{',mtrdnp,'}}%'
+ end if
+ else if (mtrnmp .lt. 0) then
+ write(11,'(a26,i1,a2,i1,a3)')
+ * sq//'generalmeter{'//sq//'meterfracS{',
+ * -mtrnmp,'}{',mtrdnp,'}}%'
+ else if (mtrdnp .le. 4) then
+ write(11,'(a21,i1,a2)')
+ * sq//'generalmeter{'//sq//'meterN',mtrdnp,'}%'
+ else if (mtrdnp .eq. 5) then
+ write(11,'(a)')sq//'generalmeter'//sq//'allabreve%'
+ else if (mtrdnp .eq. 6) then
+ write(11,'(a)')sq//'generalmeter'//sq//'meterC%'
+ else if (mtrdnp .eq. 7) then
+ write(11,'(a)')sq//'generalmeter'//sq//'meterIIIS%'
+ end if
+ return
+ end
+ subroutine writemidi(jobname,ljob)
+ parameter(nm=24,mv=24576)
+ common /all/ mult(nm,200),iv,nnl(nm),nv,ibar,
+ * ivxo(600),ipo(600),to(600),tno(600),tnote(600),eskz(nm,200),
+ * ipl(nm,200),ibm1(nm,9),ibm2(nm,9),nolev(nm,200),ibmcnt(nm),
+ * nodur(nm,200),jn,lenbar,iccount,nbars,itsofar(nm),nacc(nm,200),
+ * nib(nm,15),nn(nm),lenb0,lenb1,slfac,musicsize,stemmax,
+ * stemmin,stemlen,mtrnuml,mtrdenl,mtrnmp,mtrdnp,islur(nm,200),
+ * ifigdr(2,125),iline,figbass,figchk(2),firstgulp,irest(nm,200),
+ * iornq(nm,0:200),isdat1(202),isdat2(202),nsdat,isdat3(202),
+ * isdat4(202),beamon(nm),isfig(2,200),sepsymq(nm),sq,ulq(nm,9)
+ character*1 ulq,sepsymq,sq
+ logical beamon,firstgulp,figbass,figchk,isfig
+ character*1 byteq(4),char,chax
+ character*10 tempoq,instq
+ character*44 jobname
+ integer*2 mmidi
+ logical restpend,relacc,notmain,twoline,ismidi,crdacc
+ common /commidi/ imidi(0:nm),trest(0:nm),mcpitch(20),mgap,
+ * iacclo(0:nm,6),iacchi(0:nm,6),midinst(nm),
+ * nmidcrd,midchan(nm,2),numchan,naccim(0:nm),
+ * laccim(0:nm,10),jaccim(0:nm,10),crdacc,notmain,
+ * restpend(0:nm),relacc,twoline(nm),ismidi,mmidi(0:nm,mv),
+ * debugmidi
+ logical debugmidi
+ common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm)
+ * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm)
+ common /comevent/ miditime,lasttime
+ logical mmacrec,gottempo
+ common /commmac/ mmacstrt(0:nm,20),mmacend(0:nm,20),immac,
+ * mmactime(20),nmidsec,msecstrt(0:nm,60),msecend(0:nm,60),
+ * mmacrec,gottempo
+ character*79 inameq
+ common /comtop / itopfacteur,ibotfacteur,interfacteur,isig0,
+ * isig,lastisig,fracindent,widthpt,height,hoffpt,voffpt,idsig,
+ * lnam(nm),inameq(nm)
+ logical rename
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+c
+c Used to be icmm(0:nm); did midi fail when nv>16?
+c
+ integer*2 iinsiv,icmm(0:15)
+ character*5 versionc
+ common /comver/ versionc
+c
+c These are not consecutive because channel 9 is reserved for percussion.
+c
+ data icmm /0,1,2,3,4,5,6,7,8,10,11,12,13,14,15,16/
+c
+c Write Header
+c
+ write(51,'(a,$)')'MThd'//char(0)//char(0)//char(0)//char(6)
+ * //char(0)//char(1)//char(0)//char(numchan+1)//char(0)//char(240)
+ if (debugmidi)
+ * write(52,'(a6,10Z4)')'"MThd"',0,0,0,6,
+ * 0,1,0,numchan+1,0,240
+c
+c Write the "conductor" track, for keys, meter, and tempos
+c Get the number of bytes in the conductor event stream
+c
+ ndata = 1+imidi(numchan)-msecstrt(numchan,nmidsec)
+ do 15 isec = 1 , nmidsec-1
+ ndata = ndata+1+msecend(numchan,isec)-msecstrt(numchan,isec)
+15 continue
+c ib1 = (4+ljob+26+ndata+4)/256
+c ib0 = 4+ljob+26+ndata+4-256*ib1
+ ib1 = (4+ljob+27+ndata+4)/256
+ ib0 = 4+ljob+27+ndata+4-256*ib1
+ write(51,'(a,$)')'MTrk'//char(0)//char(0)//char(ib1)//char(ib0)
+c
+c Text header
+c
+c * //char(0)//char(255)//char(1)//char(ljob+26)
+ * //char(0)//char(255)//char(1)//char(ljob+27)
+ if (debugmidi)
+ * write(52,'(a6,8z4)')'"MTrk"',0,0,ib1,ib0,
+ * 0,255,1,ljob+27
+ write(51,'(a,$)')jobname(1:ljob)
+ if (debugmidi) write(52,'(a)')chax(34)//jobname(1:ljob)//chax(34)
+c
+c (separate writes are needed to defeat compiler BUG!!!)
+c
+ write(51,'(a,$)')'.mid, produced by PMX '//versionc
+ if (debugmidi) write(52,'(a)')
+ * chax(34)//'.mid, produced by PMX '//versionc//chax(34)
+c
+c Conductor event data: Loop over sections.
+c
+ do 16 isec = 1 , nmidsec
+ if (isec .lt. nmidsec) then
+ mend = msecend(numchan,isec)
+ else
+ mend = imidi(numchan)
+ end if
+ do 17 i = msecstrt(numchan,isec) , mend
+ write(51,'(a,$)')char(mmidi(numchan,i))
+ if (debugmidi) write(52,'(z4)')mmidi(numchan,i)
+17 continue
+16 continue
+c
+c And close out the time sig / tempo track.
+c
+ write(51,'(a,$)')char(0)//char(255)//char(2*16+15)//char(0)
+ if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
+c
+c Loop over track for each voice: The following sets up iv.
+c
+ iv = nv
+ if (twoline(nv)) then
+ kv = 2
+ else
+ kv = 1
+ end if
+c
+ do 5 icm = 0 , numchan-1
+c
+c Get the number of bytes in the data stream
+c
+ ndata = 1+imidi(icm)-msecstrt(icm,nmidsec)
+ do 11 isec = 1 , nmidsec-1
+ ndata = ndata+1+msecend(icm,isec)-msecstrt(icm,isec)
+11 continue
+c
+c Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count,
+c
+ ndata = ndata+11
+c
+c Add 4+lnam(iinsiv(iv)) if lnam>0 ,
+c
+ if (lnam(iinsiv(iv)).gt.0) ndata = ndata+4+lnam(iinsiv(iv))
+c
+c Separate total byte counts into 4 bytes
+c
+ do 2 ibyte = 1 , 4
+ if (ndata .gt. 0) then
+ byteq(ibyte) = char(mod(ndata,256))
+ ndata = ishft(ndata,-8)
+ else
+ byteq(ibyte) = char(0)
+ end if
+2 continue
+c
+c Now write front stuff for this track
+c
+ write(51,'(a,$)')'MTrk'//byteq(4)//byteq(3)//byteq(2)//byteq(1)
+ * //char(0)//char(12*16+icmm(icm))//char(midinst(iinsiv(iv)))
+ * //char(0)//char(11*16+icmm(icm))//char(10)//char(midbc(icm))
+ if (debugmidi) write(52,'(a4,z2,a7,11z4)')'icm=',icm,
+ * ' "MTrk"',ichar(byteq(4)),ichar(byteq(3)),ichar(byteq(2)),
+ * ichar(byteq(1)),0,12*16+icmm(icm),midinst(iinsiv(iv)),
+ * 0,11*16+icmm(icm),10,midbc(icm)
+ if (lnam(iinsiv(iv)) .gt. 0) then
+c
+c Add instrument name as sequence name
+c
+ write(51,'(a,$)')char(0)//char(255)//char(3)
+ * //char(lnam(iinsiv(iv)))
+ if (debugmidi) write(52,'(4z4)')0,255,3,lnam(iinsiv(iv))
+ write(51,'(a,$)')
+ * inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))
+ if (debugmidi) write(52,'(a)')
+ * chax(34)//inameq(iinsiv(iv))(1:lnam(iinsiv(iv)))//chax(34)
+ end if
+ write(tempoq,'(i2)')icm
+ write(instq,'(i3)')midinst(iinsiv(iv))
+ call printl('MIDI instrument '//tempoq(1:2)//' is '//instq(1:3))
+c
+c Notes: Loop over sections.
+c
+ do 9 isec = 1 , nmidsec
+ if (isec .lt. nmidsec) then
+ mend = msecend(icm,isec)
+ else
+ mend = imidi(icm)
+ end if
+ do 10 i = msecstrt(icm,isec) , mend
+ write(51,'(a,$)')char(mmidi(icm,i))
+ if (debugmidi) write(52,'(z4)')mmidi(icm,i)
+10 continue
+9 continue
+c
+c Closing 4 bytes
+c
+ write(51,'(a,$)')chax(0)//char(255)//char(2*16+15)//char(0)
+ if (debugmidi) write(52,'(4z4)')0,255,2*16+15,0
+ if (kv .eq. 2) then
+ kv = 1
+ else if (iv .eq. 1) then
+ go to 5
+ else
+ iv = iv-1
+ if (twoline(iv)) kv=2
+ end if
+5 continue
+c write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan)
+c write(15,'(1x,a12,(10i6))')
+c * 'Bytes used:',(imidi(icm),icm=0,numchan)
+ close(51)
+ if (debugmidi) close(52)
+ return
+ end
+ subroutine Writesetsign(nInstTrans,iInstTrans,iTransKey,flag)
+ parameter(nm=24)
+ integer*4 iInstTrans(nm),iTransKey(nm)
+ character*79 notexq
+ character*1 chax
+ logical flag
+c
+c Assumes notexq is blank
+c
+ do 1 i = 1 , nInstTrans
+ notexq = chax(92)//'setsign'
+ lnote = 8
+ if (iInstTrans(i) .lt. 10) then
+ notexq = notexq(1:lnote)//chax(48+iInstTrans(i))
+ lnote = lnote+1
+ else
+ write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
+ * '{',iInstTrans(i),'}'
+ lnote = lnote+4
+ end if
+ if (iTransKey(i) .lt. 0) then
+ write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')
+ * '{',iTransKey(i),'}'
+ lnote = lnote+4
+ else
+ notexq = notexq(1:lnote)//chax(48+iTransKey(i))
+ lnote = lnote+1
+ end if
+ write(11,'(a)')notexq(1:lnote)//'%'
+1 continue
+ flag = .false.
+ return
+ end
+ subroutine writflot(x,notexq,lenline)
+ character*(*) notexq
+ if (x .lt. 0.95) then
+ write(notexq(lenline+1:lenline+2),'(f2.1)')x
+ lenline = lenline+2
+ else if (x .lt. 9.95) then
+ write(notexq(lenline+1:lenline+3),'(f3.1)')x
+ lenline = lenline+3
+ else
+ write(notexq(lenline+1:lenline+4),'(f4.1)')x
+ lenline = lenline+4
+ end if
+ return
+ end
+ subroutine wsclef(iv,ninow,nclef)
+c subroutine wsclef(iv,ninow,clefq,nclef)
+c
+c Writes \setclef for instrument containing *staff* iv
+c
+ parameter (nm=24)
+ common /comlast/ islast,usevshrink
+ logical islast,usevshrink
+ common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm)
+ logical rename
+c
+c In pmx271, had removed clefq, so with 2 or more staves in
+c an instrument, had problems. So replace in 272
+c
+ common /comclefq/ clefq(nm)
+ character*1 clefq,chax
+ character*40 temq
+ common /comc8flag/ c8flag(nm)
+ logical c8flag
+ if (nclef .lt. 7) then
+ clefq(iv) = chax(48+nclef)
+ else
+ clefq(iv)='9'
+ end if
+ if (.not.islast) return
+ iv1 = 1
+ do 1 iinst = 1 , ninow
+ if (iv .lt. iv1+nspern(iinst)) go to 2
+ iv1 = iv1+nspern(iinst)
+1 continue
+ print*
+ print*,'Should not be here in wsclef!'
+ call stop1()
+2 continue
+c
+c Here, iinst is the instrument number with staff of clef change
+c
+ iv2 = iv1+nspern(iinst)-1
+ if (iinst .lt. 10) then
+ temq = chax(92)//'setclef'//chax(48+iinst)
+ ltem = 9
+ else
+ write(temq,'(a9,i2,a1)') chax(92)//'setclef{',iinst,'}'
+ ltem = 12
+ end if
+ if (iv1 .eq. iv2) then
+c
+c Only one staff (iv) in instrument with clef change
+c
+ write(11,'(a)')temq(1:ltem)//clefq(iv)//'%'
+ else
+ temq = temq(1:ltem)//'{'
+ ltem = ltem+1
+c
+c Loop over staves, but clefq has only changed for one of them
+c
+ do 3 iiv = iv1 , iv2
+ temq = temq(1:ltem)//chax(48+numclef(clefq(iiv)))
+ ltem = ltem+1
+3 continue
+ write(11,'(a)')temq(1:ltem)//'}%'
+ end if
+ if (c8flag(iv)) then
+c
+c If we change FROM octave treble clef to some other, need the following.
+c
+ write(11,'(a)')char(92)//'settrebleclefsymbol'//chax(48+iinst)
+ * //char(92)//'trebleclef%'
+ c8flag(iv) = .false.
+ end if
+ return
+ end
+ subroutine chkpmxlyr(lineq,iccount,lyrerr)
+ character*128 lineq
+ character*1 charq,chax
+ lyrerr = 0
+c
+c On entry, last char was "
+c
+18 call g1etchar(lineq,iccount,charq)
+ if (iccount .eq. 121) then
+ lyrerr = 2
+ return
+ else if (charq.eq.chax(34) .and.
+ * .not.(lineq(iccount-1:iccount-1).eq.char(92))) then
+ call g1etchar(lineq,iccount,charq)
+c
+c Check for raise/lower command
+c
+ if (charq .eq. '@') then
+c
+c @ positions lyrics vertically for current voice
+c [a,b] above or below of the staff
+c +/- i offset, \internotes
+c
+ call g1etchar(lineq,iccount,charq)
+ if (index('ab',charq).eq.0) then
+ lyrerr = 3
+ return
+ end if
+ call g1etchar(lineq,iccount,charq)
+ if (index('+-',charq).eq.0) then
+ lyrerr = 4
+ return
+ end if
+ call g1etchar(lineq,iccount,charq)
+ if (index('0123456789',charq).eq.0) then
+ lyrerr = 5
+ return
+ end if
+ else if (charq .ne. ' ') then
+c
+c 2nd " must be followed by ' '
+c
+ lyrerr = 1
+ return
+ end if
+ return
+ end if
+ go to 18
+ end
+ subroutine dopmxlyr(lineq,iccount)
+c
+c lineq has " at iccount. Find end of lyrics string, replace "..."
+c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ',
+c (unless preceded with '\'), check length
+c
+ character*128 lineq,lineqt
+ character*1 sq,chax
+ sq = chax(92)
+ iend = lenstr(lineq,128)
+c
+c i2nd = iccount+index(lineq(iccount+1:128),'"')
+c Find position of closing '"'; must bypass any \" which is used for umlaut
+c
+ i2nd = iccount+index(lineq(iccount+1:128),chax(34))
+2 continue
+ if (lineq(i2nd-1:i2nd-1).eq.char(92)) then
+ i2nd = i2nd+index(lineq(i2nd+1:128),chax(34))
+ go to 2
+ end if
+ istart = iccount
+1 itilde = istart+index(lineq(istart+1:i2nd-1),'~')
+ if (itilde.gt.istart.and.itilde.lt.i2nd) then
+c
+c Replace tilde if not preceded by \
+c
+ if (iend .ge. 117) then
+ print*,'Sorry, lyric string is too long, stopping'
+ call stop1()
+ else if (lineq(itilde-1:itilde-1) .eq. sq) then
+ istart = itilde
+ go to 1
+ end if
+ lineqt = lineq(1:itilde-1)//sq//'lk '
+ * //lineq(itilde+1:iend)
+ iend = lenstr(lineqt,128)
+ i2nd = i2nd+3
+ lineq = lineqt
+ go to 1
+ end if
+ if (iccount .eq. 1) then
+ lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq
+ * //lineq(i2nd+1:128)
+ else
+ lineqt = lineq(1:iccount-1)//sq//'pmxlyr{'
+ * //lineq(iccount+1:i2nd-1)//'}'//sq
+ * //lineq(i2nd+1:128)
+ end if
+ i2nd = i2nd+8
+ lineq = lineqt
+ if (lineq(i2nd+1:i2nd+1) .eq. '@') then
+ lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq
+ * //lineq(i2nd+5:128)
+ lineq = lineqt
+ end if
+ return
+ end
+ subroutine inst2chan(midc,midi,midchan,nv,iinsiv,twoline)
+c propagate per-instrument quantities to per-channel ones
+ parameter (nm=24)
+ integer*4 midc(0:nm),midi(nm),midchan(nm,2)
+ integer*2 iinsiv(nm)
+ logical twoline(nm)
+ do iv = nv, 1, -1
+ if (twoline(iv)) then
+ midc(midchan(iv,2)) = midi(iinsiv(iv))
+ end if
+ midc(midchan(iv,1)) = midi(iinsiv(iv))
+ end do
+ end
+
+
diff --git a/Build/source/utils/pmx/pmx-src/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c
index 2ad12053934..0a697264a8a 100644
--- a/Build/source/utils/pmx/pmx-src/pmxab.c
+++ b/Build/source/utils/pmx/pmx-src/pmxab.c
@@ -906,6 +906,7 @@ static integer c__2 = 2;
static integer c__4 = 4;
static integer c__128 = 128;
static integer c__3 = 3;
+static integer c__47 = 47;
static logical c_true = TRUE_;
static logical c_false = FALSE_;
static integer c__92 = 92;
@@ -921,6 +922,7 @@ static integer c__7 = 7;
static integer c__22 = 22;
static integer c__0 = 0;
static integer c__27 = 27;
+static integer c__34 = 34;
static integer c__10 = 10;
static integer c__20 = 20;
static integer c__26 = 26;
@@ -942,18 +944,16 @@ static integer c__30 = 30;
static integer c__60 = 60;
static integer c__80 = 80;
static integer c__256 = 256;
-static integer c__34 = 34;
static integer c__120 = 120;
static integer c__240 = 240;
static integer c__255 = 255;
-static integer c__47 = 47;
/* Main program */ int MAIN__(void)
{
/* Initialized data */
- static char date[9] = "17 Mar 20";
- static char version[5] = "2.94 ";
+ static char date[9] = "12 Dec 21";
+ static char version[5] = "2.98 ";
static integer maxit = 200;
static integer ncalls = 0;
static logical isfirst = TRUE_;
@@ -962,7 +962,7 @@ static integer c__47 = 47;
address a__1[2], a__2[4], a__3[3];
integer i__1, i__2, i__3[2], i__4[4], i__5[3], i__6;
real r__1;
- char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[56];
+ char ch__1[48], ch__2[64], ch__3[37], ch__4[55], ch__5[1], ch__6[56];
olist o__1;
cllist cl__1;
inlist ioin__1;
@@ -987,6 +987,7 @@ static integer c__47 = 47;
static real poe[125];
static integer ivt, ivx;
static real poe0[125];
+ extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static integer ljob, ipoe[125];
extern /* Subroutine */ int pmxa_(char *, integer *, logical *, integer *,
integer *, logical *, ftnlen), pmxb_(logical *, real *, integer *
@@ -1105,6 +1106,14 @@ static integer c__47 = 47;
/* Forced line break without line number */
/* Fix dot moving when 2nds in chord get flipped */
/* To do: increase length on notexq in dodyn */
+/* 2.98 */
+/* Fix beaming in 6/2 time by setting mapfb(5) and (6) = 0 in make1bar(...) */
+/* 2.97 */
+/* Fix problem with beaming after new movement command */
+/* 2.96 and 2.95 */
+/* replace and '\','/'. and '"' with chax(); */
+/* eliminate do loops with shared last line */
+/* delete superfluous comments in source */
/* 2.94 */
/* Allow moving dots on main and chord note in 2-note termolos */
/* Add definitions of \hbp and \hbpp to pmx.tex */
@@ -1830,1018 +1839,1022 @@ static integer c__47 = 47;
/* cccccccccccccccccccccccc */
/* itstart = mytime() */
-#line 838 ""
+#line 847 ""
s_copy(comver_1.versionc, version, (ftnlen)5, (ftnlen)5);
/* Initialize midi parameters */
-#line 842 ""
+#line 851 ""
commmac_1.gottempo = FALSE_;
-#line 843 ""
+#line 852 ""
commidi_1.ismidi = FALSE_;
-#line 844 ""
+#line 853 ""
commidi_1.debugmidi = FALSE_;
-#line 845 ""
+#line 854 ""
commidi_1.relacc = FALSE_;
-#line 846 ""
+#line 855 ""
commmac_1.mmacrec = FALSE_;
-#line 847 ""
+#line 856 ""
commmac_1.nmidsec = 1;
-#line 848 ""
+#line 857 ""
commidi_1.mgap = 10;
-#line 849 ""
+#line 858 ""
comevent_1.miditime = 0;
-#line 850 ""
+#line 859 ""
comevent_1.lasttime = 0;
-#line 851 ""
+#line 860 ""
commidi_1.nmidcrd = 0;
-#line 852 ""
+#line 861 ""
comslm_1.nusebl = 0;
-#line 853 ""
+#line 862 ""
commidi_1.notmain = FALSE_;
-#line 854 ""
+#line 863 ""
for (ivx = 1; ivx <= 24; ++ivx) {
-#line 855 ""
+#line 864 ""
commidi_1.twoline[ivx - 1] = FALSE_;
-#line 856 ""
+#line 865 ""
commidi_1.midinst[ivx - 1] = 6;
-#line 857 ""
+#line 866 ""
commvel_1.midivel[ivx - 1] = 127;
-#line 858 ""
+#line 867 ""
commvel_1.midibal[ivx - 1] = 64;
-#line 859 ""
+#line 868 ""
commvel_1.miditran[ivx - 1] = 0;
-#line 860 ""
+#line 869 ""
/* L3: */
-#line 860 ""
+#line 869 ""
}
-#line 861 ""
+#line 870 ""
for (icm = 0; icm <= 24; ++icm) {
-#line 862 ""
+#line 871 ""
commidi_1.imidi[icm] = 0;
-#line 863 ""
+#line 872 ""
commidi_1.restpend[icm] = FALSE_;
-#line 864 ""
+#line 873 ""
commidi_1.trest[icm] = 0.f;
-#line 865 ""
+#line 874 ""
comslm_1.levson[icm] = 0;
-#line 866 ""
+#line 875 ""
comslm_1.levsoff[icm] = 0;
-#line 867 ""
+#line 876 ""
comslm_1.slmon[icm] = FALSE_;
-#line 868 ""
+#line 877 ""
comslm_1.naccbl[icm] = 0;
-#line 869 ""
+#line 878 ""
comdiag_1.n69[icm] = 0;
-#line 870 ""
+#line 879 ""
comdiag_1.n34[icm] = 0;
-#line 871 ""
+#line 880 ""
commmac_1.msecstrt[icm] = 1;
-#line 872 ""
+#line 881 ""
/* L12: */
-#line 872 ""
+#line 881 ""
}
/* End of midi parameter initialization */
-#line 876 ""
+#line 885 ""
commus_1.musize = 0;
-#line 877 ""
+#line 886 ""
optimize = FALSE_;
-#line 878 ""
+#line 887 ""
numargs = iargc_();
-#line 879 ""
+#line 888 ""
if (numargs == 0) {
-#line 880 ""
+#line 889 ""
s_wsle(&io___10);
-#line 880 ""
+#line 889 ""
do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
"d line,", (ftnlen)53);
-#line 880 ""
+#line 889 ""
e_wsle();
-#line 881 ""
+#line 890 ""
s_wsle(&io___11);
-#line 881 ""
+#line 890 ""
do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32);
-#line 881 ""
+#line 890 ""
e_wsle();
-#line 882 ""
+#line 891 ""
s_rsfe(&io___12);
-#line 882 ""
+#line 891 ""
do_fio(&c__1, jobname, (ftnlen)44);
-#line 882 ""
+#line 891 ""
e_rsfe();
-#line 883 ""
+#line 892 ""
numargs = 1;
-#line 884 ""
+#line 893 ""
} else {
/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */
-#line 886 ""
+#line 895 ""
getarg_(&c__1, jobname, (ftnlen)44);
-#line 887 ""
+#line 896 ""
}
-#line 888 ""
+#line 897 ""
L10:
-#line 888 ""
+#line 897 ""
ljob = lenstr_(jobname, &c__44, (ftnlen)44);
-#line 889 ""
+#line 898 ""
if (ljob > 44) {
-#line 890 ""
+#line 899 ""
s_wsle(&io___15);
-#line 890 ""
+#line 899 ""
do_lio(&c__9, &c__1, "Jobname is too long. Try again.", (ftnlen)31);
-#line 890 ""
+#line 899 ""
e_wsle();
-#line 891 ""
+#line 900 ""
stop1_();
-#line 892 ""
+#line 901 ""
} else if (ljob == 0) {
-#line 893 ""
+#line 902 ""
s_wsle(&io___16);
-#line 893 ""
+#line 902 ""
do_lio(&c__9, &c__1, "No was jobname entered. Try again.", (ftnlen)34)
;
-#line 893 ""
+#line 902 ""
e_wsle();
-#line 894 ""
+#line 903 ""
stop1_();
-#line 895 ""
+#line 904 ""
} else if (numargs == 2) {
-#line 896 ""
+#line 905 ""
if (ljob == 2 && s_cmp(jobname, "-o", (ftnlen)2, (ftnlen)2) == 0) {
-#line 897 ""
+#line 906 ""
optimize = TRUE_;
/* call getarg(2,jobname,idum) ! May need to replace this w/ next line */
-#line 899 ""
+#line 908 ""
getarg_(&c__2, jobname, (ftnlen)44);
-#line 900 ""
+#line 909 ""
numargs = 1;
-#line 901 ""
+#line 910 ""
goto L10;
-#line 902 ""
+#line 911 ""
} else {
-#line 903 ""
+#line 912 ""
s_wsle(&io___17);
-#line 903 ""
+#line 912 ""
do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30)
;
-#line 903 ""
+#line 912 ""
e_wsle();
-#line 904 ""
+#line 913 ""
stop1_();
-#line 905 ""
+#line 914 ""
}
-#line 906 ""
+#line 915 ""
}
/* Strip ".pmx" if necessary */
/* Computing MAX */
-#line 910 ""
+#line 919 ""
i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx(
jobname, ".PMX", (ftnlen)44, (ftnlen)4);
-#line 910 ""
+#line 919 ""
ndxpmx = max(i__1,i__2);
-#line 911 ""
+#line 920 ""
if (ndxpmx > 0) {
-#line 912 ""
+#line 921 ""
s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1);
-#line 913 ""
+#line 922 ""
ljob += -4;
-#line 914 ""
+#line 923 ""
}
/* Check for existence of input file */
/* Writing concatenation */
-#line 918 ""
+#line 927 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 918 ""
+#line 927 ""
i__3[1] = 4, a__1[1] = ".pmx";
-#line 918 ""
+#line 927 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
-#line 919 ""
+#line 928 ""
ioin__1.inerr = 0;
-#line 919 ""
+#line 928 ""
ioin__1.infilen = 47;
-#line 919 ""
+#line 928 ""
ioin__1.infile = infileq;
-#line 919 ""
+#line 928 ""
ioin__1.inex = &fexist;
-#line 919 ""
+#line 928 ""
ioin__1.inopen = 0;
-#line 919 ""
+#line 928 ""
ioin__1.innum = 0;
-#line 919 ""
+#line 928 ""
ioin__1.innamed = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inname = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inacc = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inseq = 0;
-#line 919 ""
+#line 928 ""
ioin__1.indir = 0;
-#line 919 ""
+#line 928 ""
ioin__1.infmt = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inform = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inunf = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inrecl = 0;
-#line 919 ""
+#line 928 ""
ioin__1.innrec = 0;
-#line 919 ""
+#line 928 ""
ioin__1.inblank = 0;
-#line 919 ""
+#line 928 ""
f_inqu(&ioin__1);
-#line 920 ""
+#line 929 ""
if (! fexist) {
-#line 921 ""
+#line 930 ""
ioin__1.inerr = 0;
-#line 921 ""
+#line 930 ""
ioin__1.infilen = ljob + 4;
/* Writing concatenation */
-#line 921 ""
+#line 930 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 921 ""
+#line 930 ""
i__3[1] = 4, a__1[1] = ".PMX";
-#line 921 ""
+#line 930 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
-#line 921 ""
+#line 930 ""
ioin__1.infile = ch__1;
-#line 921 ""
+#line 930 ""
ioin__1.inex = &fexist;
-#line 921 ""
+#line 930 ""
ioin__1.inopen = 0;
-#line 921 ""
+#line 930 ""
ioin__1.innum = 0;
-#line 921 ""
+#line 930 ""
ioin__1.innamed = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inname = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inacc = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inseq = 0;
-#line 921 ""
+#line 930 ""
ioin__1.indir = 0;
-#line 921 ""
+#line 930 ""
ioin__1.infmt = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inform = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inunf = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inrecl = 0;
-#line 921 ""
+#line 930 ""
ioin__1.innrec = 0;
-#line 921 ""
+#line 930 ""
ioin__1.inblank = 0;
-#line 921 ""
+#line 930 ""
f_inqu(&ioin__1);
-#line 922 ""
+#line 931 ""
if (! fexist) {
-#line 923 ""
+#line 932 ""
s_wsle(&io___21);
/* Writing concatenation */
-#line 923 ""
+#line 932 ""
i__3[0] = 17, a__1[0] = "Cannot find file ";
-#line 923 ""
+#line 932 ""
i__3[1] = 47, a__1[1] = infileq;
-#line 923 ""
+#line 932 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64);
-#line 923 ""
+#line 932 ""
do_lio(&c__9, &c__1, ch__2, (ftnlen)64);
-#line 923 ""
+#line 932 ""
e_wsle();
-#line 924 ""
+#line 933 ""
stop1_();
-#line 925 ""
+#line 934 ""
} else {
/* Writing concatenation */
-#line 926 ""
+#line 935 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 926 ""
+#line 935 ""
i__3[1] = 4, a__1[1] = ".PMX";
-#line 926 ""
+#line 935 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47);
-#line 927 ""
+#line 936 ""
}
-#line 928 ""
+#line 937 ""
}
/* Open a log file */
-#line 932 ""
+#line 941 ""
o__1.oerr = 0;
-#line 932 ""
+#line 941 ""
o__1.ounit = 15;
-#line 932 ""
+#line 941 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
-#line 932 ""
+#line 941 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 932 ""
+#line 941 ""
i__3[1] = 4, a__1[1] = ".pml";
-#line 932 ""
+#line 941 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
-#line 932 ""
+#line 941 ""
o__1.ofnm = ch__1;
-#line 932 ""
+#line 941 ""
o__1.orl = 0;
-#line 932 ""
+#line 941 ""
o__1.osta = 0;
-#line 932 ""
+#line 941 ""
o__1.oacc = 0;
-#line 932 ""
+#line 941 ""
o__1.ofm = 0;
-#line 932 ""
+#line 941 ""
o__1.oblnk = 0;
-#line 932 ""
+#line 941 ""
f_open(&o__1);
/* Writing concatenation */
-#line 933 ""
+#line 942 ""
i__4[0] = 21, a__2[0] = "This is PMX, Version ";
-#line 933 ""
+#line 942 ""
i__4[1] = 5, a__2[1] = version;
-#line 933 ""
+#line 942 ""
i__4[2] = 2, a__2[2] = ", ";
-#line 933 ""
+#line 942 ""
i__4[3] = 9, a__2[3] = date;
-#line 933 ""
+#line 942 ""
s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37);
-#line 933 ""
+#line 942 ""
printl_(ch__3, (ftnlen)37);
-#line 934 ""
+#line 943 ""
ljob4 = ljob;
/* Writing concatenation */
-#line 935 ""
+#line 944 ""
i__3[0] = 8, a__1[0] = "Opening ";
-#line 935 ""
+#line 944 ""
i__3[1] = 47, a__1[1] = infileq;
-#line 935 ""
+#line 944 ""
s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55);
-#line 935 ""
+#line 944 ""
printl_(ch__4, (ftnlen)55);
-#line 936 ""
+#line 945 ""
o__1.oerr = 0;
-#line 936 ""
+#line 945 ""
o__1.ounit = 18;
-#line 936 ""
+#line 945 ""
o__1.ofnmlen = 47;
-#line 936 ""
+#line 945 ""
o__1.ofnm = infileq;
-#line 936 ""
+#line 945 ""
o__1.orl = 0;
-#line 936 ""
+#line 945 ""
o__1.osta = 0;
-#line 936 ""
+#line 945 ""
o__1.oacc = 0;
-#line 936 ""
+#line 945 ""
o__1.ofm = 0;
-#line 936 ""
+#line 945 ""
o__1.oblnk = 0;
-#line 936 ""
+#line 945 ""
f_open(&o__1);
/* Copy input file into common buffer */
-#line 940 ""
+#line 949 ""
inbuff_1.ipbuf = 0;
-#line 941 ""
+#line 950 ""
truelinecount_1.linewcom[0] = 1;
-#line 942 ""
+#line 951 ""
for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 9600; ++inbuff_1.ilbuf) {
-#line 943 ""
+#line 952 ""
ncomments = 0;
-#line 944 ""
+#line 953 ""
L14:
-#line 944 ""
+#line 953 ""
i__1 = s_rsfe(&io___24);
-#line 944 ""
+#line 953 ""
if (i__1 != 0) {
-#line 944 ""
+#line 953 ""
goto L9;
-#line 944 ""
+#line 953 ""
}
-#line 944 ""
+#line 953 ""
i__1 = do_fio(&c__1, lnholdq, (ftnlen)128);
-#line 944 ""
+#line 953 ""
if (i__1 != 0) {
-#line 944 ""
+#line 953 ""
goto L9;
-#line 944 ""
+#line 953 ""
}
-#line 944 ""
+#line 953 ""
i__1 = e_rsfe();
-#line 944 ""
+#line 953 ""
if (i__1 != 0) {
-#line 944 ""
+#line 953 ""
goto L9;
-#line 944 ""
+#line 953 ""
}
-#line 945 ""
+#line 954 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, &
c__128, (ftnlen)128);
-#line 946 ""
+#line 955 ""
if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) {
/* Blank line. Make it a single blank with length 1 */
-#line 950 ""
+#line 959 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1;
-#line 951 ""
+#line 960 ""
s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
-#line 952 ""
+#line 961 ""
}
/* Now line has at least one non blank character. Check for comment */
/* As of Version 260, do not copy comments into bufq */
/* But need to count %'s for error messaging */
/* if (lnholdq(1:1).eq.'%') go to 14 */
-#line 958 ""
+#line 967 ""
if (*(unsigned char *)lnholdq == '%') {
-#line 959 ""
+#line 968 ""
++ncomments;
-#line 960 ""
+#line 969 ""
goto L14;
-#line 961 ""
+#line 970 ""
}
/* When here, have counted all preceding comments and have a real line */
-#line 965 ""
+#line 974 ""
if (inbuff_1.ilbuf > 1) {
-#line 966 ""
+#line 975 ""
truelinecount_1.linewcom[inbuff_1.ilbuf - 1] =
truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 +
ncomments;
-#line 967 ""
+#line 976 ""
} else {
-#line 968 ""
+#line 977 ""
truelinecount_1.linewcom[0] = ncomments + 1;
-#line 969 ""
+#line 978 ""
}
-#line 970 ""
+#line 979 ""
if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 131072) {
-#line 971 ""
+#line 980 ""
s_wsle(&io___26);
-#line 971 ""
+#line 980 ""
do_lio(&c__9, &c__1, "Too many characters in file, stopping", (
ftnlen)37);
-#line 971 ""
+#line 980 ""
e_wsle();
-#line 972 ""
+#line 981 ""
stop1_();
-#line 973 ""
+#line 982 ""
}
-#line 974 ""
+#line 983 ""
i__1 = inbuff_1.ipbuf;
-#line 974 ""
+#line 983 ""
s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[
inbuff_1.ilbuf - 1] - i__1, (ftnlen)128);
-#line 975 ""
+#line 984 ""
inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
-#line 976 ""
+#line 985 ""
/* L8: */
-#line 976 ""
+#line 985 ""
}
-#line 977 ""
+#line 986 ""
printl_("Too many lines in input file", (ftnlen)28);
-#line 978 ""
+#line 987 ""
stop1_();
-#line 979 ""
+#line 988 ""
L9:
/* Insert dummy line to handle input files w/o CR-LF at end. */
-#line 983 ""
+#line 992 ""
inbuff_1.nlbuf = inbuff_1.ilbuf - 1;
/* nlbuf = ilbuf */
/* bufq(ipbuf+1:ipbuf+3) = ' / ' */
/* lbuf(nlbuf) = 3 */
-#line 987 ""
+#line 996 ""
cl__1.cerr = 0;
-#line 987 ""
+#line 996 ""
cl__1.cunit = 18;
-#line 987 ""
+#line 996 ""
cl__1.csta = 0;
-#line 987 ""
+#line 996 ""
f_clos(&cl__1);
-#line 988 ""
+#line 997 ""
i__1 = maxit;
-#line 988 ""
+#line 997 ""
for (numit = 1; numit <= i__1; ++numit) {
-#line 989 ""
+#line 998 ""
if (optimize) {
-#line 989 ""
+#line 998 ""
printl_("Starting an iteration", (ftnlen)21);
-#line 989 ""
+#line 998 ""
}
/* When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */
/* Otherwise, nbars0 is the input */
/* When islast=.false., pmxb only returns poe's, otherwise does whole job */
-#line 995 ""
+#line 1004 ""
pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen)
44);
-#line 996 ""
+#line 1005 ""
if (! optimize) {
-#line 997 ""
+#line 1006 ""
if (commidi_1.ismidi) {
/* This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */
/* set up here as functions of instrument rather than iv (staff). */
/* Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */
-#line 1003 ""
+#line 1012 ""
nstaves = 0;
-#line 1004 ""
+#line 1013 ""
ivt = 0;
-#line 1005 ""
+#line 1014 ""
for (iinst = 1; iinst <= 24; ++iinst) {
-#line 1006 ""
+#line 1015 ""
nstaves += c1omget_1.nsperi[iinst - 1];
-#line 1007 ""
+#line 1016 ""
i__2 = c1omget_1.nsperi[iinst - 1];
-#line 1007 ""
+#line 1016 ""
for (ivtt = 1; ivtt <= i__2; ++ivtt) {
-#line 1008 ""
+#line 1017 ""
++ivt;
-#line 1009 ""
+#line 1018 ""
commvel_1.iinsiv[ivt - 1] = (shortint) iinst;
-#line 1010 ""
+#line 1019 ""
/* L17: */
-#line 1010 ""
+#line 1019 ""
}
-#line 1011 ""
+#line 1020 ""
if (nstaves == a1ll_1.nv) {
-#line 1011 ""
+#line 1020 ""
goto L18;
-#line 1011 ""
+#line 1020 ""
}
-#line 1012 ""
+#line 1021 ""
/* L16: */
-#line 1012 ""
+#line 1021 ""
}
-#line 1013 ""
+#line 1022 ""
s_wsle(&io___34);
-#line 1013 ""
+#line 1022 ""
do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8);
-#line 1013 ""
+#line 1022 ""
e_wsle();
-#line 1014 ""
+#line 1023 ""
stop1_();
-#line 1015 ""
+#line 1024 ""
L18:
/* Set up channel numbers for midi. */
-#line 1019 ""
+#line 1028 ""
commidi_1.numchan = 0;
-#line 1020 ""
+#line 1029 ""
for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
-#line 1021 ""
+#line 1030 ""
if (commidi_1.twoline[a1ll_1.iv - 1]) {
-#line 1022 ""
+#line 1031 ""
commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan;
-#line 1023 ""
+#line 1032 ""
++commidi_1.numchan;
-#line 1024 ""
+#line 1033 ""
}
-#line 1025 ""
+#line 1034 ""
commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan;
-#line 1026 ""
+#line 1035 ""
++commidi_1.numchan;
-#line 1027 ""
+#line 1036 ""
/* L11: */
-#line 1027 ""
+#line 1036 ""
}
/* numchan will now be the number of channels, but max channel # is numchan-1 */
/* Set up velocities, balances, and midi-transpositions */
-#line 1033 ""
+#line 1042 ""
for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) {
-#line 1034 ""
+#line 1043 ""
if (commidi_1.twoline[a1ll_1.iv - 1]) {
/* 130302 Make these functions of instrument rather than staff (iv) */
-/* midvelc(midchan(iv,2)) = midivel(iv) */
-/* midbc(midchan(iv,2)) = midibal(iv) */
-/* midtc(midchan(iv,2)) = miditran(iv) */
-#line 1039 ""
+#line 1045 ""
commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
-#line 1040 ""
+#line 1046 ""
commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
-#line 1041 ""
+#line 1047 ""
commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] =
commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv
- 1] - 1];
-#line 1042 ""
+#line 1048 ""
}
-/* midvelc(midchan(iv,1)) = midivel(iv) */
-/* midbc(midchan(iv,1)) = midibal(iv) */
-/* midtc(midchan(iv,1)) = miditran(iv) */
-#line 1046 ""
+#line 1049 ""
commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
-#line 1047 ""
+#line 1050 ""
commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
-#line 1048 ""
+#line 1051 ""
commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] =
commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1]
- 1];
-#line 1049 ""
+#line 1052 ""
/* L13: */
-#line 1049 ""
+#line 1052 ""
}
-#line 1050 ""
+#line 1053 ""
}
/* TEMPORARY!!! */
-#line 1054 ""
+#line 1057 ""
s_wsle(&io___35);
-#line 1054 ""
+#line 1057 ""
do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
-#line 1054 ""
+#line 1057 ""
do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(
integer));
-#line 1054 ""
+#line 1057 ""
e_wsle();
-#line 1055 ""
+#line 1058 ""
ip1 = 1;
-#line 1056 ""
+#line 1059 ""
i__2 = inbuff_1.nlbuf;
-#line 1056 ""
+#line 1059 ""
for (ilb = 1; ilb <= i__2; ++ilb) {
-/* write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */
-/* * bufq(ip1:ip1+lbuf(ilb)-1), */
-/* * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */
-/* * k=min(3,lbuf(ilb)),1,-1) */
-#line 1061 ""
+#line 1060 ""
ip1 += inbuff_1.lbuf[ilb - 1];
-#line 1062 ""
+#line 1061 ""
/* L10000: */
-#line 1062 ""
+#line 1061 ""
}
-#line 1063 ""
+#line 1062 ""
iplast = ip1 - 1;
/* Check to see if (1) last line is "<blank><blank>/" and (2) next to last */
/* line is "/" */
-#line 1068 ""
+#line 1067 ""
i__2 = iplast + 1 - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
-#line 1068 ""
+#line 1067 ""
if (s_cmp(inbuff_1.bufq + i__2, " /", iplast - i__2, (ftnlen)3)
== 0) {
-#line 1069 ""
+#line 1068 ""
i__2 = iplast - inbuff_1.lbuf[inbuff_1.nlbuf - 1] - 1;
-#line 1069 ""
- if (s_cmp(inbuff_1.bufq + i__2, "/", iplast - inbuff_1.lbuf[
+#line 1068 ""
+ chax_(ch__5, (ftnlen)1, &c__47);
+#line 1068 ""
+ if (s_cmp(inbuff_1.bufq + i__2, ch__5, iplast - inbuff_1.lbuf[
inbuff_1.nlbuf - 1] - i__2, (ftnlen)1) == 0) {
-#line 1070 ""
+#line 1069 ""
s_wsle(&io___39);
-#line 1070 ""
+#line 1069 ""
do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
"ank>/\"", (ftnlen)39);
-#line 1070 ""
+#line 1069 ""
e_wsle();
-#line 1071 ""
+#line 1070 ""
s_wsle(&io___40);
-#line 1071 ""
+#line 1070 ""
do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\
"ank>/\"", (ftnlen)39);
-#line 1071 ""
+#line 1070 ""
e_wsle();
-#line 1072 ""
+#line 1071 ""
--inbuff_1.nlbuf;
-#line 1073 ""
+#line 1072 ""
}
-#line 1074 ""
+#line 1073 ""
}
-#line 1076 ""
+#line 1075 ""
pmxb_(&c_true, poe0, &ncalls, &optimize);
-#line 1077 ""
+#line 1076 ""
if (commidi_1.ismidi) {
/* Write midi file */
-#line 1081 ""
+#line 1080 ""
o__1.oerr = 0;
-#line 1081 ""
+#line 1080 ""
o__1.ounit = 51;
-#line 1081 ""
+#line 1080 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
-#line 1081 ""
+#line 1080 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 1081 ""
+#line 1080 ""
i__3[1] = 4, a__1[1] = ".mid";
-#line 1081 ""
+#line 1080 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
-#line 1081 ""
+#line 1080 ""
o__1.ofnm = ch__1;
-#line 1081 ""
+#line 1080 ""
o__1.orl = 0;
-#line 1081 ""
+#line 1080 ""
o__1.osta = 0;
-#line 1081 ""
+#line 1080 ""
o__1.oacc = 0;
-#line 1081 ""
+#line 1080 ""
o__1.ofm = 0;
-#line 1081 ""
+#line 1080 ""
o__1.oblnk = 0;
-#line 1081 ""
+#line 1080 ""
f_open(&o__1);
-#line 1082 ""
+#line 1081 ""
if (commidi_1.debugmidi) {
-#line 1082 ""
+#line 1081 ""
o__1.oerr = 0;
-#line 1082 ""
+#line 1081 ""
o__1.ounit = 52;
-#line 1082 ""
+#line 1081 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
-#line 1082 ""
+#line 1081 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 1082 ""
+#line 1081 ""
i__3[1] = 4, a__1[1] = ".dbm";
-#line 1082 ""
+#line 1081 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48);
-#line 1082 ""
+#line 1081 ""
o__1.ofnm = ch__1;
-#line 1082 ""
+#line 1081 ""
o__1.orl = 0;
-#line 1082 ""
+#line 1081 ""
o__1.osta = 0;
-#line 1082 ""
+#line 1081 ""
o__1.oacc = 0;
-#line 1082 ""
+#line 1081 ""
o__1.ofm = 0;
-#line 1082 ""
+#line 1081 ""
o__1.oblnk = 0;
-#line 1082 ""
+#line 1081 ""
f_open(&o__1);
-#line 1082 ""
+#line 1081 ""
}
-#line 1083 ""
+#line 1082 ""
printl_(" ", (ftnlen)1);
/* Writing concatenation */
-#line 1084 ""
+#line 1083 ""
i__5[0] = 8, a__3[0] = "Writing ";
-#line 1084 ""
+#line 1083 ""
i__5[1] = ljob, a__3[1] = jobname;
-#line 1084 ""
+#line 1083 ""
i__5[2] = 4, a__3[2] = ".mid";
+#line 1083 ""
+ s_cat(ch__6, a__3, i__5, &c__3, (ftnlen)56);
+#line 1083 ""
+ printl_(ch__6, ljob + 12);
#line 1084 ""
- s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56);
-#line 1084 ""
- printl_(ch__5, ljob + 12);
-#line 1085 ""
writemidi_(jobname, &ljob, (ftnlen)44);
-#line 1086 ""
+#line 1085 ""
}
-#line 1087 ""
+#line 1086 ""
cl__1.cerr = 0;
-#line 1087 ""
+#line 1086 ""
cl__1.cunit = 15;
-#line 1087 ""
+#line 1086 ""
cl__1.csta = 0;
-#line 1087 ""
+#line 1086 ""
f_clos(&cl__1);
-#line 1088 ""
+#line 1087 ""
s_stop("", (ftnlen)0);
-#line 1089 ""
+#line 1088 ""
}
-#line 1090 ""
+#line 1089 ""
s_wsle(&io___42);
-#line 1090 ""
+#line 1089 ""
do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7);
-#line 1090 ""
+#line 1089 ""
do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer))
;
-#line 1090 ""
+#line 1089 ""
e_wsle();
-#line 1091 ""
+#line 1090 ""
ip1 = 1;
-#line 1092 ""
+#line 1091 ""
pmxb_(&c_false, poe0, &ncalls, &optimize);
-#line 1093 ""
+#line 1092 ""
poestats_(&nsyst, poe0, &poebar0, &devnorm0);
/* Save initial deviation and line breaks for later comparison */
-#line 1097 ""
+#line 1096 ""
if (numit == 1) {
-#line 1098 ""
+#line 1097 ""
devpmx = devnorm0;
-#line 1099 ""
+#line 1098 ""
i__2 = nsyst;
-#line 1099 ""
+#line 1098 ""
for (isys = 1; isys <= i__2; ++isys) {
-#line 1100 ""
+#line 1099 ""
nbari[isys - 1] = nbars0[isys - 1];
-#line 1101 ""
+#line 1100 ""
/* L20: */
-#line 1101 ""
+#line 1100 ""
}
-#line 1102 ""
+#line 1101 ""
}
-#line 1103 ""
+#line 1102 ""
sortpoe_(&nsyst, poe0, ipoe);
-#line 1104 ""
+#line 1103 ""
for (iupord = nsyst; iupord >= 1; --iupord) {
-#line 1105 ""
+#line 1104 ""
isysu = ipoe[iupord - 1];
-#line 1106 ""
+#line 1105 ""
s_wsle(&io___51);
-#line 1106 ""
+#line 1105 ""
do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
-#line 1106 ""
+#line 1105 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
-#line 1106 ""
+#line 1105 ""
e_wsle();
-#line 1107 ""
+#line 1106 ""
s_wsle(&io___52);
-#line 1107 ""
+#line 1106 ""
do_lio(&c__9, &c__1, "isysu=", (ftnlen)6);
-#line 1107 ""
+#line 1106 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer));
-#line 1107 ""
+#line 1106 ""
e_wsle();
/* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */
-#line 1111 ""
+#line 1110 ""
if (poe0[isysu - 1] < poebar0) {
-#line 1111 ""
+#line 1110 ""
goto L1;
-#line 1111 ""
+#line 1110 ""
}
-#line 1112 ""
+#line 1111 ""
i__2 = nsyst;
-#line 1112 ""
+#line 1111 ""
for (idnord = 1; idnord <= i__2; ++idnord) {
-#line 1113 ""
+#line 1112 ""
isysd = ipoe[idnord - 1];
-#line 1114 ""
+#line 1113 ""
if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd -
1] > poebar0) {
-#line 1114 ""
+#line 1113 ""
goto L5;
-#line 1114 ""
+#line 1113 ""
}
-#line 1116 ""
+#line 1115 ""
i__6 = nsyst;
-#line 1116 ""
+#line 1115 ""
for (isyst = 1; isyst <= i__6; ++isyst) {
-#line 1117 ""
+#line 1116 ""
nbars[isyst - 1] = nbars0[isyst - 1];
-#line 1118 ""
+#line 1117 ""
if (isyst == isysu) {
-#line 1119 ""
+#line 1118 ""
++nbars[isyst - 1];
-#line 1120 ""
+#line 1119 ""
} else if (isyst == isysd) {
-#line 1121 ""
+#line 1120 ""
--nbars[isyst - 1];
-#line 1122 ""
+#line 1121 ""
}
-#line 1123 ""
+#line 1122 ""
/* L2: */
-#line 1123 ""
+#line 1122 ""
}
-#line 1124 ""
+#line 1123 ""
pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, (
ftnlen)44);
-#line 1125 ""
+#line 1124 ""
pmxb_(&c_false, poe, &ncalls, &optimize);
-#line 1126 ""
+#line 1125 ""
poestats_(&nsyst, poe, &poebar, &devnorm);
-#line 1127 ""
+#line 1126 ""
if (devnorm < devnorm0) {
-#line 1128 ""
+#line 1127 ""
devnorm0 = devnorm;
-#line 1129 ""
+#line 1128 ""
poebar0 = poebar;
-#line 1130 ""
+#line 1129 ""
i__6 = nsyst;
-#line 1130 ""
+#line 1129 ""
for (isys = 1; isys <= i__6; ++isys) {
-#line 1131 ""
+#line 1130 ""
nbars0[isys - 1] = nbars[isys - 1];
-#line 1132 ""
+#line 1131 ""
poe0[isys - 1] = poe[isys - 1];
-#line 1133 ""
+#line 1132 ""
/* L4: */
-#line 1133 ""
+#line 1132 ""
}
-#line 1134 ""
+#line 1133 ""
s_wsle(&io___60);
-#line 1134 ""
+#line 1133 ""
do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
ftnlen)32);
-#line 1134 ""
+#line 1133 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
integer));
-#line 1134 ""
+#line 1133 ""
do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
integer));
-#line 1134 ""
+#line 1133 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
real));
-#line 1134 ""
+#line 1133 ""
e_wsle();
-#line 1136 ""
+#line 1135 ""
s_wsle(&io___61);
-#line 1136 ""
+#line 1135 ""
do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", (
ftnlen)32);
-#line 1136 ""
+#line 1135 ""
do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(
integer));
-#line 1136 ""
+#line 1135 ""
do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof(
integer));
-#line 1136 ""
+#line 1135 ""
do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(
real));
-#line 1136 ""
+#line 1135 ""
e_wsle();
-#line 1138 ""
+#line 1137 ""
s_wsfe(&io___62);
-#line 1138 ""
+#line 1137 ""
i__6 = nsyst;
-#line 1138 ""
+#line 1137 ""
for (isys = 1; isys <= i__6; ++isys) {
-#line 1138 ""
+#line 1137 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
sizeof(integer));
-#line 1138 ""
+#line 1137 ""
}
-#line 1138 ""
+#line 1137 ""
e_wsfe();
-#line 1139 ""
+#line 1138 ""
s_wsfe(&io___63);
-#line 1139 ""
+#line 1138 ""
i__6 = nsyst;
-#line 1139 ""
+#line 1138 ""
for (isys = 1; isys <= i__6; ++isys) {
-#line 1139 ""
+#line 1138 ""
do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)
sizeof(integer));
-#line 1139 ""
+#line 1138 ""
}
-#line 1139 ""
+#line 1138 ""
e_wsfe();
-#line 1140 ""
+#line 1139 ""
sortpoe_(&nsyst, poe0, ipoe);
-#line 1141 ""
+#line 1140 ""
goto L6;
-#line 1142 ""
+#line 1141 ""
}
-#line 1143 ""
+#line 1142 ""
L5:
-#line 1143 ""
+#line 1142 ""
;
-#line 1143 ""
+#line 1142 ""
}
-#line 1144 ""
+#line 1143 ""
L1:
-#line 1144 ""
+#line 1143 ""
;
-#line 1144 ""
+#line 1143 ""
}
/* If we get here, must have gone thru all switches and found nothing better, */
/* so done! */
-#line 1149 ""
+#line 1148 ""
goto L7;
-#line 1150 ""
+#line 1149 ""
L6:
-#line 1150 ""
+#line 1149 ""
;
-#line 1150 ""
+#line 1149 ""
}
-#line 1151 ""
+#line 1150 ""
L7:
-#line 1152 ""
+#line 1151 ""
s_wsle(&io___64);
+#line 1151 ""
+ do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
+#line 1151 ""
+ do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
+#line 1151 ""
+ do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
+#line 1151 ""
+ do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
+#line 1151 ""
+ e_wsle();
+#line 1152 ""
+ s_wsle(&io___65);
#line 1152 ""
do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
#line 1152 ""
@@ -2853,19 +2866,19 @@ L7:
#line 1152 ""
e_wsle();
#line 1153 ""
- s_wsle(&io___65);
+ s_wsle(&io___66);
#line 1153 ""
- do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23);
+ do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
#line 1153 ""
- do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer));
+ do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
#line 1153 ""
- do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10);
+ do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
#line 1153 ""
- do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer));
+ do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
#line 1153 ""
e_wsle();
#line 1154 ""
- s_wsle(&io___66);
+ s_wsle(&io___67);
#line 1154 ""
do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
#line 1154 ""
@@ -2877,19 +2890,17 @@ L7:
#line 1154 ""
e_wsle();
#line 1155 ""
- s_wsle(&io___67);
-#line 1155 ""
- do_lio(&c__9, &c__1, "Final error:", (ftnlen)12);
+ s_wsle(&io___68);
#line 1155 ""
- do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real));
+ do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
#line 1155 ""
- do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16);
+ r__1 = (1 - devnorm0 / devpmx) * 100.f;
#line 1155 ""
- do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real));
+ do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
#line 1155 ""
e_wsle();
#line 1156 ""
- s_wsle(&io___68);
+ s_wsle(&io___69);
#line 1156 ""
do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
#line 1156 ""
@@ -2899,19 +2910,21 @@ L7:
#line 1156 ""
e_wsle();
#line 1157 ""
- s_wsle(&io___69);
-#line 1157 ""
- do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23);
-#line 1157 ""
- r__1 = (1 - devnorm0 / devpmx) * 100.f;
-#line 1157 ""
- do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 1157 ""
- e_wsle();
-#line 1158 ""
printl_("Initial bars/system:", (ftnlen)20);
-#line 1159 ""
+#line 1158 ""
s_wsfe(&io___70);
+#line 1158 ""
+ i__1 = nsyst;
+#line 1158 ""
+ for (isys = 1; isys <= i__1; ++isys) {
+#line 1158 ""
+ do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
+#line 1158 ""
+ }
+#line 1158 ""
+ e_wsfe();
+#line 1159 ""
+ s_wsfe(&io___71);
#line 1159 ""
i__1 = nsyst;
#line 1159 ""
@@ -2923,21 +2936,21 @@ L7:
#line 1159 ""
e_wsfe();
#line 1160 ""
- s_wsfe(&io___71);
-#line 1160 ""
+ printl_("Final bars/system:", (ftnlen)18);
+#line 1161 ""
+ s_wsfe(&io___72);
+#line 1161 ""
i__1 = nsyst;
-#line 1160 ""
+#line 1161 ""
for (isys = 1; isys <= i__1; ++isys) {
-#line 1160 ""
- do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer));
-#line 1160 ""
+#line 1161 ""
+ do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
+#line 1161 ""
}
-#line 1160 ""
- e_wsfe();
#line 1161 ""
- printl_("Final bars/system:", (ftnlen)18);
+ e_wsfe();
#line 1162 ""
- s_wsfe(&io___72);
+ s_wsfe(&io___73);
#line 1162 ""
i__1 = nsyst;
#line 1162 ""
@@ -2949,30 +2962,18 @@ L7:
#line 1162 ""
e_wsfe();
#line 1163 ""
- s_wsfe(&io___73);
-#line 1163 ""
- i__1 = nsyst;
-#line 1163 ""
- for (isys = 1; isys <= i__1; ++isys) {
-#line 1163 ""
- do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer));
-#line 1163 ""
- }
-#line 1163 ""
- e_wsfe();
-#line 1164 ""
pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44);
-#line 1165 ""
+#line 1164 ""
pmxb_(&c_true, poe0, &ncalls, &optimize);
-#line 1166 ""
+#line 1165 ""
cl__1.cerr = 0;
-#line 1166 ""
+#line 1165 ""
cl__1.cunit = 15;
-#line 1166 ""
+#line 1165 ""
cl__1.csta = 0;
-#line 1166 ""
+#line 1165 ""
f_clos(&cl__1);
-#line 1167 ""
+#line 1166 ""
return 0;
} /* MAIN__ */
@@ -2991,51 +2992,51 @@ L7:
static cilist io___75 = { 0, 6, 0, 0, 0 };
-#line 1170 ""
+#line 1169 ""
iacc = *nacc & 7;
-#line 1171 ""
+#line 1170 ""
if (iacc == 1) {
-#line 1172 ""
+#line 1171 ""
s_copy(acsymq, "fl", (ftnlen)3, (ftnlen)2);
-#line 1173 ""
+#line 1172 ""
*lacc = 2;
-#line 1174 ""
+#line 1173 ""
} else if (iacc == 2) {
-#line 1175 ""
+#line 1174 ""
s_copy(acsymq, "sh", (ftnlen)3, (ftnlen)2);
-#line 1176 ""
+#line 1175 ""
*lacc = 2;
-#line 1177 ""
+#line 1176 ""
} else if (iacc == 3) {
-#line 1178 ""
+#line 1177 ""
s_copy(acsymq, "na", (ftnlen)3, (ftnlen)2);
-#line 1179 ""
+#line 1178 ""
*lacc = 2;
-#line 1180 ""
+#line 1179 ""
} else if (iacc == 5) {
-#line 1181 ""
+#line 1180 ""
s_copy(acsymq, "dfl", (ftnlen)3, (ftnlen)3);
-#line 1182 ""
+#line 1181 ""
*lacc = 3;
-#line 1183 ""
+#line 1182 ""
} else if (iacc == 6) {
-#line 1184 ""
+#line 1183 ""
s_copy(acsymq, "dsh", (ftnlen)3, (ftnlen)3);
-#line 1185 ""
+#line 1184 ""
*lacc = 3;
-#line 1186 ""
+#line 1185 ""
} else {
-#line 1187 ""
+#line 1186 ""
s_wsle(&io___75);
-#line 1187 ""
+#line 1186 ""
do_lio(&c__9, &c__1, "bad accidental: ", (ftnlen)16);
-#line 1187 ""
+#line 1186 ""
do_lio(&c__3, &c__1, (char *)&iacc, (ftnlen)sizeof(integer));
-#line 1187 ""
+#line 1186 ""
e_wsle();
-#line 1188 ""
+#line 1187 ""
}
-#line 1189 ""
+#line 1188 ""
return 0;
} /* accsym_ */
@@ -3060,125 +3061,125 @@ L7:
static cilist io___78 = { 0, 6, 0, 0, 0 };
-#line 1198 ""
+#line 1197 ""
scoarg = *scaldold * *scfac;
-#line 1199 ""
+#line 1198 ""
if (*isudsp) {
/* Find which udsp we're dealing with */
-#line 1203 ""
+#line 1202 ""
i__1 = comudsp_1.nudsp;
-#line 1203 ""
+#line 1202 ""
for (iudsp = 1; iudsp <= i__1; ++iudsp) {
-#line 1204 ""
+#line 1203 ""
if ((r__1 = *taskn + *tglp1 - comudsp_1.tudsp[iudsp - 1], dabs(
r__1)) < comtol_1.tol) {
-#line 1204 ""
+#line 1203 ""
goto L2;
-#line 1204 ""
+#line 1203 ""
}
-#line 1205 ""
+#line 1204 ""
/* L1: */
-#line 1205 ""
+#line 1204 ""
}
-#line 1206 ""
+#line 1205 ""
s_wsle(&io___78);
-#line 1206 ""
+#line 1205 ""
do_lio(&c__9, &c__1, "You should note BEEE here in addask!", (ftnlen)
36);
-#line 1206 ""
+#line 1205 ""
e_wsle();
-#line 1207 ""
+#line 1206 ""
stop1_();
-#line 1208 ""
+#line 1207 ""
L2:
/* Fixednew and scaldold must not be changed, since udsp's are already included */
/* in fsyst from pmxa, and udsp don't involve scaled space.. */
-#line 1213 ""
+#line 1212 ""
if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
/* Must add user-defined space to what's there already. */
-#line 1217 ""
+#line 1216 ""
comas1_1.wask[comas1_1.naskb - 1] += comudsp_1.udsp[iudsp - 1];
-#line 1218 ""
+#line 1217 ""
} else {
/* This place has no other space. */
-#line 1222 ""
+#line 1221 ""
++comas1_1.naskb;
-#line 1223 ""
+#line 1222 ""
comas1_1.task[comas1_1.naskb - 1] = *taskn;
-#line 1224 ""
+#line 1223 ""
comas1_1.wask[comas1_1.naskb - 1] = comudsp_1.udsp[iudsp - 1];
-#line 1225 ""
+#line 1224 ""
comas1_1.elask[comas1_1.naskb - 1] = 0.f;
-#line 1226 ""
+#line 1225 ""
}
-#line 1227 ""
+#line 1226 ""
} else {
/* 130330 start */
-#line 1229 ""
+#line 1228 ""
oldwask = 0.f;
-#line 1230 ""
+#line 1229 ""
oldelask = 0.f;
/* 130330 end */
/* This is a normal space, no effect if smaller than existing space */
-#line 1235 ""
+#line 1234 ""
if (comas1_1.naskb > 0 && (r__1 = *taskn - comas1_1.task[max(1,
comas1_1.naskb) - 1], dabs(r__1)) < comtol_1.tol) {
/* We already put in some space at this time */
/* Check if new one needs more space than old one at same time */
-#line 1240 ""
+#line 1239 ""
if (*waskn > comas1_1.wask[comas1_1.naskb - 1]) {
/* 130330 We were double counting the larger space when it came 2nd */
/* Need to fix but don't see how yet. Assume times came in order and */
/* that last naskb defined spaces that need updating */
-#line 1246 ""
+#line 1245 ""
oldwask = comas1_1.wask[comas1_1.naskb - 1];
-#line 1247 ""
+#line 1246 ""
oldelask = comas1_1.elask[comas1_1.naskb - 1];
/* End of 130330 insertions */
-#line 1249 ""
+#line 1248 ""
--comas1_1.naskb;
-#line 1250 ""
+#line 1249 ""
} else {
-#line 1251 ""
+#line 1250 ""
return 0;
-#line 1252 ""
+#line 1251 ""
}
-#line 1253 ""
+#line 1252 ""
}
-#line 1254 ""
+#line 1253 ""
++comas1_1.naskb;
-#line 1255 ""
+#line 1254 ""
comas1_1.task[comas1_1.naskb - 1] = *taskn;
-#line 1256 ""
+#line 1255 ""
comas1_1.wask[comas1_1.naskb - 1] = *waskn;
-#line 1257 ""
+#line 1256 ""
comas1_1.elask[comas1_1.naskb - 1] = *elaskn;
/* 130330 start */
/* fixednew = fixednew+waskn */
/* scaldold = scaldold+elaskn */
-#line 1261 ""
+#line 1260 ""
*fixednew = *fixednew + *waskn - oldwask;
-#line 1262 ""
+#line 1261 ""
*scaldold = scoarg + *elaskn - oldelask;
/* 130330 end */
-#line 1264 ""
+#line 1263 ""
}
-#line 1265 ""
+#line 1264 ""
return 0;
} /* addask_ */
@@ -3194,18 +3195,18 @@ L2:
/* Local variables */
static char tchar[1];
-#line 1270 ""
+#line 1269 ""
*(unsigned char *)tchar = *(unsigned char *)noteq;
/* Writing concatenation */
-#line 1271 ""
+#line 1270 ""
i__1[0] = 1, a__1[0] = " ";
-#line 1271 ""
+#line 1270 ""
i__1[1] = 1, a__1[1] = tchar;
-#line 1271 ""
+#line 1270 ""
s_cat(noteq, a__1, i__1, &c__2, (ftnlen)8);
-#line 1272 ""
+#line 1271 ""
*lnoten = 2;
-#line 1273 ""
+#line 1272 ""
return 0;
} /* addblank_ */
@@ -3214,54 +3215,54 @@ L2:
{
static integer ifb;
-#line 1281 ""
+#line 1280 ""
/* Parameter adjustments */
-#line 1281 ""
+#line 1280 ""
ulfbq -= 25;
-#line 1281 ""
+#line 1280 ""
t2fb -= 25;
-#line 1281 ""
+#line 1280 ""
t1fb -= 25;
-#line 1281 ""
+#line 1280 ""
--nfb;
-#line 1281 ""
+#line 1280 ""
-#line 1281 ""
+#line 1280 ""
/* Function Body */
-#line 1281 ""
+#line 1280 ""
*ifbadd = 1;
-#line 1282 ""
+#line 1281 ""
++nfb[*iv];
-#line 1283 ""
+#line 1282 ""
for (ifb = nfb[*iv] - 1; ifb >= 1; --ifb) {
-#line 1284 ""
+#line 1283 ""
if (*tnew < t1fb[*iv + ifb * 24] - comtol_1.tol) {
-#line 1285 ""
+#line 1284 ""
t1fb[*iv + (ifb + 1) * 24] = t1fb[*iv + ifb * 24];
-#line 1286 ""
+#line 1285 ""
t2fb[*iv + (ifb + 1) * 24] = t2fb[*iv + ifb * 24];
-#line 1287 ""
+#line 1286 ""
*(unsigned char *)&ulfbq[*iv + (ifb + 1) * 24] = *(unsigned char *
)&ulfbq[*iv + ifb * 24];
-#line 1288 ""
+#line 1287 ""
} else {
-#line 1289 ""
+#line 1288 ""
*ifbadd = ifb + 1;
-#line 1290 ""
+#line 1289 ""
goto L2;
-#line 1291 ""
+#line 1290 ""
}
-#line 1292 ""
+#line 1291 ""
/* L1: */
-#line 1292 ""
+#line 1291 ""
}
-#line 1293 ""
+#line 1292 ""
L2:
-#line 1294 ""
+#line 1293 ""
t1fb[*iv + *ifbadd * 24] = *tnew;
-#line 1295 ""
+#line 1294 ""
*(unsigned char *)&ulfbq[*iv + *ifbadd * 24] = 'x';
-#line 1296 ""
+#line 1295 ""
return 0;
} /* addfb_ */
@@ -3318,178 +3319,178 @@ L2:
/* Cancel out barline accidentals if there's a rest. */
-#line 1336 ""
+#line 1335 ""
if (*rest) {
-#line 1336 ""
+#line 1335 ""
comslm_1.naccbl[(300 + (0 + (*icm - 0 << 2)) - 300) / 4] = 0;
-#line 1336 ""
+#line 1335 ""
}
/* Special path to insert dummy rest at end of a section */
-#line 1340 ""
+#line 1339 ""
if (*endrest) {
-#line 1340 ""
+#line 1339 ""
goto L20;
-#line 1340 ""
+#line 1339 ""
}
-#line 1342 ""
+#line 1341 ""
i__1 = commidi_1.nmidcrd;
-#line 1342 ""
+#line 1341 ""
for (ion = 0; ion <= i__1; ++ion) {
/* check if this is only to get pitch of a chord note */
-#line 1346 ""
+#line 1345 ""
if (commidi_1.notmain) {
-#line 1346 ""
+#line 1345 ""
goto L6;
-#line 1346 ""
+#line 1345 ""
}
/* check for rest */
-#line 1350 ""
+#line 1349 ""
if (*rest) {
/* Will not put in a note, but must update timing */
-#line 1354 ""
+#line 1353 ""
if (! commidi_1.restpend[*icm]) {
/* First rest in sequence, save the time */
-#line 1358 ""
+#line 1357 ""
commidi_1.restpend[*icm] = TRUE_;
-#line 1359 ""
+#line 1358 ""
commidi_1.trest[*icm] = *time;
-#line 1360 ""
+#line 1359 ""
} else {
-#line 1361 ""
+#line 1360 ""
commidi_1.trest[*icm] += *time;
-#line 1362 ""
+#line 1361 ""
}
/* Note: code checkers don't like the above due to calling addmidi(trest(icm)) */
/* but this only happens if rest at end of section (endrest=.true.) (called */
/* from getmidi(), in which case these above lines are bypassed. */
-#line 1368 ""
+#line 1367 ""
chkimidi_(icm);
-#line 1369 ""
+#line 1368 ""
return 0;
-#line 1370 ""
+#line 1369 ""
}
/* time tics */
-#line 1374 ""
+#line 1373 ""
if (commidi_1.imidi[*icm] > 0 && ion == 0) {
-#line 1375 ""
+#line 1374 ""
idur = commidi_1.mgap;
-#line 1376 ""
+#line 1375 ""
} else {
-#line 1377 ""
+#line 1376 ""
idur = 0;
-#line 1378 ""
+#line 1377 ""
}
-#line 1379 ""
+#line 1378 ""
if (commidi_1.restpend[*icm]) {
-#line 1380 ""
+#line 1379 ""
commidi_1.restpend[*icm] = FALSE_;
-#line 1381 ""
+#line 1380 ""
r__1 = commidi_1.trest[*icm] * 15;
-#line 1381 ""
+#line 1380 ""
idur += i_nint(&r__1);
-#line 1382 ""
+#line 1381 ""
}
/* time to start of note */
-#line 1386 ""
+#line 1385 ""
idurvar = isetvarlen_(&idur, &nby2on);
-#line 1387 ""
+#line 1386 ""
if (nby2on > 4) {
-#line 1388 ""
+#line 1387 ""
s_wsle(&io___88);
-#line 1388 ""
+#line 1387 ""
do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.", (
ftnlen)37);
-#line 1388 ""
+#line 1387 ""
e_wsle();
-#line 1389 ""
+#line 1388 ""
stop1_();
-#line 1390 ""
+#line 1389 ""
}
-#line 1391 ""
+#line 1390 ""
++commidi_1.imidi[*icm];
-#line 1392 ""
+#line 1391 ""
i__2 = nby2on;
-#line 1392 ""
+#line 1391 ""
for (i__ = 1; i__ <= i__2; ++i__) {
/* imidi points to cell before highest (leftmost) byte. Start with lowest byte */
/* at far right, fill in backwards */
-#line 1397 ""
+#line 1396 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2on - i__) *
25 - 25] = (shortint) (idurvar % 256);
-#line 1398 ""
+#line 1397 ""
if (nby2on > 1) {
-#line 1398 ""
+#line 1397 ""
idurvar /= 256;
-#line 1398 ""
+#line 1397 ""
}
-#line 1399 ""
+#line 1398 ""
/* L2: */
-#line 1399 ""
+#line 1398 ""
}
-#line 1400 ""
+#line 1399 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2on - 1;
/* Note-on signal */
-#line 1404 ""
+#line 1403 ""
++commidi_1.imidi[*icm];
-#line 1405 ""
+#line 1404 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
icmm[*icm] + 144);
/* Entry point for chord note pitch determination */
-#line 1409 ""
+#line 1408 ""
L6:
/* Get midi pitch. On chord iteration, only do this first time (main note), */
/* since pitch was already computed for nonmain chord notes. */
-#line 1414 ""
+#line 1413 ""
if (ion == 0) {
-#line 1415 ""
+#line 1414 ""
ipsav = *nolev * 12.f / 7 + 11;
-#line 1416 ""
+#line 1415 ""
ipsav0 = ipsav;
-#line 1417 ""
+#line 1416 ""
if (*midisig != 0) {
/* Adjust for signature */
-#line 1421 ""
+#line 1420 ""
*(unsigned char *)notenumq = (char) (*nolev % 7 + 48);
-#line 1422 ""
+#line 1421 ""
if (*midisig >= i_indx("4152630", notenumq, (ftnlen)7, (
ftnlen)1)) {
-#line 1423 ""
+#line 1422 ""
++ipsav;
-#line 1424 ""
+#line 1423 ""
} else if (-(*midisig) >= i_indx("0362514", notenumq, (ftnlen)
7, (ftnlen)1)) {
-#line 1425 ""
+#line 1424 ""
--ipsav;
-#line 1426 ""
+#line 1425 ""
}
-#line 1427 ""
+#line 1426 ""
}
/* Deal with accidentals. */
@@ -3498,440 +3499,440 @@ L6:
/* effect X fl sh na X dfl dsh X */
/* iashft X -1 1 0 X -2 2 X */
-#line 1435 ""
+#line 1434 ""
jacc = 0;
-#line 1436 ""
+#line 1435 ""
eximacc = FALSE_;
-#line 1437 ""
+#line 1436 ""
if (*iacc > 0) {
/* Adjust key-sig-adjusted pitch for explicit accidental (and exit) */
-#line 1441 ""
+#line 1440 ""
jacc = iashft_(iacc);
-#line 1442 ""
+#line 1441 ""
eximacc = TRUE_;
-#line 1443 ""
+#line 1442 ""
if (! commidi_1.relacc) {
-#line 1443 ""
+#line 1442 ""
jacc = jacc + ipsav0 - ipsav;
-#line 1443 ""
+#line 1442 ""
}
/* (Above) Shift applies to diatonic pitch but will be added to adjusted one */
-#line 1447 ""
+#line 1446 ""
} else if (commidi_1.naccim[*icm] > 0) {
/* Possible implicit accidental from earlier in the bar */
/* Check for prior accid in this bar at this note level */
-#line 1452 ""
+#line 1451 ""
i__2 = commidi_1.naccim[*icm];
-#line 1452 ""
+#line 1451 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
-#line 1453 ""
+#line 1452 ""
if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
-#line 1454 ""
+#line 1453 ""
jacc = commidi_1.jaccim[*icm + kacc * 25 - 25];
-#line 1455 ""
+#line 1454 ""
eximacc = TRUE_;
-#line 1456 ""
+#line 1455 ""
if (! commidi_1.relacc) {
-#line 1456 ""
+#line 1455 ""
jacc = jacc + ipsav0 - ipsav;
-#line 1456 ""
+#line 1455 ""
}
-#line 1457 ""
+#line 1456 ""
goto L4;
-#line 1458 ""
+#line 1457 ""
}
-#line 1459 ""
+#line 1458 ""
/* L3: */
-#line 1459 ""
+#line 1458 ""
}
-#line 1460 ""
+#line 1459 ""
L4:
-#line 1461 ""
+#line 1460 ""
;
-#line 1461 ""
+#line 1460 ""
}
/* Must split off the following if block from those above because chord */
/* notes can cause naccim>0, forcing us to miss other chord note's */
/* accross-bar-line accidental */
-#line 1467 ""
+#line 1466 ""
if (comslm_1.naccbl[*icm] > 0 && ! eximacc) {
/* Possible carryover accid from prior bar (or prior same-pitch note). */
-#line 1471 ""
+#line 1470 ""
i__2 = comslm_1.naccbl[*icm];
-#line 1471 ""
+#line 1470 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
-#line 1472 ""
+#line 1471 ""
if (comslm_1.laccbl[*icm + kacc * 25 - 25] == *nolev) {
-#line 1473 ""
+#line 1472 ""
jacc = comslm_1.jaccbl[*icm + kacc * 25 - 25];
/* Since we are *using* the bar-line accid, must flag it to be saved for next. */
-#line 1477 ""
+#line 1476 ""
++comslm_1.nusebl;
-#line 1478 ""
+#line 1477 ""
comips_1.jusebl[comslm_1.nusebl - 1] = (shortint)
jacc;
-#line 1479 ""
+#line 1478 ""
comips_1.lusebl[comslm_1.nusebl - 1] = (shortint) (*
nolev);
-#line 1480 ""
+#line 1479 ""
if (! commidi_1.relacc) {
-#line 1480 ""
+#line 1479 ""
jacc = jacc + ipsav0 - ipsav;
-#line 1480 ""
+#line 1479 ""
}
-#line 1481 ""
+#line 1480 ""
goto L22;
-#line 1482 ""
+#line 1481 ""
}
-#line 1483 ""
+#line 1482 ""
/* L21: */
-#line 1483 ""
+#line 1482 ""
}
-#line 1484 ""
+#line 1483 ""
L22:
-#line 1485 ""
+#line 1484 ""
;
-#line 1485 ""
+#line 1484 ""
}
-#line 1486 ""
+#line 1485 ""
ipsav += jacc;
-#line 1487 ""
+#line 1486 ""
}
-#line 1488 ""
+#line 1487 ""
if (commidi_1.notmain) {
-#line 1489 ""
+#line 1488 ""
commidi_1.mcpitch[commidi_1.nmidcrd - 1] = ipsav;
/* Save pitch for tie checks */
-#line 1493 ""
+#line 1492 ""
if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm]) {
-#line 1493 ""
+#line 1492 ""
comips_1.ipslon[*icm] = (shortint) ipsav;
-#line 1493 ""
+#line 1492 ""
}
-#line 1495 ""
+#line 1494 ""
} else {
-#line 1496 ""
+#line 1495 ""
++commidi_1.imidi[*icm];
-#line 1497 ""
+#line 1496 ""
if (ion == 0) {
-#line 1498 ""
+#line 1497 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) ipsav;
-#line 1499 ""
+#line 1498 ""
if (comslm_1.levson[*icm] == *nolev && ! comslm_1.slmon[*icm])
{
-#line 1499 ""
+#line 1498 ""
comips_1.ipslon[*icm] = (shortint) ipsav;
-#line 1499 ""
+#line 1498 ""
}
-#line 1501 ""
+#line 1500 ""
} else {
-#line 1502 ""
+#line 1501 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) commidi_1.mcpitch[ion - 1];
-#line 1503 ""
+#line 1502 ""
}
-#line 1504 ""
+#line 1503 ""
}
-#line 1505 ""
+#line 1504 ""
if (ion == 0) {
/* Only record accids for non-chords, main chord note during chord iteration */
/* and chordnotes on first call but not during iteration */
-#line 1510 ""
+#line 1509 ""
if (*iacc > 0) {
/* Set marker for accidental for possible continuations later this bar */
/* but first check and clear earlier ones on same note. */
-#line 1515 ""
+#line 1514 ""
i__2 = commidi_1.naccim[*icm];
-#line 1515 ""
+#line 1514 ""
for (kacc = 1; kacc <= i__2; ++kacc) {
-#line 1516 ""
+#line 1515 ""
if (commidi_1.laccim[*icm + kacc * 25 - 25] == *nolev) {
-#line 1517 ""
+#line 1516 ""
i__3 = commidi_1.naccim[*icm] - 1;
-#line 1517 ""
+#line 1516 ""
for (macc = kacc; macc <= i__3; ++macc) {
-#line 1518 ""
+#line 1517 ""
commidi_1.laccim[*icm + macc * 25 - 25] =
commidi_1.laccim[*icm + (macc + 1) * 25 -
25];
-#line 1519 ""
+#line 1518 ""
commidi_1.jaccim[*icm + macc * 25 - 25] =
commidi_1.jaccim[*icm + (macc + 1) * 25 -
25];
-#line 1520 ""
+#line 1519 ""
/* L24: */
-#line 1520 ""
+#line 1519 ""
}
-#line 1521 ""
+#line 1520 ""
goto L25;
-#line 1522 ""
+#line 1521 ""
}
-#line 1523 ""
+#line 1522 ""
/* L23: */
-#line 1523 ""
+#line 1522 ""
}
-#line 1524 ""
+#line 1523 ""
goto L26;
-#line 1525 ""
+#line 1524 ""
L25:
-#line 1526 ""
+#line 1525 ""
--commidi_1.naccim[*icm];
-#line 1527 ""
+#line 1526 ""
L26:
/* Flag new accidental */
-#line 1531 ""
+#line 1530 ""
++commidi_1.naccim[*icm];
-#line 1532 ""
+#line 1531 ""
commidi_1.laccim[*icm + commidi_1.naccim[*icm] * 25 - 25] = *
nolev;
-#line 1533 ""
+#line 1532 ""
commidi_1.jaccim[*icm + commidi_1.naccim[*icm] * 25 - 25] =
iashft_(iacc);
-#line 1534 ""
+#line 1533 ""
}
/* Bail if this is a chord note on the first call (from docrd) */
-#line 1538 ""
+#line 1537 ""
if (commidi_1.notmain) {
-#line 1539 ""
+#line 1538 ""
chkimidi_(icm);
-#line 1540 ""
+#line 1539 ""
return 0;
-#line 1541 ""
+#line 1540 ""
}
-#line 1542 ""
+#line 1541 ""
}
/* Vel */
-#line 1546 ""
+#line 1545 ""
++commidi_1.imidi[*icm];
-#line 1547 ""
+#line 1546 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint)
commvel_1.midvelc[*icm];
-#line 1548 ""
+#line 1547 ""
chkimidi_(icm);
-#line 1549 ""
+#line 1548 ""
/* L7: */
-#line 1549 ""
+#line 1548 ""
}
/* For tie checks */
-#line 1553 ""
+#line 1552 ""
if (comslm_1.levson[*icm] > 0 && ! comslm_1.slmon[*icm]) {
-#line 1553 ""
+#line 1552 ""
comslm_1.imidso[*icm] = commidi_1.imidi[*icm];
-#line 1553 ""
+#line 1552 ""
}
/* Entry point for special rests at section ends (endrest=T) */
-#line 1557 ""
+#line 1556 ""
L20:
/* Now insert all the ends */
-#line 1561 ""
+#line 1560 ""
i__1 = commidi_1.nmidcrd;
-#line 1561 ""
+#line 1560 ""
for (ioff = 0; ioff <= i__1; ++ioff) {
-#line 1562 ""
+#line 1561 ""
if (ioff == 0) {
/* time to end */
-#line 1566 ""
+#line 1565 ""
r__1 = *time * 15;
-#line 1566 ""
+#line 1565 ""
idur1 = i_nint(&r__1);
-#line 1567 ""
+#line 1566 ""
r__1 = commidi_1.trest[*icm] * 15;
-#line 1567 ""
+#line 1566 ""
if (! (*endrest) || comevent_1.miditime == i_nint(&r__1)) {
-#line 1568 ""
+#line 1567 ""
idur = idur1 - commidi_1.mgap;
-#line 1569 ""
+#line 1568 ""
} else {
-#line 1570 ""
+#line 1569 ""
idur = idur1;
-#line 1571 ""
+#line 1570 ""
}
/* Deal with roundoff problems with 7-tuplets on half or quarters */
-#line 1575 ""
+#line 1574 ""
if (idur1 == 69) {
-#line 1576 ""
+#line 1575 ""
++comdiag_1.n69[*icm];
/* if (mod(n69(icm)+6,7) .gt. 3) idur = 58 */
-#line 1578 ""
+#line 1577 ""
if ((comdiag_1.n69[*icm] + 6) % 7 > 3) {
-#line 1578 ""
+#line 1577 ""
idur = idur1 - commidi_1.mgap - 1;
-#line 1578 ""
+#line 1577 ""
}
-#line 1579 ""
+#line 1578 ""
} else if (idur1 == 34) {
-#line 1580 ""
+#line 1579 ""
++comdiag_1.n34[*icm];
-#line 1581 ""
+#line 1580 ""
if ((comdiag_1.n34[*icm] + 6) % 7 > 4) {
-#line 1581 ""
+#line 1580 ""
idur = idur1 - commidi_1.mgap + 1;
-#line 1581 ""
+#line 1580 ""
}
-#line 1582 ""
+#line 1581 ""
}
-#line 1583 ""
+#line 1582 ""
idurvar = isetvarlen_(&idur, &nby2off);
-#line 1584 ""
+#line 1583 ""
if (nby2off > 4) {
-#line 1585 ""
+#line 1584 ""
s_wsle(&io___100);
-#line 1585 ""
+#line 1584 ""
do_lio(&c__9, &c__1, "You got >4 bytes, something is bogus.",
(ftnlen)37);
-#line 1585 ""
+#line 1584 ""
e_wsle();
-#line 1586 ""
+#line 1585 ""
stop1_();
-#line 1587 ""
+#line 1586 ""
}
-#line 1588 ""
+#line 1587 ""
++commidi_1.imidi[*icm];
-#line 1589 ""
+#line 1588 ""
chkimidi_(icm);
-#line 1590 ""
+#line 1589 ""
i__2 = nby2off;
-#line 1590 ""
+#line 1589 ""
for (i__ = 1; i__ <= i__2; ++i__) {
-#line 1591 ""
+#line 1590 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nby2off - i__)
* 25 - 25] = (shortint) (idurvar % 256);
-#line 1592 ""
+#line 1591 ""
if (nby2off > 1) {
-#line 1592 ""
+#line 1591 ""
idurvar /= 256;
-#line 1592 ""
+#line 1591 ""
}
-#line 1593 ""
+#line 1592 ""
/* L1: */
-#line 1593 ""
+#line 1592 ""
}
-#line 1594 ""
+#line 1593 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nby2off - 1;
-#line 1595 ""
+#line 1594 ""
} else {
/* Inserting end of chord note, delta time is 0 */
-#line 1599 ""
+#line 1598 ""
++commidi_1.imidi[*icm];
-#line 1600 ""
+#line 1599 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
-#line 1601 ""
+#line 1600 ""
}
/* Note off */
-#line 1605 ""
+#line 1604 ""
++commidi_1.imidi[*icm];
-#line 1606 ""
+#line 1605 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (shortint) (
icmm[*icm] + 128);
/* Pitch */
-#line 1610 ""
+#line 1609 ""
++commidi_1.imidi[*icm];
-#line 1611 ""
+#line 1610 ""
if (ioff == 0) {
-#line 1612 ""
+#line 1611 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) ipsav;
-#line 1613 ""
+#line 1612 ""
} else {
-#line 1614 ""
+#line 1613 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = (
shortint) commidi_1.mcpitch[ioff - 1];
-#line 1615 ""
+#line 1614 ""
}
/* Vel */
-#line 1619 ""
+#line 1618 ""
++commidi_1.imidi[*icm];
-#line 1620 ""
+#line 1619 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] = 0;
-#line 1621 ""
+#line 1620 ""
chkimidi_(icm);
-#line 1622 ""
+#line 1621 ""
if (*endrest) {
-#line 1623 ""
+#line 1622 ""
return 0;
-#line 1624 ""
+#line 1623 ""
}
-#line 1625 ""
+#line 1624 ""
/* L8: */
-#line 1625 ""
+#line 1624 ""
}
-#line 1626 ""
+#line 1625 ""
comslm_1.naccbl[*icm] = comslm_1.nusebl;
-#line 1627 ""
+#line 1626 ""
if (comslm_1.nusebl > 0) {
/* Fix tables of "bar-line" accids that are saved due to consecutive notes. */
-#line 1631 ""
+#line 1630 ""
i__1 = comslm_1.nusebl;
-#line 1631 ""
+#line 1630 ""
for (kacc = 1; kacc <= i__1; ++kacc) {
-#line 1632 ""
+#line 1631 ""
comslm_1.laccbl[*icm + kacc * 25 - 25] = comips_1.lusebl[kacc - 1]
;
-#line 1633 ""
+#line 1632 ""
comslm_1.jaccbl[*icm + kacc * 25 - 25] = comips_1.jusebl[kacc - 1]
;
-#line 1634 ""
+#line 1633 ""
/* L30: */
-#line 1634 ""
+#line 1633 ""
}
-#line 1635 ""
+#line 1634 ""
comslm_1.nusebl = 0;
-#line 1636 ""
+#line 1635 ""
}
/* Begin tie checks */
-#line 1640 ""
+#line 1639 ""
if (comslm_1.slmon[*icm]) {
/* Prior note had a slur start */
-#line 1644 ""
+#line 1643 ""
if (comslm_1.levson[*icm] == comslm_1.levsoff[*icm] && *iacc == 0) {
/* We have a tie! (Assumed there would be no accidental on tie-ending note) */
@@ -3940,198 +3941,198 @@ L20:
/* comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) */
/* Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */
/* time. */
-#line 1652 ""
+#line 1651 ""
nsav4tie = 0;
-#line 1653 ""
+#line 1652 ""
imidt = comslm_1.imidso[*icm];
-#line 1654 ""
+#line 1653 ""
L10:
-#line 1654 ""
+#line 1653 ""
++nsav4tie;
-#line 1655 ""
+#line 1654 ""
itiesav[nsav4tie * 5 - 5] = igetvarlen_(commidi_1.mmidi, icm, &
imidt, &nbytes);
-#line 1656 ""
+#line 1655 ""
imidt += nbytes;
-#line 1657 ""
+#line 1656 ""
for (j = 1; j <= 3; ++j) {
-#line 1658 ""
+#line 1657 ""
itiesav[j + 1 + nsav4tie * 5 - 6] = commidi_1.mmidi[*icm + (
imidt + j) * 25 - 25];
-#line 1659 ""
+#line 1658 ""
/* L11: */
-#line 1659 ""
+#line 1658 ""
}
-#line 1660 ""
+#line 1659 ""
imidt += 3;
-#line 1661 ""
+#line 1660 ""
if (nsav4tie == 1) {
-#line 1662 ""
+#line 1661 ""
itiesav[4] = itiesav[0];
-#line 1663 ""
+#line 1662 ""
} else {
-#line 1664 ""
+#line 1663 ""
itiesav[nsav4tie * 5 - 1] = itiesav[nsav4tie * 5 - 5] +
itiesav[(nsav4tie - 1) * 5 - 1];
-#line 1666 ""
+#line 1665 ""
}
-#line 1667 ""
+#line 1666 ""
if (imidt != commidi_1.imidi[*icm]) {
-#line 1667 ""
+#line 1666 ""
goto L10;
-#line 1667 ""
+#line 1666 ""
}
/* Find which two pitches agree with saved slur pitch. */
-#line 1671 ""
+#line 1670 ""
it1found = FALSE_;
-#line 1672 ""
+#line 1671 ""
i__1 = nsav4tie;
-#line 1672 ""
+#line 1671 ""
for (it2 = 1; it2 <= i__1; ++it2) {
-#line 1673 ""
+#line 1672 ""
if (itiesav[it2 * 5 - 3] == comips_1.ipslon[*icm]) {
-#line 1674 ""
+#line 1673 ""
if (it1found) {
-#line 1674 ""
+#line 1673 ""
goto L13;
-#line 1674 ""
+#line 1673 ""
}
-#line 1675 ""
+#line 1674 ""
it1 = it2;
-#line 1676 ""
+#line 1675 ""
it1found = TRUE_;
-#line 1677 ""
+#line 1676 ""
}
-#line 1678 ""
+#line 1677 ""
/* L12: */
-#line 1678 ""
+#line 1677 ""
}
-#line 1679 ""
+#line 1678 ""
printl_("Program error, tied notes, send source to Dr. Don", (
ftnlen)49);
-#line 1681 ""
+#line 1680 ""
it1 = nsav4tie + 1;
-#line 1682 ""
+#line 1681 ""
it2 = nsav4tie + 1;
-#line 1683 ""
+#line 1682 ""
L13:
/* List the positions we want to keep */
-#line 1687 ""
+#line 1686 ""
jsav = 0;
-#line 1688 ""
+#line 1687 ""
i__1 = nsav4tie;
-#line 1688 ""
+#line 1687 ""
for (isav = 1; isav <= i__1; ++isav) {
-#line 1689 ""
+#line 1688 ""
if (isav == it1 || isav == it2) {
-#line 1689 ""
+#line 1688 ""
goto L14;
-#line 1689 ""
+#line 1688 ""
}
-#line 1690 ""
+#line 1689 ""
++jsav;
-#line 1691 ""
+#line 1690 ""
itk[jsav - 1] = (shortint) isav;
-#line 1692 ""
+#line 1691 ""
L14:
-#line 1692 ""
+#line 1691 ""
;
-#line 1692 ""
+#line 1691 ""
}
-#line 1693 ""
+#line 1692 ""
nsav4tie += -2;
/* Now dump events it1 & it2, recompute times, restack mmidi. */
-#line 1697 ""
+#line 1696 ""
commidi_1.imidi[*icm] = comslm_1.imidso[*icm];
-#line 1698 ""
+#line 1697 ""
i__1 = nsav4tie;
-#line 1698 ""
+#line 1697 ""
for (isav = 1; isav <= i__1; ++isav) {
-#line 1699 ""
+#line 1698 ""
if (isav == 1) {
-#line 1700 ""
+#line 1699 ""
idurvar = isetvarlen_(&itiesav[itk[isav - 1] * 5 - 1], &
nbytes);
-#line 1701 ""
+#line 1700 ""
} else {
-#line 1702 ""
+#line 1701 ""
i__2 = itiesav[itk[isav - 1] * 5 - 1] - itiesav[itk[isav
- 2] * 5 - 1];
-#line 1702 ""
+#line 1701 ""
idurvar = isetvarlen_(&i__2, &nbytes);
-#line 1704 ""
+#line 1703 ""
}
-#line 1705 ""
+#line 1704 ""
++commidi_1.imidi[*icm];
-#line 1706 ""
+#line 1705 ""
i__2 = nbytes;
-#line 1706 ""
+#line 1705 ""
for (i__ = 1; i__ <= i__2; ++i__) {
-#line 1707 ""
+#line 1706 ""
commidi_1.mmidi[*icm + (commidi_1.imidi[*icm] + nbytes -
i__) * 25 - 25] = (shortint) (idurvar % 256);
-#line 1708 ""
+#line 1707 ""
if (nbytes > 1) {
-#line 1708 ""
+#line 1707 ""
idurvar /= 256;
-#line 1708 ""
+#line 1707 ""
}
-#line 1709 ""
+#line 1708 ""
/* L16: */
-#line 1709 ""
+#line 1708 ""
}
-#line 1710 ""
+#line 1709 ""
commidi_1.imidi[*icm] = commidi_1.imidi[*icm] + nbytes - 1;
-#line 1711 ""
+#line 1710 ""
for (i__ = 2; i__ <= 4; ++i__) {
-#line 1712 ""
+#line 1711 ""
++commidi_1.imidi[*icm];
-#line 1713 ""
+#line 1712 ""
commidi_1.mmidi[*icm + commidi_1.imidi[*icm] * 25 - 25] =
(shortint) itiesav[i__ + itk[isav - 1] * 5 - 6];
-#line 1714 ""
+#line 1713 ""
/* L17: */
-#line 1714 ""
+#line 1713 ""
}
-#line 1715 ""
+#line 1714 ""
/* L15: */
-#line 1715 ""
+#line 1714 ""
}
-#line 1716 ""
+#line 1715 ""
}
-#line 1717 ""
+#line 1716 ""
comslm_1.slmon[*icm] = FALSE_;
-#line 1718 ""
+#line 1717 ""
comslm_1.levsoff[*icm] = 0;
-#line 1719 ""
+#line 1718 ""
if (! comslm_1.dbltie) {
-#line 1719 ""
+#line 1718 ""
comslm_1.levson[*icm] = 0;
-#line 1719 ""
+#line 1718 ""
}
-#line 1720 ""
+#line 1719 ""
}
-#line 1721 ""
+#line 1720 ""
if (comslm_1.levson[*icm] > 0) {
-#line 1721 ""
+#line 1720 ""
comslm_1.slmon[*icm] = TRUE_;
-#line 1721 ""
+#line 1720 ""
}
-#line 1722 ""
+#line 1721 ""
if (commidi_1.nmidcrd > 0) {
-#line 1722 ""
+#line 1721 ""
commidi_1.nmidcrd = 0;
-#line 1722 ""
+#line 1721 ""
}
-#line 1723 ""
+#line 1722 ""
chkimidi_(icm);
-#line 1724 ""
+#line 1723 ""
return 0;
} /* addmidi_ */
@@ -4153,47 +4154,47 @@ L14:
static cilist io___112 = { 0, 11, 0, "(a)", 0 };
-#line 1731 ""
+#line 1730 ""
if (*lsout + *lnote > 72) {
-#line 1732 ""
+#line 1731 ""
if (comlast_1.islast) {
-#line 1732 ""
+#line 1731 ""
s_wsfe(&io___112);
/* Writing concatenation */
-#line 1732 ""
+#line 1731 ""
i__1[0] = *lsout, a__1[0] = soutq;
-#line 1732 ""
+#line 1731 ""
i__1[1] = 1, a__1[1] = "%";
-#line 1732 ""
+#line 1731 ""
s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)81);
-#line 1732 ""
+#line 1731 ""
do_fio(&c__1, ch__1, *lsout + 1);
-#line 1732 ""
+#line 1731 ""
e_wsfe();
-#line 1732 ""
+#line 1731 ""
}
-#line 1733 ""
+#line 1732 ""
*lsout = 0;
-#line 1734 ""
+#line 1733 ""
}
-#line 1735 ""
+#line 1734 ""
if (*lsout > 0) {
/* Writing concatenation */
-#line 1736 ""
+#line 1735 ""
i__1[0] = *lsout, a__1[0] = soutq;
-#line 1736 ""
+#line 1735 ""
i__1[1] = *lnote, a__1[1] = notexq;
-#line 1736 ""
+#line 1735 ""
s_cat(soutq, a__1, i__1, &c__2, (ftnlen)80);
-#line 1737 ""
+#line 1736 ""
} else {
-#line 1738 ""
+#line 1737 ""
s_copy(soutq, notexq, (ftnlen)80, (*lnote));
-#line 1739 ""
+#line 1738 ""
}
-#line 1740 ""
+#line 1739 ""
*lsout += *lnote;
-#line 1741 ""
+#line 1740 ""
return 0;
} /* addstr_ */
@@ -4211,63 +4212,63 @@ L14:
/* For block ib, this adds accidental spaces to eskz, for use in getting */
/* length of xtup bracket and slopes of brackets and beams. */
-#line 1767 ""
+#line 1766 ""
/* Parameter adjustments */
-#line 1767 ""
+#line 1766 ""
--istart;
-#line 1767 ""
+#line 1766 ""
-#line 1767 ""
+#line 1766 ""
/* Function Body */
-#line 1767 ""
+#line 1766 ""
inmin = istart[*ib] + 1;
-#line 1768 ""
+#line 1767 ""
i__1 = comas1_1.naskb;
-#line 1768 ""
+#line 1767 ""
for (iaskb = 1; iaskb <= i__1; ++iaskb) {
-#line 1769 ""
+#line 1768 ""
if (comas1_1.task[iaskb - 1] < all_1.to[istart[*ib] - 1] -
comtol_1.tol) {
-#line 1769 ""
+#line 1768 ""
goto L10;
-#line 1769 ""
+#line 1768 ""
}
-#line 1770 ""
+#line 1769 ""
eskadd = comas1_1.wask[iaskb - 1] / *poenom - comas1_1.elask[iaskb -
1];
-#line 1771 ""
+#line 1770 ""
i__2 = comntot_1.ntot;
-#line 1771 ""
+#line 1770 ""
for (in = inmin; in <= i__2; ++in) {
-#line 1772 ""
+#line 1771 ""
if (all_1.to[in - 1] > comas1_1.task[iaskb - 1] - comtol_1.tol) {
-#line 1773 ""
+#line 1772 ""
comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24
- 25] += eskadd;
-#line 1774 ""
+#line 1773 ""
if ((r__1 = all_1.to[in - 1] - comas1_1.task[iaskb - 1], dabs(
r__1)) < comtol_1.tol) {
-#line 1774 ""
+#line 1773 ""
--inmin;
-#line 1774 ""
+#line 1773 ""
}
-#line 1775 ""
+#line 1774 ""
} else {
-#line 1776 ""
+#line 1775 ""
++inmin;
-#line 1777 ""
+#line 1776 ""
}
-#line 1778 ""
+#line 1777 ""
/* L11: */
-#line 1778 ""
+#line 1777 ""
}
-#line 1779 ""
+#line 1778 ""
L10:
-#line 1779 ""
+#line 1778 ""
;
-#line 1779 ""
+#line 1778 ""
}
-#line 1780 ""
+#line 1779 ""
return 0;
} /* adjusteskz_ */
@@ -4313,333 +4314,333 @@ L10:
static cilist io___130 = { 0, 12, 0, "(a)", 0 };
-#line 1792 ""
+#line 1791 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 1792 ""
+#line 1791 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 1793 ""
+#line 1792 ""
o__1.oerr = 0;
-#line 1793 ""
+#line 1792 ""
o__1.ounit = 12;
-#line 1793 ""
+#line 1792 ""
o__1.ofnmlen = *lpath + *lbase + 4;
/* Writing concatenation */
-#line 1793 ""
+#line 1792 ""
i__1[0] = *lpath, a__1[0] = pathnameq;
-#line 1793 ""
+#line 1792 ""
i__1[1] = *lbase, a__1[1] = basenameq;
-#line 1793 ""
+#line 1792 ""
i__1[2] = 4, a__1[2] = ".tex";
-#line 1793 ""
+#line 1792 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)88);
-#line 1793 ""
+#line 1792 ""
o__1.ofnm = ch__2;
-#line 1793 ""
+#line 1792 ""
o__1.orl = 0;
-#line 1793 ""
+#line 1792 ""
o__1.osta = 0;
-#line 1793 ""
+#line 1792 ""
o__1.oacc = 0;
-#line 1793 ""
+#line 1792 ""
o__1.ofm = 0;
-#line 1793 ""
+#line 1792 ""
o__1.oblnk = 0;
-#line 1793 ""
+#line 1792 ""
f_open(&o__1);
/* Transfer first 5 lines of main internal TeX file */
-#line 1797 ""
+#line 1796 ""
for (il = 1; il <= 5; ++il) {
-#line 1798 ""
+#line 1797 ""
moveln_(&c__11, &c__12, &done);
-#line 1799 ""
+#line 1798 ""
/* L11: */
-#line 1799 ""
+#line 1798 ""
}
-#line 1800 ""
+#line 1799 ""
if (*istype0) {
/* Transfer literal TeX stuff from special scratch file */
-#line 1804 ""
+#line 1803 ""
al__1.aerr = 0;
-#line 1804 ""
+#line 1803 ""
al__1.aunit = 17;
-#line 1804 ""
+#line 1803 ""
f_rew(&al__1);
-#line 1805 ""
+#line 1804 ""
L10:
-#line 1805 ""
+#line 1804 ""
moveln_(&c__17, &c__12, &done);
-#line 1806 ""
+#line 1805 ""
if (! done) {
-#line 1806 ""
+#line 1805 ""
goto L10;
-#line 1806 ""
+#line 1805 ""
}
-#line 1807 ""
+#line 1806 ""
cl__1.cerr = 0;
-#line 1807 ""
+#line 1806 ""
cl__1.cunit = 17;
-#line 1807 ""
+#line 1806 ""
cl__1.csta = 0;
-#line 1807 ""
+#line 1806 ""
f_clos(&cl__1);
-#line 1808 ""
+#line 1807 ""
}
/* Transfer next 2 lines from main scratch file */
-#line 1812 ""
+#line 1811 ""
for (il = 1; il <= 2; ++il) {
-#line 1813 ""
+#line 1812 ""
moveln_(&c__11, &c__12, &done);
-#line 1814 ""
+#line 1813 ""
/* L3: */
-#line 1814 ""
+#line 1813 ""
}
-#line 1815 ""
+#line 1814 ""
if (compoi_1.ispoi) {
-#line 1815 ""
+#line 1814 ""
s_wsfe(&io___120);
/* Writing concatenation */
-#line 1815 ""
+#line 1814 ""
i__2[0] = 1, a__2[0] = sq;
-#line 1815 ""
+#line 1814 ""
i__2[1] = 14, a__2[1] = "input musixpoi";
-#line 1815 ""
+#line 1814 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
-#line 1815 ""
+#line 1814 ""
do_fio(&c__1, ch__3, (ftnlen)15);
-#line 1815 ""
+#line 1814 ""
e_wsfe();
-#line 1815 ""
+#line 1814 ""
}
-#line 1816 ""
+#line 1815 ""
if (combbm_1.isbbm) {
-#line 1816 ""
+#line 1815 ""
s_wsfe(&io___121);
/* Writing concatenation */
-#line 1816 ""
+#line 1815 ""
i__2[0] = 1, a__2[0] = sq;
-#line 1816 ""
+#line 1815 ""
i__2[1] = 14, a__2[1] = "input musixbbm";
-#line 1816 ""
+#line 1815 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
-#line 1816 ""
+#line 1815 ""
do_fio(&c__1, ch__3, (ftnlen)15);
-#line 1816 ""
+#line 1815 ""
e_wsfe();
-#line 1816 ""
+#line 1815 ""
}
-#line 1817 ""
+#line 1816 ""
if (*figbass) {
/* Transfer .fig data from scratch (unit 14) into external .tex (unit 12) */
-#line 1821 ""
+#line 1820 ""
L4:
-#line 1821 ""
+#line 1820 ""
moveln_(&c__14, &c__12, &done);
-#line 1822 ""
+#line 1821 ""
if (! done) {
-#line 1822 ""
+#line 1821 ""
goto L4;
-#line 1822 ""
+#line 1821 ""
}
-#line 1823 ""
+#line 1822 ""
cl__1.cerr = 0;
-#line 1823 ""
+#line 1822 ""
cl__1.cunit = 14;
-#line 1823 ""
+#line 1822 ""
cl__1.csta = 0;
-#line 1823 ""
+#line 1822 ""
f_clos(&cl__1);
-#line 1824 ""
+#line 1823 ""
}
-#line 1825 ""
+#line 1824 ""
comas3_1.iask = 0;
-#line 1826 ""
+#line 1825 ""
ihs = 0;
-#line 1827 ""
+#line 1826 ""
L1:
-#line 1827 ""
+#line 1826 ""
i__3 = s_rsfe(&io___123);
-#line 1827 ""
+#line 1826 ""
if (i__3 != 0) {
-#line 1827 ""
+#line 1826 ""
goto L999;
-#line 1827 ""
+#line 1826 ""
}
-#line 1827 ""
+#line 1826 ""
i__3 = do_fio(&c__1, outq, (ftnlen)129);
-#line 1827 ""
+#line 1826 ""
if (i__3 != 0) {
-#line 1827 ""
+#line 1826 ""
goto L999;
-#line 1827 ""
+#line 1826 ""
}
-#line 1827 ""
+#line 1826 ""
i__3 = e_rsfe();
-#line 1827 ""
+#line 1826 ""
if (i__3 != 0) {
-#line 1827 ""
+#line 1826 ""
goto L999;
-#line 1827 ""
+#line 1826 ""
}
/* Hardspaces. */
/* Writing concatenation */
-#line 1831 ""
+#line 1830 ""
i__2[0] = 1, a__2[0] = sq;
-#line 1831 ""
+#line 1830 ""
i__2[1] = 4, a__2[1] = "xard";
-#line 1831 ""
+#line 1830 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)5);
-#line 1831 ""
+#line 1830 ""
if (s_cmp(outq, ch__4, (ftnlen)5, (ftnlen)5) == 0) {
-#line 1832 ""
+#line 1831 ""
++ihs;
-#line 1833 ""
+#line 1832 ""
*(unsigned char *)&outq[1] = 'h';
-#line 1834 ""
+#line 1833 ""
s_wsfi(&io___125);
-#line 1834 ""
+#line 1833 ""
do_fio(&c__1, (char *)&comhsp_1.hpttot[ihs - 1], (ftnlen)sizeof(real))
;
-#line 1834 ""
+#line 1833 ""
e_wsfi();
-#line 1835 ""
+#line 1834 ""
lenout = 19;
-#line 1836 ""
+#line 1835 ""
goto L9;
-#line 1837 ""
+#line 1836 ""
}
/* This part hard-wires ask's into new .tex file as ast's */
-#line 1841 ""
+#line 1840 ""
L2:
/* Writing concatenation */
-#line 1841 ""
+#line 1840 ""
i__2[0] = 1, a__2[0] = sq;
-#line 1841 ""
+#line 1840 ""
i__2[1] = 3, a__2[1] = "ask";
-#line 1841 ""
+#line 1840 ""
s_cat(ch__5, a__2, i__2, &c__2, (ftnlen)4);
-#line 1841 ""
+#line 1840 ""
indxask = i_indx(outq, ch__5, (ftnlen)129, (ftnlen)4);
-#line 1842 ""
+#line 1841 ""
if (indxask != 0) {
-#line 1843 ""
+#line 1842 ""
++comas3_1.iask;
-#line 1844 ""
+#line 1843 ""
putast_(&comas3_1.ask[comas3_1.iask - 1], &indxask, outq, (ftnlen)129)
;
-#line 1845 ""
+#line 1844 ""
goto L2;
-#line 1846 ""
+#line 1845 ""
}
-#line 1847 ""
+#line 1846 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
-#line 1848 ""
+#line 1847 ""
L9:
-#line 1849 ""
+#line 1848 ""
s_wsfe(&io___128);
-#line 1849 ""
+#line 1848 ""
do_fio(&c__1, outq, lenout);
-#line 1849 ""
+#line 1848 ""
e_wsfe();
/* If this is the line with "readmod", check for topmods. */
-#line 1853 ""
+#line 1852 ""
if (comas3_1.topmods && s_cmp(outq + 1, "readmod", (ftnlen)7, (ftnlen)7)
== 0) {
-#line 1854 ""
+#line 1853 ""
comas3_1.topmods = FALSE_;
-#line 1855 ""
+#line 1854 ""
al__1.aerr = 0;
-#line 1855 ""
+#line 1854 ""
al__1.aunit = 16;
-#line 1855 ""
+#line 1854 ""
f_rew(&al__1);
-#line 1856 ""
+#line 1855 ""
for (il = 1; il <= 1000; ++il) {
-#line 1857 ""
+#line 1856 ""
i__3 = s_rsfe(&io___129);
-#line 1857 ""
+#line 1856 ""
if (i__3 != 0) {
-#line 1857 ""
+#line 1856 ""
goto L8;
-#line 1857 ""
+#line 1856 ""
}
-#line 1857 ""
+#line 1856 ""
i__3 = do_fio(&c__1, outq, (ftnlen)129);
-#line 1857 ""
+#line 1856 ""
if (i__3 != 0) {
-#line 1857 ""
+#line 1856 ""
goto L8;
-#line 1857 ""
+#line 1856 ""
}
-#line 1857 ""
+#line 1856 ""
i__3 = e_rsfe();
-#line 1857 ""
+#line 1856 ""
if (i__3 != 0) {
-#line 1857 ""
+#line 1856 ""
goto L8;
-#line 1857 ""
+#line 1856 ""
}
-#line 1858 ""
+#line 1857 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
/* We inserted the '%' in subroutine littex, to guarantee including blank. */
-#line 1862 ""
+#line 1861 ""
s_wsfe(&io___130);
-#line 1862 ""
+#line 1861 ""
do_fio(&c__1, outq, lenout);
-#line 1862 ""
+#line 1861 ""
e_wsfe();
-#line 1863 ""
+#line 1862 ""
/* L7: */
-#line 1863 ""
+#line 1862 ""
}
-#line 1864 ""
+#line 1863 ""
L8:
-#line 1865 ""
+#line 1864 ""
cl__1.cerr = 0;
-#line 1865 ""
+#line 1864 ""
cl__1.cunit = 16;
-#line 1865 ""
+#line 1864 ""
cl__1.csta = 0;
-#line 1865 ""
+#line 1864 ""
f_clos(&cl__1);
-#line 1866 ""
+#line 1865 ""
}
-#line 1867 ""
+#line 1866 ""
goto L1;
-#line 1868 ""
+#line 1867 ""
L999:
-#line 1868 ""
+#line 1867 ""
cl__1.cerr = 0;
-#line 1868 ""
+#line 1867 ""
cl__1.cunit = 11;
-#line 1868 ""
+#line 1867 ""
cl__1.csta = 0;
-#line 1868 ""
+#line 1867 ""
f_clos(&cl__1);
-#line 1869 ""
+#line 1868 ""
cl__1.cerr = 0;
-#line 1869 ""
+#line 1868 ""
cl__1.cunit = 12;
-#line 1869 ""
+#line 1868 ""
cl__1.csta = 0;
-#line 1869 ""
+#line 1868 ""
f_clos(&cl__1);
-#line 1870 ""
+#line 1869 ""
return 0;
} /* askfig_ */
@@ -4671,80 +4672,80 @@ L999:
/* In iunit, looks backward for oldq, overwrites newq */
/* Safest if both are same length! */
-#line 1879 ""
+#line 1878 ""
linesback = 0;
-#line 1880 ""
+#line 1879 ""
L1:
-#line 1881 ""
+#line 1880 ""
al__1.aerr = 0;
-#line 1881 ""
+#line 1880 ""
al__1.aunit = *iunit;
-#line 1881 ""
+#line 1880 ""
f_back(&al__1);
-#line 1882 ""
+#line 1881 ""
io___132.ciunit = *iunit;
-#line 1882 ""
+#line 1881 ""
s_rsfe(&io___132);
-#line 1882 ""
+#line 1881 ""
do_fio(&c__1, nowq, (ftnlen)128);
-#line 1882 ""
+#line 1881 ""
e_rsfe();
-#line 1883 ""
+#line 1882 ""
ndx = i_indx(nowq, oldq, (ftnlen)128, (*lenold));
/* Save the line just read */
-#line 1887 ""
+#line 1886 ""
++linesback;
-#line 1888 ""
+#line 1887 ""
s_copy(lineq + (linesback - 1 << 7), nowq, (ftnlen)128, (ftnlen)128);
-#line 1889 ""
+#line 1888 ""
if (ndx == 0) {
-#line 1890 ""
+#line 1889 ""
al__1.aerr = 0;
-#line 1890 ""
+#line 1889 ""
al__1.aunit = *iunit;
-#line 1890 ""
+#line 1889 ""
f_back(&al__1);
-#line 1891 ""
+#line 1890 ""
goto L1;
-#line 1892 ""
+#line 1891 ""
}
/* If here, it's replacement time. */
-#line 1896 ""
+#line 1895 ""
i__1 = ndx + *lenold - 1;
/* Writing concatenation */
-#line 1896 ""
+#line 1895 ""
i__2[0] = ndx - 1, a__1[0] = nowq;
-#line 1896 ""
+#line 1895 ""
i__2[1] = *lennew, a__1[1] = newq;
-#line 1896 ""
+#line 1895 ""
i__2[2] = 128 - i__1, a__1[2] = nowq + i__1;
-#line 1896 ""
+#line 1895 ""
s_cat(lineq + (linesback - 1 << 7), a__1, i__2, &c__3, (ftnlen)128);
-#line 1898 ""
+#line 1897 ""
al__1.aerr = 0;
-#line 1898 ""
+#line 1897 ""
al__1.aunit = *iunit;
-#line 1898 ""
+#line 1897 ""
f_back(&al__1);
-#line 1899 ""
+#line 1898 ""
for (line = linesback; line >= 1; --line) {
-#line 1900 ""
+#line 1899 ""
io___137.ciunit = *iunit;
-#line 1900 ""
+#line 1899 ""
s_wsfe(&io___137);
-#line 1900 ""
+#line 1899 ""
do_fio(&c__1, lineq + (line - 1 << 7), (ftnlen)128);
-#line 1900 ""
+#line 1899 ""
e_wsfe();
-#line 1901 ""
+#line 1900 ""
/* L2: */
-#line 1901 ""
+#line 1900 ""
}
-#line 1902 ""
+#line 1901 ""
return 0;
} /* backfill_ */
@@ -4801,392 +4802,392 @@ L1:
static icilist io___160 = { 0, noteq, 0, "(i2)", 2, 1 };
-#line 1930 ""
+#line 1929 ""
ip = all_1.ipo[all_1.jn - 1];
-#line 1931 ""
+#line 1930 ""
multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
-#line 1932 ""
+#line 1931 ""
*lnote = 0;
-#line 1933 ""
+#line 1932 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
/* This is the LAST note in the xtup (i.e., all rests before). Make single. */
-#line 1937 ""
+#line 1936 ""
i__1 = 4 - multip;
-#line 1937 ""
+#line 1936 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
-#line 1938 ""
+#line 1937 ""
notex_(notexq, lnote, (ftnlen)79);
-#line 1939 ""
+#line 1938 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
-#line 1940 ""
+#line 1939 ""
return 0;
-#line 1941 ""
+#line 1940 ""
}
-#line 1942 ""
+#line 1941 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
-#line 1946 ""
+#line 1945 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
-#line 1947 ""
+#line 1946 ""
--nole;
-#line 1948 ""
+#line 1947 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
-#line 1949 ""
+#line 1948 ""
++nole;
-#line 1950 ""
+#line 1949 ""
}
/* Terminate indented beams for 2-note tremolo if needed */
-#line 1954 ""
+#line 1953 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2) &&
igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &c__2,
&c__5) > 0) {
-#line 1956 ""
+#line 1955 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25], &
c__2, &c__5);
-#line 1957 ""
+#line 1956 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
-#line 1958 ""
+#line 1957 ""
addoff = -1 - nindent * .5f;
-#line 1959 ""
+#line 1958 ""
} else {
-#line 1960 ""
+#line 1959 ""
addoff = nindent * .5f + 1;
-#line 1961 ""
+#line 1960 ""
}
/* addoff = addoff+(.595-.065*abs(islope(ivx)))*islope(ivx) */
-#line 1963 ""
+#line 1962 ""
addoff += comxtup_1.islope[commvl_1.ivx - 1] * .0822f;
-#line 1964 ""
+#line 1963 ""
if (addoff < -.05f) {
-#line 1965 ""
+#line 1964 ""
s_wsfi(&io___144);
-#line 1965 ""
+#line 1964 ""
do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
-#line 1965 ""
+#line 1964 ""
e_wsfi();
-#line 1966 ""
+#line 1965 ""
} else {
-#line 1967 ""
+#line 1966 ""
s_wsfi(&io___145);
-#line 1967 ""
+#line 1966 ""
do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
-#line 1967 ""
+#line 1966 ""
e_wsfi();
-#line 1968 ""
+#line 1967 ""
}
/* Writing concatenation */
-#line 1969 ""
+#line 1968 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 1969 ""
+#line 1968 ""
i__2[1] = 5, a__1[1] = "raise";
-#line 1969 ""
+#line 1968 ""
i__2[2] = 4, a__1[2] = tempq;
-#line 1969 ""
+#line 1968 ""
i__2[3] = 1, a__1[3] = all_1.sq;
-#line 1969 ""
+#line 1968 ""
i__2[4] = 9, a__1[4] = "internote";
-#line 1969 ""
+#line 1968 ""
i__2[5] = 1, a__1[5] = all_1.sq;
-#line 1969 ""
+#line 1968 ""
i__2[6] = 5, a__1[6] = "hbox{";
-#line 1969 ""
+#line 1968 ""
i__2[7] = 1, a__1[7] = all_1.sq;
-#line 1969 ""
+#line 1968 ""
i__2[8] = 12, a__1[8] = "loffset{.7}{";
-#line 1969 ""
+#line 1968 ""
i__2[9] = 1, a__1[9] = all_1.sq;
-#line 1969 ""
+#line 1968 ""
i__2[10] = 2, a__1[10] = "tb";
-#line 1969 ""
+#line 1968 ""
i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 1969 ""
+#line 1968 ""
i__2[12] = 3, a__1[12] = "0}}";
-#line 1969 ""
+#line 1968 ""
s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
-#line 1972 ""
+#line 1971 ""
*lnote = 46;
-#line 1973 ""
+#line 1972 ""
}
-#line 1974 ""
+#line 1973 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam, just put in the right kind of note */
-#line 1978 ""
+#line 1977 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
/* Rest at end of unbeamed xtup */
-#line 1982 ""
+#line 1981 ""
*lnote = 3;
-#line 1983 ""
+#line 1982 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
/* Writing concatenation */
-#line 1984 ""
+#line 1983 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1984 ""
+#line 1983 ""
i__3[1] = 2, a__2[1] = "sk";
-#line 1984 ""
+#line 1983 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
/* 180106 There was a problem with nolev(ivx,ip) not being set to 0 for */
/* a blank rest ending xtup, but hopefully returning from here will handle it. */
-#line 1989 ""
+#line 1988 ""
return 0;
-#line 1990 ""
+#line 1989 ""
} else if (multip == 0) {
/* Writing concatenation */
-#line 1991 ""
+#line 1990 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1991 ""
+#line 1990 ""
i__3[1] = 2, a__2[1] = "qp";
-#line 1991 ""
+#line 1990 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 1992 ""
+#line 1991 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 1993 ""
+#line 1992 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1993 ""
+#line 1992 ""
i__3[1] = 2, a__2[1] = "hp";
-#line 1993 ""
+#line 1992 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 1994 ""
+#line 1993 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 1995 ""
+#line 1994 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1995 ""
+#line 1994 ""
i__3[1] = 2, a__2[1] = "ds";
-#line 1995 ""
+#line 1994 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 1996 ""
+#line 1995 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 1997 ""
+#line 1996 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1997 ""
+#line 1996 ""
i__3[1] = 2, a__2[1] = "qs";
-#line 1997 ""
+#line 1996 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 1998 ""
+#line 1997 ""
} else {
/* Writing concatenation */
-#line 1999 ""
+#line 1998 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 1999 ""
+#line 1998 ""
i__3[1] = 2, a__2[1] = "hs";
-#line 1999 ""
+#line 1998 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2000 ""
+#line 1999 ""
}
/* 180106 Deal with possible level tweak */
-#line 2004 ""
+#line 2003 ""
nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 50) % 100 - 50;
-#line 2005 ""
+#line 2004 ""
if (nole != 0) {
-#line 2006 ""
+#line 2005 ""
if (abs(nole) < 10) {
-#line 2007 ""
+#line 2006 ""
i__1 = abs(nole) + 48;
-#line 2007 ""
+#line 2006 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 2007 ""
+#line 2006 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
-#line 2008 ""
+#line 2007 ""
lnoten = 1;
-#line 2009 ""
+#line 2008 ""
} else {
-#line 2010 ""
+#line 2009 ""
s_wsfi(&io___148);
-#line 2010 ""
+#line 2009 ""
i__1 = abs(nole);
-#line 2010 ""
+#line 2009 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 2010 ""
+#line 2009 ""
e_wsfi();
-#line 2011 ""
+#line 2010 ""
lnoten = 2;
-#line 2012 ""
+#line 2011 ""
}
-#line 2013 ""
+#line 2012 ""
if (nole > 0) {
/* Writing concatenation */
-#line 2014 ""
+#line 2013 ""
i__4[0] = 1, a__3[0] = all_1.sq;
-#line 2014 ""
+#line 2013 ""
i__4[1] = 5, a__3[1] = "raise";
-#line 2014 ""
+#line 2013 ""
i__4[2] = lnoten, a__3[2] = noteq;
-#line 2014 ""
+#line 2013 ""
i__4[3] = 1, a__3[3] = all_1.sq;
-#line 2014 ""
+#line 2013 ""
i__4[4] = 9, a__3[4] = "internote";
-#line 2014 ""
+#line 2013 ""
i__4[5] = *lnote, a__3[5] = notexq;
-#line 2014 ""
+#line 2013 ""
s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
-#line 2016 ""
+#line 2015 ""
} else {
/* Writing concatenation */
-#line 2017 ""
+#line 2016 ""
i__4[0] = 1, a__3[0] = all_1.sq;
-#line 2017 ""
+#line 2016 ""
i__4[1] = 5, a__3[1] = "lower";
-#line 2017 ""
+#line 2016 ""
i__4[2] = lnoten, a__3[2] = noteq;
-#line 2017 ""
+#line 2016 ""
i__4[3] = 1, a__3[3] = all_1.sq;
-#line 2017 ""
+#line 2016 ""
i__4[4] = 9, a__3[4] = "internote";
-#line 2017 ""
+#line 2016 ""
i__4[5] = *lnote, a__3[5] = notexq;
-#line 2017 ""
+#line 2016 ""
s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
-#line 2019 ""
+#line 2018 ""
}
-#line 2020 ""
+#line 2019 ""
*lnote = lnoten + 16 + *lnote;
-#line 2021 ""
+#line 2020 ""
}
-#line 2022 ""
+#line 2021 ""
return 0;
-#line 2023 ""
+#line 2022 ""
}
-#line 2024 ""
+#line 2023 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
/* Forced stem direction */
-#line 2028 ""
+#line 2027 ""
ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 2029 ""
+#line 2028 ""
i__1 = 4 - multip;
-#line 2029 ""
+#line 2028 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
-#line 2030 ""
+#line 2029 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
-#line 2030 ""
+#line 2029 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
-#line 2030 ""
+#line 2029 ""
}
-#line 2032 ""
+#line 2031 ""
notex_(notexq, lnote, (ftnlen)79);
-#line 2033 ""
+#line 2032 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
-#line 2034 ""
+#line 2033 ""
} else {
-#line 2035 ""
+#line 2034 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2035 ""
+#line 2034 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2036 ""
+#line 2035 ""
if (lnoten == 1) {
-#line 2036 ""
+#line 2035 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 2036 ""
+#line 2035 ""
}
/* To reduce confusion due to this early update of lnote, do it */
/* below, separately in each case/ */
/* lnote = lnoten+3 */
-#line 2041 ""
+#line 2040 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
{
/* Prior note is not regular-dotted */
-#line 2045 ""
+#line 2044 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)
&& igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
24 - 25], &c__2, &c__5) > 0) {
/* Unbeamed tremolo with indented beams. Put termination in right here */
-#line 2050 ""
+#line 2049 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
24 - 25], &c__2, &c__5);
-#line 2051 ""
+#line 2050 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
{
-#line 2052 ""
+#line 2051 ""
addoff = -1 - nindent * .5f;
-#line 2053 ""
+#line 2052 ""
} else {
-#line 2054 ""
+#line 2053 ""
addoff = nindent * .5f + 1;
-#line 2055 ""
+#line 2054 ""
}
/* Is there an islope here, for unbeamed? */
-#line 2059 ""
+#line 2058 ""
if (addoff < -.05f) {
-#line 2060 ""
+#line 2059 ""
s_wsfi(&io___150);
-#line 2060 ""
+#line 2059 ""
do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
-#line 2060 ""
+#line 2059 ""
e_wsfi();
-#line 2061 ""
+#line 2060 ""
} else {
-#line 2062 ""
+#line 2061 ""
s_wsfi(&io___151);
-#line 2062 ""
+#line 2061 ""
do_fio(&c__1, (char *)&addoff, (ftnlen)sizeof(real));
-#line 2062 ""
+#line 2061 ""
e_wsfi();
-#line 2063 ""
+#line 2062 ""
}
/* Writing concatenation */
-#line 2064 ""
+#line 2063 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2064 ""
+#line 2063 ""
i__2[1] = 5, a__1[1] = "raise";
-#line 2064 ""
+#line 2063 ""
i__2[2] = 4, a__1[2] = tempq;
-#line 2064 ""
+#line 2063 ""
i__2[3] = 1, a__1[3] = all_1.sq;
-#line 2064 ""
+#line 2063 ""
i__2[4] = 9, a__1[4] = "internote";
-#line 2064 ""
+#line 2063 ""
i__2[5] = 1, a__1[5] = all_1.sq;
-#line 2064 ""
+#line 2063 ""
i__2[6] = 5, a__1[6] = "hbox{";
-#line 2064 ""
+#line 2063 ""
i__2[7] = 1, a__1[7] = all_1.sq;
-#line 2064 ""
+#line 2063 ""
i__2[8] = 12, a__1[8] = "loffset{.7}{";
-#line 2064 ""
+#line 2063 ""
i__2[9] = 1, a__1[9] = all_1.sq;
-#line 2064 ""
+#line 2063 ""
i__2[10] = 2, a__1[10] = "tb";
-#line 2064 ""
+#line 2063 ""
i__2[11] = 1, a__1[11] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2064 ""
+#line 2063 ""
i__2[12] = 3, a__1[12] = "0}}";
-#line 2064 ""
+#line 2063 ""
s_cat(notexq, a__1, i__2, &c__13, (ftnlen)79);
-#line 2068 ""
+#line 2067 ""
*lnote = 46;
-#line 2069 ""
+#line 2068 ""
}
-#line 2070 ""
+#line 2069 ""
if (multip == 0) {
-#line 2071 ""
+#line 2070 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 -
25],2) && all_1.nodur[commvl_1.ivx + ip * 24 - 25]
> 24) {
@@ -5195,45 +5196,45 @@ L1:
/* But it's not clear if unbeamed half-note tremolo is Kosher, */
/* so don't worry about stem lengths here now. */
-#line 2078 ""
+#line 2077 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 2079 ""
+#line 2078 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2079 ""
+#line 2078 ""
i__5[1] = 1, a__4[1] = "h";
-#line 2079 ""
+#line 2078 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25);
-#line 2079 ""
+#line 2078 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2079 ""
+#line 2078 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2080 ""
+#line 2079 ""
} else {
/* Writing concatenation */
-#line 2081 ""
+#line 2080 ""
i__6[0] = 46, a__5[0] = notexq;
-#line 2081 ""
+#line 2080 ""
i__6[1] = 1, a__5[1] = all_1.sq;
-#line 2081 ""
+#line 2080 ""
i__6[2] = 1, a__5[2] = "h";
-#line 2081 ""
+#line 2080 ""
i__6[3] = 1, a__5[3] = all_1.ulq + (commvl_1.ivx
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25);
-#line 2081 ""
+#line 2080 ""
i__6[4] = 8, a__5[4] = noteq;
-#line 2081 ""
+#line 2080 ""
s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
-#line 2083 ""
+#line 2082 ""
*lnote = 46;
-#line 2084 ""
+#line 2083 ""
}
-#line 2085 ""
+#line 2084 ""
} else {
-#line 2086 ""
+#line 2085 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
- 25],2) && all_1.nodur[commvl_1.ivx + ip *
24 - 25] == 24 || all_1.nodur[commvl_1.ivx +
@@ -5241,34 +5242,34 @@ L1:
/* Need a dot. */
-#line 2091 ""
+#line 2090 ""
*lnote = 46;
-#line 2092 ""
+#line 2091 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2093 ""
+#line 2092 ""
i__3[0] = 1, a__2[0] = " ";
-#line 2093 ""
+#line 2092 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 2093 ""
+#line 2092 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 2094 ""
+#line 2093 ""
lnoten = 2;
-#line 2095 ""
+#line 2094 ""
}
/* Insert stemlength stuff here for unbeamed dotted tremolo. */
/* May later combine with below to avoid repeat. But need to */
/* return to normal stem length after note is set. */
-#line 2101 ""
+#line 2100 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + (
ip - 1) * 24 - 25], &c__2, &c__5);
-#line 2102 ""
+#line 2101 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25]
== 'u') {
-#line 2103 ""
+#line 2102 ""
slen = (nindent + 4.5f + comxtup_1.nolev1[
commvl_1.ivx - 1] - nole + (
all_1.eskz[commvl_1.ivx + ip * 24 -
@@ -5276,9 +5277,9 @@ L1:
1) * 24 - 25] - .7f) * 1.3f *
comxtup_1.islope[commvl_1.ivx - 1] /
all_1.slfac) * .6667f;
-#line 2106 ""
+#line 2105 ""
} else {
-#line 2107 ""
+#line 2106 ""
slen = (nindent + 4.5f - comxtup_1.nolev1[
commvl_1.ivx - 1] + nole - (
all_1.eskz[commvl_1.ivx + ip * 24 -
@@ -5286,582 +5287,575 @@ L1:
1) * 24 - 25] - .7f) * 1.3f *
comxtup_1.islope[commvl_1.ivx - 1] /
all_1.slfac) * .6667f;
-#line 2110 ""
+#line 2109 ""
}
-#line 2111 ""
+#line 2110 ""
s_wsfi(&io___153);
-#line 2111 ""
+#line 2110 ""
do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real))
;
-#line 2111 ""
+#line 2110 ""
e_wsfi();
/* Writing concatenation */
-#line 2112 ""
+#line 2111 ""
i__6[0] = 1, a__5[0] = all_1.sq;
-#line 2112 ""
+#line 2111 ""
i__6[1] = 4, a__5[1] = "slx{";
-#line 2112 ""
+#line 2111 ""
i__6[2] = 4, a__5[2] = tempq;
-#line 2112 ""
+#line 2111 ""
i__6[3] = 1, a__5[3] = "}";
-#line 2112 ""
+#line 2111 ""
i__6[4] = *lnote, a__5[4] = notexq;
-#line 2112 ""
+#line 2111 ""
s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
-#line 2113 ""
+#line 2112 ""
*lnote += 10;
-#line 2114 ""
+#line 2113 ""
}
/* Next steps are a historical kluge to distinguish dotted unbeamed 2-note trem */
/* (needs \qup) from normal xtup on dotted note (eg e44dx2 f, wants no dot) */
-#line 2119 ""
+#line 2118 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
- 25],2)) {
-#line 2120 ""
+#line 2119 ""
if (*lnote == 0) {
/* notexq = sq//'q'//ulq(ivx,ibmcnt(ivx)) */
/* Writing concatenation */
-#line 2122 ""
+#line 2121 ""
i__6[0] = 1, a__5[0] = all_1.sq;
-#line 2122 ""
+#line 2121 ""
i__6[1] = 1, a__5[1] = "q";
-#line 2122 ""
+#line 2121 ""
i__6[2] = 1, a__5[2] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 2122 ""
+#line 2121 ""
i__6[3] = 1, a__5[3] = "p";
-#line 2122 ""
+#line 2121 ""
i__6[4] = lnoten, a__5[4] = noteq;
-#line 2122 ""
+#line 2121 ""
s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
-#line 2124 ""
+#line 2123 ""
} else {
/* Writing concatenation */
-#line 2125 ""
+#line 2124 ""
i__4[0] = *lnote, a__3[0] = notexq;
-#line 2125 ""
+#line 2124 ""
i__4[1] = 1, a__3[1] = all_1.sq;
-#line 2125 ""
+#line 2124 ""
i__4[2] = 1, a__3[2] = "q";
-#line 2125 ""
+#line 2124 ""
i__4[3] = 1, a__3[3] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 2125 ""
+#line 2124 ""
i__4[4] = 1, a__3[4] = "p";
-#line 2125 ""
+#line 2124 ""
i__4[5] = lnoten, a__3[5] = noteq;
-#line 2125 ""
+#line 2124 ""
s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
/* * //ulq(ivx,ibmcnt(ivx))//noteq(1:lnoten) */
-#line 2128 ""
+#line 2127 ""
}
/* lnote = lnote+3+lnoten */
-#line 2130 ""
+#line 2129 ""
*lnote = *lnote + 4 + lnoten;
-#line 2131 ""
+#line 2130 ""
} else {
-#line 2132 ""
+#line 2131 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 2133 ""
+#line 2132 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2133 ""
+#line 2132 ""
i__5[1] = 1, a__4[1] = "q";
-#line 2133 ""
+#line 2132 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 2133 ""
+#line 2132 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2133 ""
+#line 2132 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2135 ""
+#line 2134 ""
} else {
/* Writing concatenation */
-#line 2136 ""
+#line 2135 ""
i__6[0] = *lnote, a__5[0] = notexq;
-#line 2136 ""
+#line 2135 ""
i__6[1] = 1, a__5[1] = all_1.sq;
-#line 2136 ""
+#line 2135 ""
i__6[2] = 1, a__5[2] = "q";
-#line 2136 ""
+#line 2135 ""
i__6[3] = 1, a__5[3] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 2136 ""
+#line 2135 ""
i__6[4] = lnoten, a__5[4] = noteq;
-#line 2136 ""
+#line 2135 ""
s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
-#line 2138 ""
+#line 2137 ""
}
-#line 2139 ""
+#line 2138 ""
*lnote = *lnote + 3 + lnoten;
-#line 2140 ""
+#line 2139 ""
}
-#line 2141 ""
+#line 2140 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
- 25],2) && all_1.nodur[commvl_1.ivx + ip *
24 - 25] == 24 || all_1.nodur[commvl_1.ivx +
ip * 24 - 25] == 12) {
/* Writing concatenation */
-#line 2143 ""
+#line 2142 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2143 ""
+#line 2142 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2143 ""
+#line 2142 ""
i__7[2] = 3, a__6[2] = "slz";
-#line 2143 ""
+#line 2142 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2144 ""
+#line 2143 ""
*lnote += 4;
-#line 2145 ""
+#line 2144 ""
}
-#line 2146 ""
+#line 2145 ""
}
-#line 2147 ""
+#line 2146 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24
- 25],2)) {
/* 2nd note of unbeamed quarter or 8th trem; make quarter note */
/* Get stemlength change */
-#line 2152 ""
+#line 2151 ""
*lnote = 46;
-#line 2153 ""
+#line 2152 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + (ip - 1) *
24 - 25], &c__2, &c__5);
-#line 2154 ""
+#line 2153 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
{
-#line 2155 ""
+#line 2154 ""
slen = (nindent + 4.5f + comxtup_1.nolev1[
commvl_1.ivx - 1] - nole + (all_1.eskz[
commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) *
1.3f * comxtup_1.islope[commvl_1.ivx - 1] /
all_1.slfac) * .6667f;
-#line 2158 ""
+#line 2157 ""
} else {
-#line 2159 ""
+#line 2158 ""
slen = (nindent + 4.5f - comxtup_1.nolev1[
commvl_1.ivx - 1] + nole - (all_1.eskz[
commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
commvl_1.ivx + (ip - 1) * 24 - 25] - .7f) *
1.3f * comxtup_1.islope[commvl_1.ivx - 1] /
all_1.slfac) * .6667f;
-#line 2162 ""
+#line 2161 ""
}
-#line 2163 ""
+#line 2162 ""
s_wsfi(&io___154);
-#line 2163 ""
+#line 2162 ""
do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
-#line 2163 ""
+#line 2162 ""
e_wsfi();
/* Writing concatenation */
-#line 2164 ""
+#line 2163 ""
i__6[0] = 46, a__5[0] = notexq;
-#line 2164 ""
+#line 2163 ""
i__6[1] = 1, a__5[1] = all_1.sq;
-#line 2164 ""
+#line 2163 ""
i__6[2] = 4, a__5[2] = "slx{";
-#line 2164 ""
+#line 2163 ""
i__6[3] = 4, a__5[3] = tempq;
-#line 2164 ""
+#line 2163 ""
i__6[4] = 1, a__5[4] = "}";
-#line 2164 ""
+#line 2163 ""
s_cat(notexq, a__5, i__6, &c__5, (ftnlen)79);
-#line 2165 ""
+#line 2164 ""
*lnote += 10;
-/* if (lnote .eq. 0) then */
-/* notexq = sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */
-/* else */
-/* notexq = notexq(1:46)// */
-/* * sq//'h'//ulq(ivx,ibmcnt(ivx))//noteq */
-/* end if */
-
/* Check for dotted unbeamed tremolo */
-#line 2176 ""
+#line 2168 ""
if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] /
12.f - all_1.nodur[commvl_1.ivx + ip * 24 - 25] /
12, dabs(r__1)) < .001f) {
/* Need a dot */
-#line 2180 ""
+#line 2172 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2181 ""
+#line 2173 ""
i__3[0] = 1, a__2[0] = " ";
-#line 2181 ""
+#line 2173 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 2181 ""
+#line 2173 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 2182 ""
+#line 2174 ""
lnoten = 2;
-#line 2183 ""
+#line 2175 ""
}
-#line 2184 ""
+#line 2176 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 2185 ""
+#line 2177 ""
i__7[0] = 1, a__6[0] = all_1.sq;
-#line 2185 ""
+#line 2177 ""
i__7[1] = 2, a__6[1] = "pt";
-#line 2185 ""
+#line 2177 ""
i__7[2] = lnoten, a__6[2] = noteq;
-#line 2185 ""
+#line 2177 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2186 ""
+#line 2178 ""
} else {
/* Writing concatenation */
-#line 2187 ""
+#line 2179 ""
i__5[0] = *lnote, a__4[0] = notexq;
-#line 2187 ""
+#line 2179 ""
i__5[1] = 1, a__4[1] = all_1.sq;
-#line 2187 ""
+#line 2179 ""
i__5[2] = 2, a__4[2] = "pt";
-#line 2187 ""
+#line 2179 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2187 ""
+#line 2179 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2188 ""
+#line 2180 ""
}
-#line 2189 ""
+#line 2181 ""
*lnote = *lnote + 3 + lnoten;
-#line 2190 ""
+#line 2182 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2190 ""
+#line 2182 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2191 ""
+#line 2183 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2192 ""
+#line 2184 ""
i__3[0] = 1, a__2[0] = " ";
-#line 2192 ""
+#line 2184 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 2192 ""
+#line 2184 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 2193 ""
+#line 2185 ""
lnoten = 2;
-#line 2194 ""
+#line 2186 ""
}
-#line 2195 ""
+#line 2187 ""
}
/* Writing concatenation */
-#line 2196 ""
+#line 2188 ""
i__8[0] = *lnote, a__7[0] = notexq;
-#line 2196 ""
+#line 2188 ""
i__8[1] = 1, a__7[1] = all_1.sq;
-#line 2196 ""
+#line 2188 ""
i__8[2] = 1, a__7[2] = "q";
-#line 2196 ""
+#line 2188 ""
i__8[3] = 1, a__7[3] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2196 ""
+#line 2188 ""
i__8[4] = lnoten, a__7[4] = noteq;
-#line 2196 ""
+#line 2188 ""
i__8[5] = 1, a__7[5] = all_1.sq;
-#line 2196 ""
+#line 2188 ""
i__8[6] = 3, a__7[6] = "slz";
-#line 2196 ""
+#line 2188 ""
s_cat(notexq, a__7, i__8, &c__7, (ftnlen)79);
/* * //sq//'stemcut' */
/* lnote=lnote+3+lnoten+8 */
-#line 2201 ""
+#line 2193 ""
*lnote = *lnote + 3 + lnoten + 4;
-#line 2202 ""
+#line 2194 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 2203 ""
+#line 2195 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2203 ""
+#line 2195 ""
i__5[1] = 1, a__4[1] = "h";
-#line 2203 ""
+#line 2195 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2203 ""
+#line 2195 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2203 ""
+#line 2195 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2204 ""
+#line 2196 ""
*lnote = lnoten + 3;
-#line 2205 ""
+#line 2197 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 2206 ""
+#line 2198 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2206 ""
+#line 2198 ""
i__5[1] = 1, a__4[1] = "c";
-#line 2206 ""
+#line 2198 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2206 ""
+#line 2198 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2206 ""
+#line 2198 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2207 ""
+#line 2199 ""
*lnote = lnoten + 3;
-#line 2208 ""
+#line 2200 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 2209 ""
+#line 2201 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2209 ""
+#line 2201 ""
i__5[1] = 2, a__4[1] = "cc";
-#line 2209 ""
+#line 2201 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2209 ""
+#line 2201 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2209 ""
+#line 2201 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2210 ""
+#line 2202 ""
*lnote = lnoten + 4;
-#line 2211 ""
+#line 2203 ""
} else if (multip == 3) {
/* Writing concatenation */
-#line 2212 ""
+#line 2204 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2212 ""
+#line 2204 ""
i__5[1] = 3, a__4[1] = "ccc";
-#line 2212 ""
+#line 2204 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2212 ""
+#line 2204 ""
i__5[3] = lnoten, a__4[3] = noteq;
-#line 2212 ""
+#line 2204 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2213 ""
+#line 2205 ""
*lnote = lnoten + 5;
-#line 2214 ""
+#line 2206 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2215 ""
+#line 2207 ""
i__7[0] = 1, a__6[0] = all_1.sq;
-#line 2215 ""
+#line 2207 ""
i__7[1] = 2, a__6[1] = "wh";
-#line 2215 ""
+#line 2207 ""
i__7[2] = lnoten, a__6[2] = noteq;
-#line 2215 ""
+#line 2207 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2216 ""
+#line 2208 ""
*lnote = lnoten + 3;
-#line 2217 ""
+#line 2209 ""
} else if (multip == -3) {
/* Writing concatenation */
-#line 2218 ""
+#line 2210 ""
i__7[0] = 1, a__6[0] = all_1.sq;
-#line 2218 ""
+#line 2210 ""
i__7[1] = 5, a__6[1] = "breve";
-#line 2218 ""
+#line 2210 ""
i__7[2] = lnoten, a__6[2] = noteq;
-#line 2218 ""
+#line 2210 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2219 ""
+#line 2211 ""
*lnote = lnoten + 6;
-#line 2220 ""
+#line 2212 ""
} else {
-#line 2221 ""
+#line 2213 ""
s_wsle(&io___155);
-#line 2221 ""
+#line 2213 ""
e_wsle();
-#line 2222 ""
+#line 2214 ""
s_wsle(&io___156);
-#line 2222 ""
+#line 2214 ""
do_lio(&c__9, &c__1, "(Error in beamend, send source to "\
"Dr. Don)", (ftnlen)42);
-#line 2222 ""
+#line 2214 ""
e_wsle();
-#line 2223 ""
+#line 2215 ""
stop1_();
-#line 2224 ""
+#line 2216 ""
}
-#line 2225 ""
+#line 2217 ""
} else {
/* Prior note is regular-dotted so this one is halved */
-#line 2229 ""
+#line 2221 ""
*lnote = lnoten + 3;
-#line 2230 ""
+#line 2222 ""
if (multip == 0) {
/* Writing concatenation */
-#line 2231 ""
+#line 2223 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2231 ""
+#line 2223 ""
i__5[1] = 1, a__4[1] = "c";
-#line 2231 ""
+#line 2223 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2231 ""
+#line 2223 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2231 ""
+#line 2223 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2232 ""
+#line 2224 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 2233 ""
+#line 2225 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2233 ""
+#line 2225 ""
i__5[1] = 1, a__4[1] = "q";
-#line 2233 ""
+#line 2225 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2233 ""
+#line 2225 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2233 ""
+#line 2225 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2234 ""
+#line 2226 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2235 ""
+#line 2227 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2235 ""
+#line 2227 ""
i__5[1] = 1, a__4[1] = "h";
-#line 2235 ""
+#line 2227 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2235 ""
+#line 2227 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2235 ""
+#line 2227 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2236 ""
+#line 2228 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 2237 ""
+#line 2229 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2237 ""
+#line 2229 ""
i__5[1] = 2, a__4[1] = "cc";
-#line 2237 ""
+#line 2229 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2237 ""
+#line 2229 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2237 ""
+#line 2229 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2238 ""
+#line 2230 ""
*lnote = lnoten + 4;
-#line 2239 ""
+#line 2231 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 2240 ""
+#line 2232 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2240 ""
+#line 2232 ""
i__5[1] = 3, a__4[1] = "ccc";
-#line 2240 ""
+#line 2232 ""
i__5[2] = 1, a__4[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2240 ""
+#line 2232 ""
i__5[3] = 8, a__4[3] = noteq;
-#line 2240 ""
+#line 2232 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2241 ""
+#line 2233 ""
*lnote = lnoten + 5;
-#line 2242 ""
+#line 2234 ""
}
-#line 2243 ""
+#line 2235 ""
}
-#line 2244 ""
+#line 2236 ""
}
-#line 2245 ""
+#line 2237 ""
return 0;
-#line 2246 ""
+#line 2238 ""
}
/* End of block for unbeamed. Problem if beamed but ends w/ rest. Try just */
/* skipping the call in that case. */
-#line 2251 ""
+#line 2243 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 2252 ""
+#line 2244 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2252 ""
+#line 2244 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2253 ""
+#line 2245 ""
}
/* call notefq(noteq,lnoten,nole,ncmid(iv,ip)) */
/* lnote = 0 */
/* New way, with flipend, which was computed in beamstrt. */
-#line 2259 ""
+#line 2251 ""
if (strtmid_1.flipend[commvl_1.ivx - 1] && bit_test(all_1.ipl[
commvl_1.ivx + ip * 24 - 25],30)) {
-#line 2260 ""
+#line 2252 ""
i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25];
-#line 2260 ""
+#line 2252 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 2260 ""
+#line 2252 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx
- 1] * 24 - 25] = *(unsigned char *)&ch__1[0];
-#line 2261 ""
+#line 2253 ""
strtmid_1.flipend[commvl_1.ivx - 1] = FALSE_;
-#line 2262 ""
+#line 2254 ""
}
-#line 2263 ""
+#line 2255 ""
if (ip > all_1.ibm1[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25]) {
/* This is not a one-noter from beam-jump. Check if multiplicity has increased */
-#line 2267 ""
+#line 2259 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],0)) {
/* Prior note is a rest, check one before that */
-#line 2271 ""
+#line 2263 ""
mp = (all_1.mult[commvl_1.ivx + (ip - 2) * 24 - 25] & 15) - 8;
-#line 2272 ""
+#line 2264 ""
} else {
-#line 2273 ""
+#line 2265 ""
mp = (all_1.mult[commvl_1.ivx + (ip - 1) * 24 - 25] & 15) - 8;
-#line 2274 ""
+#line 2266 ""
}
-#line 2275 ""
+#line 2267 ""
if (multip > mp) {
/* Assume 1-3, 2-3, or 1-2 */
-#line 2279 ""
+#line 2271 ""
i__1 = mp + 1;
-#line 2279 ""
+#line 2271 ""
for (imp = multip; imp >= i__1; --imp) {
-#line 2280 ""
+#line 2272 ""
ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
-#line 2281 ""
+#line 2273 ""
/* L2: */
-#line 2281 ""
+#line 2273 ""
}
-#line 2282 ""
+#line 2274 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27))
{
/* 2nd member of dotted xtup */
-#line 2286 ""
+#line 2278 ""
i__1 = multip + 1;
-#line 2286 ""
+#line 2278 ""
ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
-#line 2288 ""
+#line 2280 ""
}
-#line 2289 ""
+#line 2281 ""
}
/* Beam termination and direction analysis */
-#line 2293 ""
+#line 2285 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23) && !
combjmp_1.isbjmp) {
@@ -5870,470 +5864,470 @@ L1:
/* voice of the 2nd part of jumped beam. (May need special treatment for */
/* multi-segment jump-beams */
-#line 2300 ""
+#line 2292 ""
combjmp_1.isbjmp = TRUE_;
-#line 2301 ""
+#line 2293 ""
combjmp_1.ivbj1 = commvl_1.ivx;
-#line 2302 ""
+#line 2294 ""
combjmp_1.multbj1 = 15 & all_1.mult[commvl_1.ivx + ip * 24 - 25] - 8;
-#line 2303 ""
+#line 2295 ""
combjmp_1.ivbj2 = 0;
-#line 2304 ""
+#line 2296 ""
}
-#line 2305 ""
+#line 2297 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) {
/* This is either a normal beamend or end of a sequence of jump-beam segments, */
/* (170409) or rest at end of xtup */
/* so some sort of termination is required */
-#line 2311 ""
+#line 2303 ""
*(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
-#line 2312 ""
+#line 2304 ""
if (! combjmp_1.isbjmp || commvl_1.ivx != combjmp_1.ivbj2) {
-#line 2313 ""
+#line 2305 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
/* Xtup ends with rest */
-#line 2317 ""
+#line 2309 ""
if (multip == 1) {
/* Writing concatenation */
-#line 2318 ""
+#line 2310 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2318 ""
+#line 2310 ""
i__3[1] = 2, a__2[1] = "ds";
-#line 2318 ""
+#line 2310 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2319 ""
+#line 2311 ""
*lnote = 3;
-#line 2320 ""
+#line 2312 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 2321 ""
+#line 2313 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2321 ""
+#line 2313 ""
i__3[1] = 2, a__2[1] = "qs";
-#line 2321 ""
+#line 2313 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2322 ""
+#line 2314 ""
*lnote = 3;
-#line 2323 ""
+#line 2315 ""
} else if (multip == 3) {
/* Writing concatenation */
-#line 2324 ""
+#line 2316 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2324 ""
+#line 2316 ""
i__3[1] = 2, a__2[1] = "hs";
-#line 2324 ""
+#line 2316 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2325 ""
+#line 2317 ""
*lnote = 3;
-#line 2326 ""
+#line 2318 ""
}
/* 170801 Borrowed from main rest entry way down below to get level adjustment: */
/* BUT nole is like 102, not 2, so subtracted 100 for nole. Why different??? */
/* "... Now raise if necc." */
-#line 2332 ""
+#line 2324 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
/* Blank rest */
/* Writing concatenation */
-#line 2336 ""
+#line 2328 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2336 ""
+#line 2328 ""
i__3[1] = 2, a__2[1] = "sk";
-#line 2336 ""
+#line 2328 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2337 ""
+#line 2329 ""
*lnote = 3;
-#line 2338 ""
+#line 2330 ""
} else if (nole != 0) {
/* Bandaid. Odd case with rests in xtups + 2 voices where came thru here with */
/* nolev=-4 but expected 100+/-. Try to fix. */
-#line 2343 ""
+#line 2335 ""
if (abs(nole) < 30) {
-#line 2343 ""
+#line 2335 ""
nole += 100;
-#line 2343 ""
+#line 2335 ""
}
-#line 2345 ""
+#line 2337 ""
if ((i__1 = nole - 100, abs(i__1)) < 10) {
-#line 2346 ""
+#line 2338 ""
i__9 = (i__1 = nole - 100, abs(i__1)) + 48;
-#line 2346 ""
+#line 2338 ""
chax_(ch__1, (ftnlen)1, &i__9);
-#line 2346 ""
+#line 2338 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
-#line 2347 ""
+#line 2339 ""
lnoten = 1;
-#line 2348 ""
+#line 2340 ""
} else {
-#line 2349 ""
+#line 2341 ""
s_wsfi(&io___160);
-#line 2349 ""
+#line 2341 ""
i__9 = (i__1 = nole - 100, abs(i__1));
-#line 2349 ""
+#line 2341 ""
do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer));
-#line 2349 ""
+#line 2341 ""
e_wsfi();
-#line 2350 ""
+#line 2342 ""
lnoten = 2;
-#line 2351 ""
+#line 2343 ""
}
/* ??? if (nole .gt. 0) then */
-#line 2353 ""
+#line 2345 ""
if (nole > 100) {
/* Writing concatenation */
-#line 2354 ""
+#line 2346 ""
i__4[0] = 1, a__3[0] = all_1.sq;
-#line 2354 ""
+#line 2346 ""
i__4[1] = 5, a__3[1] = "raise";
-#line 2354 ""
+#line 2346 ""
i__4[2] = lnoten, a__3[2] = noteq;
-#line 2354 ""
+#line 2346 ""
i__4[3] = 1, a__3[3] = all_1.sq;
-#line 2354 ""
+#line 2346 ""
i__4[4] = 9, a__3[4] = "internote";
-#line 2354 ""
+#line 2346 ""
i__4[5] = *lnote, a__3[5] = notexq;
-#line 2354 ""
+#line 2346 ""
s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
-#line 2356 ""
+#line 2348 ""
} else {
/* Writing concatenation */
-#line 2357 ""
+#line 2349 ""
i__4[0] = 1, a__3[0] = all_1.sq;
-#line 2357 ""
+#line 2349 ""
i__4[1] = 5, a__3[1] = "lower";
-#line 2357 ""
+#line 2349 ""
i__4[2] = lnoten, a__3[2] = noteq;
-#line 2357 ""
+#line 2349 ""
i__4[3] = 1, a__3[3] = all_1.sq;
-#line 2357 ""
+#line 2349 ""
i__4[4] = 9, a__3[4] = "internote";
-#line 2357 ""
+#line 2349 ""
i__4[5] = *lnote, a__3[5] = notexq;
-#line 2357 ""
+#line 2349 ""
s_cat(notexq, a__3, i__4, &c__6, (ftnlen)79);
-#line 2359 ""
+#line 2351 ""
}
-#line 2360 ""
+#line 2352 ""
*lnote = lnoten + 16 + *lnote;
-#line 2361 ""
+#line 2353 ""
}
-#line 2362 ""
+#line 2354 ""
return 0;
-#line 2363 ""
+#line 2355 ""
} else {
/* Normal termination */
-#line 2367 ""
+#line 2359 ""
i__1 = commvl_1.ivx % 24;
-#line 2367 ""
+#line 2359 ""
ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
-#line 2368 ""
+#line 2360 ""
}
-#line 2369 ""
+#line 2361 ""
} else {
/* Terminate a sequence of jump-beam segments. */
-#line 2373 ""
+#line 2365 ""
i__1 = 225 - *(unsigned char *)ulqq;
-#line 2373 ""
+#line 2365 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 2373 ""
+#line 2365 ""
*(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
-#line 2374 ""
+#line 2366 ""
i__1 = combjmp_1.ivbj1 % 24;
-#line 2374 ""
+#line 2366 ""
ntrbbb_(&c__1, "t", ulqq, &i__1, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
-#line 2375 ""
+#line 2367 ""
}
-#line 2376 ""
+#line 2368 ""
}
/* Check for end of 2nd seg of staff-jump xtup chord blank rest */
/* if (isbjmp.and.ivx.eq.ivbj2 */
-#line 2381 ""
+#line 2373 ""
if (combjmp_1.isbjmp && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
29)) {
/* Writing concatenation */
-#line 2383 ""
+#line 2375 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2383 ""
+#line 2375 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2383 ""
+#line 2375 ""
i__7[2] = 2, a__6[2] = "sk";
-#line 2383 ""
+#line 2375 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2384 ""
+#line 2376 ""
return 0;
-#line 2385 ""
+#line 2377 ""
}
/* And now the note, checking for open-head beamed tremolo */
-#line 2389 ""
+#line 2381 ""
if (bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],2)) {
/* Check for dotted tremolo */
-#line 2393 ""
+#line 2385 ""
if ((r__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12.f -
all_1.nodur[commvl_1.ivx + ip * 24 - 25] / 12, dabs(r__1)) <
.001f) {
/* Need a dot */
-#line 2397 ""
+#line 2389 ""
if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 24 || all_1.nodur[
commvl_1.ivx + ip * 24 - 25] == 12) {
/* Solid notehead */
/* Writing concatenation */
-#line 2401 ""
+#line 2393 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2401 ""
+#line 2393 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2401 ""
+#line 2393 ""
i__7[2] = 3, a__6[2] = "qbp";
-#line 2401 ""
+#line 2393 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2402 ""
+#line 2394 ""
} else {
/* Assuming open notehead and nodur = 48 */
/* Writing concatenation */
-#line 2406 ""
+#line 2398 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2406 ""
+#line 2398 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2406 ""
+#line 2398 ""
i__7[2] = 3, a__6[2] = "hbp";
-#line 2406 ""
+#line 2398 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2407 ""
+#line 2399 ""
}
-#line 2408 ""
+#line 2400 ""
*lnote += 4;
-#line 2409 ""
+#line 2401 ""
} else {
-#line 2410 ""
+#line 2402 ""
if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 32 || all_1.nodur[
commvl_1.ivx + ip * 24 - 25] == 48) {
-#line 2411 ""
+#line 2403 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 2412 ""
+#line 2404 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2412 ""
+#line 2404 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2412 ""
+#line 2404 ""
i__7[2] = 2, a__6[2] = "hb";
-#line 2412 ""
+#line 2404 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2413 ""
+#line 2405 ""
} else {
/* Writing concatenation */
-#line 2414 ""
+#line 2406 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2414 ""
+#line 2406 ""
i__3[1] = 2, a__2[1] = "hb";
-#line 2414 ""
+#line 2406 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2415 ""
+#line 2407 ""
}
-#line 2416 ""
+#line 2408 ""
} else {
-#line 2417 ""
+#line 2409 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 2418 ""
+#line 2410 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2418 ""
+#line 2410 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2418 ""
+#line 2410 ""
i__7[2] = 2, a__6[2] = "qb";
-#line 2418 ""
+#line 2410 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2419 ""
+#line 2411 ""
} else {
/* Writing concatenation */
-#line 2420 ""
+#line 2412 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2420 ""
+#line 2412 ""
i__3[1] = 2, a__2[1] = "qb";
-#line 2420 ""
+#line 2412 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2421 ""
+#line 2413 ""
}
-#line 2422 ""
+#line 2414 ""
}
-#line 2423 ""
+#line 2415 ""
*lnote += 3;
-#line 2424 ""
+#line 2416 ""
}
-#line 2425 ""
+#line 2417 ""
} else {
/* No tremolo */
-#line 2429 ""
+#line 2421 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 2430 ""
+#line 2422 ""
i__7[0] = *lnote, a__6[0] = notexq;
-#line 2430 ""
+#line 2422 ""
i__7[1] = 1, a__6[1] = all_1.sq;
-#line 2430 ""
+#line 2422 ""
i__7[2] = 2, a__6[2] = "qb";
-#line 2430 ""
+#line 2422 ""
s_cat(notexq, a__6, i__7, &c__3, (ftnlen)79);
-#line 2431 ""
+#line 2423 ""
} else {
/* Writing concatenation */
-#line 2432 ""
+#line 2424 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2432 ""
+#line 2424 ""
i__3[1] = 2, a__2[1] = "qb";
-#line 2432 ""
+#line 2424 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2433 ""
+#line 2425 ""
}
-#line 2434 ""
+#line 2426 ""
*lnote += 3;
-#line 2435 ""
+#line 2427 ""
}
-#line 2436 ""
+#line 2428 ""
isdotm = FALSE_;
-#line 2437 ""
+#line 2429 ""
if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
-#line 2438 ""
+#line 2430 ""
i__1 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]);
-#line 2438 ""
+#line 2430 ""
if (pow_ii(&c__2, &i__1) != all_1.nodur[commvl_1.ivx + ip * 24 - 25])
{
-#line 2439 ""
+#line 2431 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
/* Writing concatenation */
-#line 2440 ""
+#line 2432 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2440 ""
+#line 2432 ""
i__3[1] = 1, a__2[1] = "p";
-#line 2440 ""
+#line 2432 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2441 ""
+#line 2433 ""
} else {
/* Writing concatenation */
-#line 2442 ""
+#line 2434 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2442 ""
+#line 2434 ""
i__3[1] = 1, a__2[1] = "m";
-#line 2442 ""
+#line 2434 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2443 ""
+#line 2435 ""
isdotm = TRUE_;
-#line 2444 ""
+#line 2436 ""
}
-#line 2445 ""
+#line 2437 ""
++(*lnote);
-#line 2446 ""
+#line 2438 ""
}
-#line 2447 ""
+#line 2439 ""
}
/* 5/25/08 Allow >12 */
/* 5/9/10 Up to 24; replace 24 with 0 */
-#line 2452 ""
+#line 2444 ""
if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
-#line 2453 ""
+#line 2445 ""
i__1 = commvl_1.ivx % 24;
-#line 2453 ""
+#line 2445 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
-#line 2454 ""
+#line 2446 ""
} else {
-#line 2455 ""
+#line 2447 ""
i__1 = combjmp_1.ivbj1 % 24;
-#line 2455 ""
+#line 2447 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
-#line 2456 ""
+#line 2448 ""
}
-#line 2457 ""
+#line 2449 ""
if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2 && ! bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],23)) {
-#line 2457 ""
+#line 2449 ""
combjmp_1.isbjmp = FALSE_;
-#line 2457 ""
+#line 2449 ""
}
/* Writing concatenation */
-#line 2459 ""
+#line 2451 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2459 ""
+#line 2451 ""
i__3[1] = len, a__2[1] = tempq;
-#line 2459 ""
+#line 2451 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2460 ""
+#line 2452 ""
*lnote += len;
/* Writing concatenation */
-#line 2461 ""
+#line 2453 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2461 ""
+#line 2453 ""
i__3[1] = lnoten, a__2[1] = noteq;
-#line 2461 ""
+#line 2453 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2462 ""
+#line 2454 ""
*lnote += lnoten;
-#line 2463 ""
+#line 2455 ""
if (isdotm) {
-#line 2464 ""
+#line 2456 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2465 ""
+#line 2457 ""
i__5[0] = *lnote, a__4[0] = notexq;
-#line 2465 ""
+#line 2457 ""
i__5[1] = 1, a__4[1] = "{";
-#line 2465 ""
+#line 2457 ""
i__5[2] = 1, a__4[2] = noteq;
-#line 2465 ""
+#line 2457 ""
i__5[3] = 1, a__4[3] = "}";
-#line 2465 ""
+#line 2457 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)79);
-#line 2466 ""
+#line 2458 ""
*lnote += 3;
-#line 2467 ""
+#line 2459 ""
} else {
-#line 2468 ""
+#line 2460 ""
i__1 = lnoten - 2;
/* Writing concatenation */
-#line 2468 ""
+#line 2460 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2468 ""
+#line 2460 ""
i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
-#line 2468 ""
+#line 2460 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2469 ""
+#line 2461 ""
++(*lnote);
-#line 2470 ""
+#line 2462 ""
}
-#line 2471 ""
+#line 2463 ""
}
-#line 2472 ""
+#line 2464 ""
return 0;
} /* beamend_ */
@@ -6380,28 +6374,28 @@ L1:
extern /* Subroutine */ int istring_(integer *, char *, integer *, ftnlen)
;
-#line 2502 ""
+#line 2494 ""
*lnote = 0;
-#line 2503 ""
+#line 2495 ""
ip = all_1.ipo[all_1.jn - 1];
-#line 2504 ""
+#line 2496 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
-#line 2508 ""
+#line 2500 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
-#line 2509 ""
+#line 2501 ""
--nole;
-#line 2510 ""
+#line 2502 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
-#line 2511 ""
+#line 2503 ""
++nole;
-#line 2512 ""
+#line 2504 ""
}
-#line 2513 ""
+#line 2505 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 2514 ""
+#line 2506 ""
multip = (all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8;
/* if (btest(islur(ivx,ip-1),3)) multip = multip+1 */
@@ -6411,173 +6405,173 @@ L1:
/* embedded xtup with number, due to ordering/octave feature. */
/* call notefq(noteq,lnoten,nolev(ivx,ip),ncmid(iv,ip)) */
-#line 2523 ""
+#line 2515 ""
}
-#line 2524 ""
+#line 2516 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],28)) {
-#line 2524 ""
+#line 2516 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
-#line 2524 ""
+#line 2516 ""
}
-#line 2525 ""
+#line 2517 ""
if (comxtup_1.vxtup[commvl_1.ivx - 1]) {
/* In an xtup */
-#line 2529 ""
+#line 2521 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
/* Intermediate rest in xtup, put in the rest. Reset nodur so notex works OK */
-#line 2533 ""
+#line 2525 ""
i__1 = 4 - ((all_1.mult[commvl_1.ivx + ip * 24 - 25] & 15) - 8);
-#line 2533 ""
+#line 2525 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &i__1);
-#line 2534 ""
+#line 2526 ""
notex_(notexq, lnote, (ftnlen)79);
/* Re-zero so next note does not get confused */
-#line 2538 ""
+#line 2530 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = 0;
-#line 2539 ""
+#line 2531 ""
return 0;
-#line 2540 ""
+#line 2532 ""
}
-#line 2541 ""
+#line 2533 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam, just put in the right kind of note */
-#line 2545 ""
+#line 2537 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],30)) {
/* Forced stem direction */
-#line 2549 ""
+#line 2541 ""
ndsav = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 2550 ""
+#line 2542 ""
i__1 = 4 - multip;
-#line 2550 ""
+#line 2542 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = pow_ii(&c__2, &
i__1);
-#line 2551 ""
+#line 2543 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) ||
bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27))
{
-#line 2553 ""
+#line 2545 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = all_1.nodur[
commvl_1.ivx + ip * 24 - 25] * 3 / 2;
-#line 2554 ""
+#line 2546 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 -
25],27)) {
-#line 2555 ""
+#line 2547 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] /= 2;
-#line 2556 ""
+#line 2548 ""
}
-#line 2557 ""
+#line 2549 ""
notex_(notexq, lnote, (ftnlen)79);
-#line 2558 ""
+#line 2550 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] = ndsav;
-#line 2559 ""
+#line 2551 ""
} else {
/* Use ulq for stem direction */
-#line 2563 ""
+#line 2555 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2563 ""
+#line 2555 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2564 ""
+#line 2556 ""
if (lnoten == 1) {
-#line 2564 ""
+#line 2556 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 2564 ""
+#line 2556 ""
}
-#line 2565 ""
+#line 2557 ""
*lnote = 3;
-#line 2566 ""
+#line 2558 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],
27)) {
/* Prior note of xtup is not regular-dotted */
-#line 2570 ""
+#line 2562 ""
if (multip == 0) {
/* Writing concatenation */
-#line 2571 ""
+#line 2563 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2571 ""
+#line 2563 ""
i__2[1] = 1, a__1[1] = "q";
-#line 2571 ""
+#line 2563 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2571 ""
+#line 2563 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2572 ""
+#line 2564 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 2573 ""
+#line 2565 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2573 ""
+#line 2565 ""
i__2[1] = 1, a__1[1] = "h";
-#line 2573 ""
+#line 2565 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2573 ""
+#line 2565 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2574 ""
+#line 2566 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 2575 ""
+#line 2567 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2575 ""
+#line 2567 ""
i__2[1] = 1, a__1[1] = "c";
-#line 2575 ""
+#line 2567 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2575 ""
+#line 2567 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2576 ""
+#line 2568 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 2577 ""
+#line 2569 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2577 ""
+#line 2569 ""
i__2[1] = 2, a__1[1] = "cc";
-#line 2577 ""
+#line 2569 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2577 ""
+#line 2569 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2578 ""
+#line 2570 ""
*lnote = 4;
-#line 2579 ""
+#line 2571 ""
} else if (multip == 3) {
/* Writing concatenation */
-#line 2580 ""
+#line 2572 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2580 ""
+#line 2572 ""
i__2[1] = 3, a__1[1] = "ccc";
-#line 2580 ""
+#line 2572 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2580 ""
+#line 2572 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2581 ""
+#line 2573 ""
*lnote = 5;
-#line 2582 ""
+#line 2574 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2583 ""
+#line 2575 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2583 ""
+#line 2575 ""
i__3[1] = 2, a__2[1] = "wh";
-#line 2583 ""
+#line 2575 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2584 ""
+#line 2576 ""
}
-#line 2585 ""
+#line 2577 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27))
{
@@ -6586,198 +6580,198 @@ L1:
/* notexq = notexq(1:3)//'p' */
/* lnote = 4 */
/* Writing concatenation */
-#line 2591 ""
+#line 2583 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2591 ""
+#line 2583 ""
i__3[1] = 1, a__2[1] = "p";
-#line 2591 ""
+#line 2583 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2592 ""
+#line 2584 ""
++(*lnote);
-#line 2593 ""
+#line 2585 ""
}
-#line 2594 ""
+#line 2586 ""
} else {
/* Prior note of xtup is regular-dotted so this one is halved */
-#line 2598 ""
+#line 2590 ""
if (multip == 2) {
/* Writing concatenation */
-#line 2599 ""
+#line 2591 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2599 ""
+#line 2591 ""
i__2[1] = 3, a__1[1] = "ccc";
-#line 2599 ""
+#line 2591 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2599 ""
+#line 2591 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2600 ""
+#line 2592 ""
*lnote = 5;
-#line 2601 ""
+#line 2593 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 2602 ""
+#line 2594 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2602 ""
+#line 2594 ""
i__2[1] = 2, a__1[1] = "cc";
-#line 2602 ""
+#line 2594 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2602 ""
+#line 2594 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2603 ""
+#line 2595 ""
*lnote = 4;
-#line 2604 ""
+#line 2596 ""
} else if (multip == 0) {
/* Writing concatenation */
-#line 2605 ""
+#line 2597 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2605 ""
+#line 2597 ""
i__2[1] = 1, a__1[1] = "c";
-#line 2605 ""
+#line 2597 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2605 ""
+#line 2597 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2606 ""
+#line 2598 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 2607 ""
+#line 2599 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2607 ""
+#line 2599 ""
i__2[1] = 1, a__1[1] = "q";
-#line 2607 ""
+#line 2599 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2607 ""
+#line 2599 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2608 ""
+#line 2600 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2609 ""
+#line 2601 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2609 ""
+#line 2601 ""
i__2[1] = 1, a__1[1] = "h";
-#line 2609 ""
+#line 2601 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2609 ""
+#line 2601 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2610 ""
+#line 2602 ""
}
-#line 2611 ""
+#line 2603 ""
}
/* Writing concatenation */
-#line 2612 ""
+#line 2604 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2612 ""
+#line 2604 ""
i__3[1] = 8, a__2[1] = noteq;
-#line 2612 ""
+#line 2604 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2613 ""
+#line 2605 ""
*lnote += lnoten;
-#line 2614 ""
+#line 2606 ""
}
-#line 2615 ""
+#line 2607 ""
return 0;
-#line 2616 ""
+#line 2608 ""
} else if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
/* In the beamed xtup but not the last note */
-#line 2620 ""
+#line 2612 ""
if (all_1.nodur[commvl_1.ivx + (ip - 1) * 24 - 25] > 0) {
/* Embedded Xtup, mult>0, starts here. Put in number if needed */
-#line 2624 ""
+#line 2616 ""
++comxtup_1.nxtinbm[commvl_1.ivx - 1];
-#line 2625 ""
+#line 2617 ""
iud = 1;
-#line 2626 ""
+#line 2618 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
-#line 2626 ""
+#line 2618 ""
iud = -1;
-#line 2626 ""
+#line 2618 ""
}
/* Get ip#, notelevel of middle note (or gap) in xtup */
-#line 2630 ""
+#line 2622 ""
ipmid = ip + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] / 2;
-#line 2631 ""
+#line 2623 ""
i__1 = ncmid_(&all_1.iv, &ipmid);
-#line 2631 ""
+#line 2623 ""
i__4 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
-#line 2631 ""
+#line 2623 ""
xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24
- 25], &all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &
iud, &i__1, &i__4);
-#line 2633 ""
+#line 2625 ""
if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] % 2 == 0) {
-#line 2633 ""
+#line 2625 ""
i__4 = ipmid - 1;
-#line 2633 ""
+#line 2625 ""
i__1 = ncmid_(&all_1.iv, &i__4);
-#line 2633 ""
+#line 2625 ""
i__5 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 -
25]) - 8;
-#line 2633 ""
+#line 2625 ""
xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (
ipmid - 1) * 24 - 25], &all_1.irest[commvl_1.ivx
+ (ipmid - 1) * 24 - 25], &iud, &i__1, &i__5)) /
2;
-#line 2633 ""
+#line 2625 ""
}
-#line 2636 ""
+#line 2628 ""
iflop = 0;
-#line 2637 ""
+#line 2629 ""
if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ip), dabs(r__1)) <
3.f) {
-#line 2637 ""
+#line 2629 ""
iflop = -iud;
-#line 2637 ""
+#line 2629 ""
}
-#line 2638 ""
+#line 2630 ""
iup = iud + (iflop << 1);
-#line 2639 ""
+#line 2631 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],14)) {
-#line 2640 ""
+#line 2632 ""
iup = -iup;
-#line 2641 ""
+#line 2633 ""
iflop = 0;
-#line 2642 ""
+#line 2634 ""
if (iud * iup < 0) {
-#line 2642 ""
+#line 2634 ""
iflop = iup;
-#line 2642 ""
+#line 2634 ""
}
-#line 2643 ""
+#line 2635 ""
}
/* Place number if needed */
-#line 2647 ""
+#line 2639 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],31)) {
-#line 2648 ""
+#line 2640 ""
mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 -
25], &c__5, &c__22);
-#line 2649 ""
+#line 2641 ""
if (mprint == 0) {
-#line 2649 ""
+#line 2641 ""
mprint = comxtup_1.mtupv[commvl_1.ivx +
comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25]
;
-#line 2649 ""
+#line 2641 ""
}
-#line 2650 ""
+#line 2642 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2650 ""
+#line 2642 ""
putxtn_(&mprint, &iflop, &multip, &iud, &comask_1.wheadpt,
&comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx
- 1], &comxtup_1.islope[commvl_1.ivx - 1], &
@@ -6788,47 +6782,47 @@ L1:
commvl_1.ivx + ip * 24 - 25], &all_1.mult[
commvl_1.ivx + ip * 24 - 25], &c_false, (ftnlen)
79);
-#line 2655 ""
+#line 2647 ""
}
-#line 2656 ""
+#line 2648 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2656 ""
+#line 2648 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2657 ""
+#line 2649 ""
} else {
/* Intermediate note of xtup */
-#line 2661 ""
+#line 2653 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2661 ""
+#line 2653 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2662 ""
+#line 2654 ""
}
-#line 2663 ""
+#line 2655 ""
} else {
/* Last note of xtup (but not last note of beam!) */
-#line 2667 ""
+#line 2659 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2667 ""
+#line 2659 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2668 ""
+#line 2660 ""
}
-#line 2669 ""
+#line 2661 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 2670 ""
+#line 2662 ""
notex_(notexq, lnote, (ftnlen)79);
-#line 2671 ""
+#line 2663 ""
return 0;
-#line 2672 ""
+#line 2664 ""
} else {
-#line 2673 ""
+#line 2665 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 2673 ""
+#line 2665 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2674 ""
+#line 2666 ""
}
/* Check for string of rests up to and including last note in xtup. */
@@ -6838,7 +6832,7 @@ L1:
/* break some unaccounted non-chordal staff-jum xtup situations. */
/* if (vxtup(ivx) .and. btest(irest(ivx,ip+1),0) .and. */
/* * .not.btest(irest(ivx,ip),0)) then */
-#line 2683 ""
+#line 2675 ""
if (comxtup_1.vxtup[commvl_1.ivx - 1] && bit_test(all_1.irest[
commvl_1.ivx + (ip + 1) * 24 - 25],0) && ! bit_test(all_1.irest[
commvl_1.ivx + ip * 24 - 25],0) && ! (combjmp_1.isbjmp &&
@@ -6847,379 +6841,379 @@ L1:
/* This note is not a rest but next is a rest. Do rests continue to */
/* end of xtup, where nodur>0 */
-#line 2690 ""
+#line 2682 ""
i__1 = ip + 24;
-#line 2690 ""
+#line 2682 ""
for (ipnow = ip + 1; ipnow <= i__1; ++ipnow) {
-#line 2691 ""
+#line 2683 ""
if (all_1.nodur[commvl_1.ivx + ipnow * 24 - 25] > 0) {
-#line 2691 ""
+#line 2683 ""
goto L4;
-#line 2691 ""
+#line 2683 ""
}
/* This is last of xtup */
-#line 2692 ""
+#line 2684 ""
if (! bit_test(all_1.irest[commvl_1.ivx + (ipnow + 1) * 24 - 25],
0)) {
-#line 2692 ""
+#line 2684 ""
goto L5;
-#line 2692 ""
+#line 2684 ""
}
/* If I don't go to 5, know next note IS a rest! */
/* Next is not */
-#line 2696 ""
+#line 2688 ""
/* L3: */
-#line 2696 ""
+#line 2688 ""
}
-#line 2697 ""
+#line 2689 ""
L4:
-#line 2698 ""
+#line 2690 ""
ntrbbb_(&c__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq, lnote, (
ftnlen)1, (ftnlen)1, (ftnlen)79);
/* Writing concatenation */
-#line 2699 ""
+#line 2691 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 2699 ""
+#line 2691 ""
i__2[1] = 1, a__1[1] = all_1.sq;
-#line 2699 ""
+#line 2691 ""
i__2[2] = 2, a__1[2] = "qb";
-#line 2699 ""
+#line 2691 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2700 ""
+#line 2692 ""
*lnote += 3;
-#line 2701 ""
+#line 2693 ""
istring_(&commvl_1.ivx, tempq, &len, (ftnlen)4);
/* Writing concatenation */
-#line 2702 ""
+#line 2694 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2702 ""
+#line 2694 ""
i__3[1] = len, a__2[1] = tempq;
-#line 2702 ""
+#line 2694 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2703 ""
+#line 2695 ""
*lnote += len;
/* Writing concatenation */
-#line 2704 ""
+#line 2696 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2704 ""
+#line 2696 ""
i__3[1] = lnoten, a__2[1] = noteq;
-#line 2704 ""
+#line 2696 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2705 ""
+#line 2697 ""
*lnote += lnoten;
-#line 2706 ""
+#line 2698 ""
return 0;
-#line 2707 ""
+#line 2699 ""
L5:
/* Check if multiplicity changes in a way requiring action, */
/* unless (160211) it's blank rest on start of 2nd seg of joined beam */
-#line 2712 ""
+#line 2704 ""
;
-#line 2712 ""
+#line 2704 ""
} else if (! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],24)
|| ! bit_test(all_1.islur[commvl_1.ivx + (ip - 1) * 24 - 25],29))
{
-#line 2714 ""
+#line 2706 ""
ipleft = ip - 1;
-#line 2715 ""
+#line 2707 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipleft * 24 - 25],0)) {
-#line 2715 ""
+#line 2707 ""
--ipleft;
-#line 2715 ""
+#line 2707 ""
}
-#line 2716 ""
+#line 2708 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipleft * 24 - 25],20)) {
-#line 2717 ""
+#line 2709 ""
multl = (15 & all_1.mult[commvl_1.ivx + ipleft * 24 - 25]) - 8;
-#line 2718 ""
+#line 2710 ""
} else {
-#line 2719 ""
+#line 2711 ""
multl = 1;
-#line 2720 ""
+#line 2712 ""
}
-#line 2721 ""
+#line 2713 ""
mub = multip - multl;
-#line 2722 ""
+#line 2714 ""
ipright = ip + 1;
-#line 2723 ""
+#line 2715 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipright * 24 - 25],0)) {
-#line 2723 ""
+#line 2715 ""
++ipright;
-#line 2723 ""
+#line 2715 ""
}
-#line 2724 ""
+#line 2716 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],20)) {
-#line 2725 ""
+#line 2717 ""
multr = (15 & all_1.mult[commvl_1.ivx + ipright * 24 - 25]) - 8;
-#line 2726 ""
+#line 2718 ""
} else {
-#line 2727 ""
+#line 2719 ""
multr = 1;
-#line 2728 ""
+#line 2720 ""
}
-#line 2729 ""
+#line 2721 ""
mua = multr - multip;
-#line 2730 ""
+#line 2722 ""
if (mub > 0 || mua < 0) {
/* Multiplicity has increased from left or will decrease to right. Need action. */
-#line 2734 ""
+#line 2726 ""
if (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2) {
-#line 2735 ""
+#line 2727 ""
ivb = combjmp_1.ivbj1;
-#line 2736 ""
+#line 2728 ""
i__1 = 225 - *(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25];
-#line 2736 ""
+#line 2728 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 2736 ""
+#line 2728 ""
*(unsigned char *)ulqq = *(unsigned char *)&ch__1[0];
-#line 2737 ""
+#line 2729 ""
} else {
-#line 2738 ""
+#line 2730 ""
ivb = commvl_1.ivx;
-#line 2739 ""
+#line 2731 ""
*(unsigned char *)ulqq = *(unsigned char *)&all_1.ulq[
commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 -
25];
-#line 2740 ""
+#line 2732 ""
}
-#line 2741 ""
+#line 2733 ""
if (mua >= 0) {
-#line 2742 ""
+#line 2734 ""
ntrbbb_(&multip, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
/* Test for next note being blank rest, assuming staff-crossing */
/* xtup chord */
-#line 2747 ""
+#line 2739 ""
} else if (multl >= multr && ! bit_test(all_1.islur[commvl_1.ivx
+ (ip + 1) * 24 - 25],29)) {
-#line 2749 ""
+#line 2741 ""
i__1 = multr + 1;
-#line 2749 ""
+#line 2741 ""
for (im = multip; im >= i__1; --im) {
-#line 2750 ""
+#line 2742 ""
ntrbbb_(&im, "t", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
-#line 2751 ""
+#line 2743 ""
/* L1: */
-#line 2751 ""
+#line 2743 ""
}
/* else */
/* Test for next note being blank rest, assuming staff-crossing */
/* xtup chord */
-#line 2756 ""
+#line 2748 ""
} else if (! bit_test(all_1.islur[commvl_1.ivx + (ip + 1) * 24 -
25],29)) {
-#line 2757 ""
+#line 2749 ""
i__1 = multip;
-#line 2757 ""
+#line 2749 ""
for (im = multr + 1; im <= i__1; ++im) {
-#line 2758 ""
+#line 2750 ""
ntrbbb_(&im, "r", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
-#line 2759 ""
+#line 2751 ""
/* L2: */
-#line 2759 ""
+#line 2751 ""
}
-#line 2760 ""
+#line 2752 ""
ntrbbb_(&multr, "n", ulqq, &ivb, notexq, lnote, (ftnlen)1, (
ftnlen)1, (ftnlen)79);
-#line 2761 ""
+#line 2753 ""
}
-#line 2762 ""
+#line 2754 ""
} else if (ip > 1) {
/* Check for 2nd member of dotted xtup */
-#line 2766 ""
+#line 2758 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (ip - 1) * 24 - 25],27)) {
-#line 2766 ""
+#line 2758 ""
i__1 = multip + 1;
-#line 2766 ""
+#line 2758 ""
ntrbbb_(&i__1, "t", all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &commvl_1.ivx, notexq,
lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
-#line 2766 ""
+#line 2758 ""
}
-#line 2768 ""
+#line 2760 ""
}
-#line 2769 ""
+#line 2761 ""
}
/* Now put in the note */
-#line 2773 ""
+#line 2765 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 2774 ""
+#line 2766 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 2774 ""
+#line 2766 ""
i__2[1] = 1, a__1[1] = all_1.sq;
-#line 2774 ""
+#line 2766 ""
i__2[2] = 2, a__1[2] = "qb";
-#line 2774 ""
+#line 2766 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2775 ""
+#line 2767 ""
} else {
/* Writing concatenation */
-#line 2776 ""
+#line 2768 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2776 ""
+#line 2768 ""
i__3[1] = 2, a__2[1] = "qb";
-#line 2776 ""
+#line 2768 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2777 ""
+#line 2769 ""
}
-#line 2778 ""
+#line 2770 ""
*lnote += 3;
-#line 2779 ""
+#line 2771 ""
isdotm = FALSE_;
-#line 2780 ""
+#line 2772 ""
if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
/* rule out ')' */
-#line 2784 ""
+#line 2776 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
-#line 2785 ""
+#line 2777 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
/* Writing concatenation */
-#line 2786 ""
+#line 2778 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2786 ""
+#line 2778 ""
i__3[1] = 1, a__2[1] = "p";
-#line 2786 ""
+#line 2778 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2787 ""
+#line 2779 ""
} else {
/* Double dot */
/* Writing concatenation */
-#line 2791 ""
+#line 2783 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2791 ""
+#line 2783 ""
i__3[1] = 2, a__2[1] = "pp";
-#line 2791 ""
+#line 2783 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2792 ""
+#line 2784 ""
++(*lnote);
-#line 2793 ""
+#line 2785 ""
}
-#line 2794 ""
+#line 2786 ""
} else {
/* Writing concatenation */
-#line 2795 ""
+#line 2787 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2795 ""
+#line 2787 ""
i__3[1] = 1, a__2[1] = "m";
-#line 2795 ""
+#line 2787 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2796 ""
+#line 2788 ""
isdotm = TRUE_;
-#line 2797 ""
+#line 2789 ""
}
-#line 2798 ""
+#line 2790 ""
++(*lnote);
-#line 2799 ""
+#line 2791 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19) ||
bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],27)) {
/* Special dotted notation for 2:1 xtup, or normal dot in xtup */
/* Writing concatenation */
-#line 2804 ""
+#line 2796 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2804 ""
+#line 2796 ""
i__3[1] = 1, a__2[1] = "p";
-#line 2804 ""
+#line 2796 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2805 ""
+#line 2797 ""
++(*lnote);
-#line 2806 ""
+#line 2798 ""
}
/* 5/25/08 Allow >12 */
-#line 2810 ""
+#line 2802 ""
if (! (combjmp_1.isbjmp && commvl_1.ivx == combjmp_1.ivbj2)) {
/* call istring(mod(ivx,12),tempq,len) */
-#line 2812 ""
+#line 2804 ""
i__1 = commvl_1.ivx % 24;
-#line 2812 ""
+#line 2804 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
-#line 2813 ""
+#line 2805 ""
} else {
/* call istring(mod(ivbj1,12),tempq,len) */
-#line 2815 ""
+#line 2807 ""
i__1 = combjmp_1.ivbj1 % 24;
-#line 2815 ""
+#line 2807 ""
istring_(&i__1, tempq, &len, (ftnlen)4);
-#line 2816 ""
+#line 2808 ""
}
/* Writing concatenation */
-#line 2817 ""
+#line 2809 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2817 ""
+#line 2809 ""
i__3[1] = len, a__2[1] = tempq;
-#line 2817 ""
+#line 2809 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2818 ""
+#line 2810 ""
*lnote += len;
/* Writing concatenation */
-#line 2819 ""
+#line 2811 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2819 ""
+#line 2811 ""
i__3[1] = lnoten, a__2[1] = noteq;
-#line 2819 ""
+#line 2811 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2820 ""
+#line 2812 ""
*lnote += lnoten;
-#line 2821 ""
+#line 2813 ""
if (isdotm) {
-#line 2822 ""
+#line 2814 ""
if (lnoten == 2) {
/* Writing concatenation */
-#line 2823 ""
+#line 2815 ""
i__6[0] = *lnote, a__3[0] = notexq;
-#line 2823 ""
+#line 2815 ""
i__6[1] = 1, a__3[1] = "{";
-#line 2823 ""
+#line 2815 ""
i__6[2] = 1, a__3[2] = noteq + 1;
-#line 2823 ""
+#line 2815 ""
i__6[3] = 1, a__3[3] = "}";
-#line 2823 ""
+#line 2815 ""
s_cat(notexq, a__3, i__6, &c__4, (ftnlen)79);
-#line 2824 ""
+#line 2816 ""
*lnote += 3;
-#line 2825 ""
+#line 2817 ""
} else {
-#line 2826 ""
+#line 2818 ""
i__1 = lnoten - 2;
/* Writing concatenation */
-#line 2826 ""
+#line 2818 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2826 ""
+#line 2818 ""
i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
-#line 2826 ""
+#line 2818 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2827 ""
+#line 2819 ""
++(*lnote);
-#line 2828 ""
+#line 2820 ""
}
-#line 2829 ""
+#line 2821 ""
}
-#line 2830 ""
+#line 2822 ""
return 0;
} /* beamid_ */
@@ -7268,91 +7262,91 @@ L5:
static cilist io___202 = { 0, 6, 0, 0, 0 };
-#line 2857 ""
+#line 2849 ""
gotnote = FALSE_;
-#line 2858 ""
+#line 2850 ""
lnoten = 0;
-#line 2859 ""
+#line 2851 ""
ip1 = all_1.ipo[all_1.jn - 1];
-#line 2860 ""
+#line 2852 ""
multip = (15 & all_1.mult[commvl_1.ivx + ip1 * 24 - 25]) - 8;
-#line 2861 ""
+#line 2853 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1] && bit_test(all_1.irest[
commvl_1.ivx + ip1 * 24 - 25],0)) {
-#line 2862 ""
+#line 2854 ""
*lnote = 0;
/* The rest was already written in beamstrt, so just get out of here */
-#line 2866 ""
+#line 2858 ""
return 0;
-#line 2867 ""
+#line 2859 ""
}
-#line 2868 ""
+#line 2860 ""
nole = all_1.nolev[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
-#line 2872 ""
+#line 2864 ""
if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25],
30)) {
-#line 2873 ""
+#line 2865 ""
--nole;
-#line 2874 ""
+#line 2866 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + all_1.ipo[all_1.jn - 1] *
24 - 25],31)) {
-#line 2875 ""
+#line 2867 ""
++nole;
-#line 2876 ""
+#line 2868 ""
}
-#line 2877 ""
+#line 2869 ""
if (comxtup_1.vxtup[commvl_1.ivx - 1] && ! comdraw_1.drawbm[commvl_1.ivx
- 1]) {
/* Xtuplet with no beam, just put in the right kind of note */
-#line 2881 ""
+#line 2873 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],30)) {
/* Forced stem direction */
-#line 2885 ""
+#line 2877 ""
ndsav = all_1.nodur[commvl_1.ivx + ip1 * 24 - 25];
-#line 2886 ""
+#line 2878 ""
i__1 = 4 - multip;
-#line 2886 ""
+#line 2878 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = pow_ii(&c__2, &i__1);
-#line 2887 ""
+#line 2879 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
-#line 2887 ""
+#line 2879 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = all_1.nodur[
commvl_1.ivx + ip1 * 24 - 25] * 3 / 2;
-#line 2887 ""
+#line 2879 ""
}
-#line 2889 ""
+#line 2881 ""
notex_(notexq, lnote, (ftnlen)79);
-#line 2890 ""
+#line 2882 ""
all_1.nodur[commvl_1.ivx + ip1 * 24 - 25] = ndsav;
-#line 2891 ""
+#line 2883 ""
} else {
-#line 2892 ""
+#line 2884 ""
i__1 = ncmid_(&all_1.iv, &ip1);
-#line 2892 ""
+#line 2884 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2893 ""
+#line 2885 ""
gotnote = TRUE_;
-#line 2894 ""
+#line 2886 ""
if (lnoten == 1) {
-#line 2894 ""
+#line 2886 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 2894 ""
+#line 2886 ""
}
-#line 2895 ""
+#line 2887 ""
*lnote = 3;
-#line 2896 ""
+#line 2888 ""
if (multip <= 0) {
-#line 2897 ""
+#line 2889 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) &&
all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32
|| multip == -1) {
@@ -7360,42 +7354,42 @@ L5:
/* 1st note of unbeamed half-note trem; make open */
/* Writing concatenation */
-#line 2903 ""
+#line 2895 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2903 ""
+#line 2895 ""
i__2[1] = 1, a__1[1] = "h";
-#line 2903 ""
+#line 2895 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2903 ""
+#line 2895 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2904 ""
+#line 2896 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2905 ""
+#line 2897 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2905 ""
+#line 2897 ""
i__3[1] = 2, a__2[1] = "wh";
-#line 2905 ""
+#line 2897 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2906 ""
+#line 2898 ""
} else {
/* Writing concatenation */
-#line 2907 ""
+#line 2899 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2907 ""
+#line 2899 ""
i__2[1] = 1, a__1[1] = "q";
-#line 2907 ""
+#line 2899 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2907 ""
+#line 2899 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2908 ""
+#line 2900 ""
}
/* Check for dot */
-#line 2912 ""
+#line 2904 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (
r__1 = all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25]
/ 12.f - all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 -
@@ -7403,85 +7397,85 @@ L5:
/* Need a dot. already called addblank for noteq */
-#line 2917 ""
+#line 2909 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 2918 ""
+#line 2910 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2918 ""
+#line 2910 ""
i__2[1] = 2, a__1[1] = "pt";
-#line 2918 ""
+#line 2910 ""
i__2[2] = lnoten, a__1[2] = noteq;
-#line 2918 ""
+#line 2910 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2919 ""
+#line 2911 ""
*lnote = lnoten + 3;
-#line 2920 ""
+#line 2912 ""
} else {
/* Writing concatenation */
-#line 2921 ""
+#line 2913 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 2921 ""
+#line 2913 ""
i__3[1] = 1, a__2[1] = "p";
-#line 2921 ""
+#line 2913 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2922 ""
+#line 2914 ""
++(*lnote);
-#line 2923 ""
+#line 2915 ""
}
-#line 2924 ""
+#line 2916 ""
}
/* Insert the stemlength calcs here for dotted, unbeamed. */
/* Later may combine with below to avoid repeat. */
-#line 2929 ""
+#line 2921 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2)) {
-#line 2930 ""
+#line 2922 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24
- 25], &c__2, &c__5);
-#line 2931 ""
+#line 2923 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] == 'u')
{
-#line 2932 ""
+#line 2924 ""
slen = (nindent + 4.5f + comxtup_1.nolev1[
commvl_1.ivx - 1] - nole - comxtup_1.islope[
commvl_1.ivx - 1] * .4f / all_1.slfac) *
.6667f;
-#line 2934 ""
+#line 2926 ""
} else {
-#line 2935 ""
+#line 2927 ""
slen = (nindent + 4.5f - comxtup_1.nolev1[
commvl_1.ivx - 1] + nole + comxtup_1.islope[
commvl_1.ivx - 1] * .4f / all_1.slfac) *
.6667f;
-#line 2937 ""
+#line 2929 ""
}
-#line 2938 ""
+#line 2930 ""
s_wsfi(&io___199);
-#line 2938 ""
+#line 2930 ""
do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
-#line 2938 ""
+#line 2930 ""
e_wsfi();
/* Writing concatenation */
-#line 2939 ""
+#line 2931 ""
i__4[0] = 1, a__3[0] = all_1.sq;
-#line 2939 ""
+#line 2931 ""
i__4[1] = 4, a__3[1] = "slx{";
-#line 2939 ""
+#line 2931 ""
i__4[2] = 4, a__3[2] = tempq;
-#line 2939 ""
+#line 2931 ""
i__4[3] = 1, a__3[3] = "}";
-#line 2939 ""
+#line 2931 ""
i__4[4] = *lnote, a__3[4] = notexq;
-#line 2939 ""
+#line 2931 ""
s_cat(notexq, a__3, i__4, &c__5, (ftnlen)79);
-#line 2941 ""
+#line 2933 ""
*lnote += 10;
-#line 2942 ""
+#line 2934 ""
}
-#line 2943 ""
+#line 2935 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2))
{
@@ -7490,389 +7484,389 @@ L5:
/* Stem length calcs here. The .2 factor is empirical, but */
/* slfac accounts for musicsize. */
-#line 2950 ""
+#line 2942 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + ip1 * 24 - 25]
, &c__2, &c__5);
-#line 2951 ""
+#line 2943 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
-#line 2952 ""
+#line 2944 ""
slen = (nindent + 4.5f + comxtup_1.nolev1[commvl_1.ivx -
1] - nole - comxtup_1.islope[commvl_1.ivx - 1] *
.4f / all_1.slfac) * .6667f;
-#line 2954 ""
+#line 2946 ""
} else {
-#line 2955 ""
+#line 2947 ""
slen = (nindent + 4.5f - comxtup_1.nolev1[commvl_1.ivx -
1] + nole + comxtup_1.islope[commvl_1.ivx - 1] *
.4f / all_1.slfac) * .6667f;
-#line 2957 ""
+#line 2949 ""
}
-#line 2958 ""
+#line 2950 ""
s_wsfi(&io___200);
-#line 2958 ""
+#line 2950 ""
do_fio(&c__1, (char *)&slen, (ftnlen)sizeof(real));
-#line 2958 ""
+#line 2950 ""
e_wsfi();
/* Writing concatenation */
-#line 2959 ""
+#line 2951 ""
i__5[0] = 1, a__4[0] = all_1.sq;
-#line 2959 ""
+#line 2951 ""
i__5[1] = 4, a__4[1] = "slx{";
-#line 2959 ""
+#line 2951 ""
i__5[2] = 4, a__4[2] = tempq;
-#line 2959 ""
+#line 2951 ""
i__5[3] = 1, a__4[3] = "}";
-#line 2959 ""
+#line 2951 ""
i__5[4] = 1, a__4[4] = all_1.sq;
-#line 2959 ""
+#line 2951 ""
i__5[5] = 1, a__4[5] = "q";
-#line 2959 ""
+#line 2951 ""
i__5[6] = 1, a__4[6] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2959 ""
+#line 2951 ""
s_cat(notexq, a__4, i__5, &c__7, (ftnlen)79);
-#line 2961 ""
+#line 2953 ""
*lnote = 13;
/* Check for dotted 2-note trem; prepend dot to notexq if needed */
-#line 2965 ""
+#line 2957 ""
if (all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 ||
all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24)
{
-#line 2967 ""
+#line 2959 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2968 ""
+#line 2960 ""
i__3[0] = 1, a__2[0] = " ";
-#line 2968 ""
+#line 2960 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 2968 ""
+#line 2960 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 2969 ""
+#line 2961 ""
lnoten = 2;
-#line 2970 ""
+#line 2962 ""
}
/* Writing concatenation */
-#line 2971 ""
+#line 2963 ""
i__6[0] = 1, a__5[0] = all_1.sq;
-#line 2971 ""
+#line 2963 ""
i__6[1] = 2, a__5[1] = "pt";
-#line 2971 ""
+#line 2963 ""
i__6[2] = lnoten, a__5[2] = noteq;
-#line 2971 ""
+#line 2963 ""
i__6[3] = *lnote, a__5[3] = notexq;
-#line 2971 ""
+#line 2963 ""
s_cat(notexq, a__5, i__6, &c__4, (ftnlen)79);
-#line 2972 ""
+#line 2964 ""
*lnote = *lnote + 3 + lnoten;
-#line 2973 ""
+#line 2965 ""
i__1 = ncmid_(&all_1.iv, &ip1);
-#line 2973 ""
+#line 2965 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 2974 ""
+#line 2966 ""
gotnote = TRUE_;
-#line 2975 ""
+#line 2967 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 2976 ""
+#line 2968 ""
i__3[0] = 1, a__2[0] = " ";
-#line 2976 ""
+#line 2968 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 2976 ""
+#line 2968 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 2977 ""
+#line 2969 ""
lnoten = 2;
-#line 2978 ""
+#line 2970 ""
}
-#line 2979 ""
+#line 2971 ""
}
-#line 2980 ""
+#line 2972 ""
} else if (multip == -1) {
/* Writing concatenation */
-#line 2981 ""
+#line 2973 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2981 ""
+#line 2973 ""
i__2[1] = 1, a__1[1] = "h";
-#line 2981 ""
+#line 2973 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2981 ""
+#line 2973 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2982 ""
+#line 2974 ""
} else if (multip == 1) {
/* Writing concatenation */
-#line 2983 ""
+#line 2975 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2983 ""
+#line 2975 ""
i__2[1] = 1, a__1[1] = "c";
-#line 2983 ""
+#line 2975 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2983 ""
+#line 2975 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2984 ""
+#line 2976 ""
} else if (multip == 2) {
/* Writing concatenation */
-#line 2985 ""
+#line 2977 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2985 ""
+#line 2977 ""
i__2[1] = 2, a__1[1] = "cc";
-#line 2985 ""
+#line 2977 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2985 ""
+#line 2977 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2986 ""
+#line 2978 ""
*lnote = 4;
-#line 2987 ""
+#line 2979 ""
} else if (multip == 3) {
/* Writing concatenation */
-#line 2988 ""
+#line 2980 ""
i__2[0] = 1, a__1[0] = all_1.sq;
-#line 2988 ""
+#line 2980 ""
i__2[1] = 3, a__1[1] = "ccc";
-#line 2988 ""
+#line 2980 ""
i__2[2] = 1, a__1[2] = all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25);
-#line 2988 ""
+#line 2980 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 2989 ""
+#line 2981 ""
*lnote = 5;
-#line 2990 ""
+#line 2982 ""
} else if (multip == -2) {
/* Writing concatenation */
-#line 2991 ""
+#line 2983 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2991 ""
+#line 2983 ""
i__3[1] = 2, a__2[1] = "wh";
-#line 2991 ""
+#line 2983 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2992 ""
+#line 2984 ""
} else if (multip == -3) {
/* Writing concatenation */
-#line 2993 ""
+#line 2985 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 2993 ""
+#line 2985 ""
i__3[1] = 5, a__2[1] = "breve";
-#line 2993 ""
+#line 2985 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 2994 ""
+#line 2986 ""
*lnote = 6;
-#line 2995 ""
+#line 2987 ""
} else {
-#line 2996 ""
+#line 2988 ""
s_wsle(&io___201);
-#line 2996 ""
+#line 2988 ""
e_wsle();
-#line 2997 ""
+#line 2989 ""
s_wsle(&io___202);
-#line 2997 ""
+#line 2989 ""
do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D"\
"on)", (ftnlen)41);
-#line 2997 ""
+#line 2989 ""
e_wsle();
-#line 2998 ""
+#line 2990 ""
stop1_();
-#line 2999 ""
+#line 2991 ""
}
-#line 3000 ""
+#line 2992 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
/* notexq = notexq(1:3)//'p' */
/* lnote = 4 */
/* Writing concatenation */
-#line 3003 ""
+#line 2995 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3003 ""
+#line 2995 ""
i__3[1] = 1, a__2[1] = "p";
-#line 3003 ""
+#line 2995 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3004 ""
+#line 2996 ""
++(*lnote);
-#line 3005 ""
+#line 2997 ""
}
/* Writing concatenation */
-#line 3006 ""
+#line 2998 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3006 ""
+#line 2998 ""
i__3[1] = 8, a__2[1] = noteq;
-#line 3006 ""
+#line 2998 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3007 ""
+#line 2999 ""
*lnote += lnoten;
-#line 3008 ""
+#line 3000 ""
}
-#line 3009 ""
+#line 3001 ""
return 0;
-#line 3010 ""
+#line 3002 ""
}
/* Check if mult. decreases from 1st note to 2nd */
-#line 3014 ""
+#line 3006 ""
if (all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25] >
ip1 || bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) {
/* More than one note or single-note before a multiplicity-down-up "][" */
-#line 3019 ""
+#line 3011 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],20)) {
-#line 3020 ""
+#line 3012 ""
multr = 1;
-#line 3021 ""
+#line 3013 ""
} else if (! bit_test(all_1.irest[commvl_1.ivx + (ip1 + 1) * 24 - 25],
0)) {
-#line 3022 ""
+#line 3014 ""
multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 1) * 24 - 25]) - 8;
-#line 3023 ""
+#line 3015 ""
} else {
-#line 3024 ""
+#line 3016 ""
multr = (15 & all_1.mult[commvl_1.ivx + (ip1 + 2) * 24 - 25]) - 8;
-#line 3025 ""
+#line 3017 ""
}
-#line 3026 ""
+#line 3018 ""
*lnote = 0;
/* Check if staff-jumper */
-#line 3030 ""
+#line 3022 ""
if (combjmp_1.isbjmp && combjmp_1.ivbj2 > 0) {
-#line 3031 ""
+#line 3023 ""
ivxp = combjmp_1.ivbj1;
-#line 3032 ""
+#line 3024 ""
} else {
-#line 3033 ""
+#line 3025 ""
ivxp = commvl_1.ivx;
-#line 3034 ""
+#line 3026 ""
}
-#line 3035 ""
+#line 3027 ""
if (multr < multip) {
-#line 3036 ""
+#line 3028 ""
i__1 = multr + 1;
-#line 3036 ""
+#line 3028 ""
for (im = multip; im >= i__1; --im) {
/* Right-shifted 'termination' */
-#line 3040 ""
+#line 3032 ""
if (combjmp_1.isbjmp && combjmp_1.ivbj2 > 0) {
/* Jump beam */
-#line 3044 ""
+#line 3036 ""
ntrbbb_(&im, "t", all_1.ulq + (ivxp + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &ivxp, notexq,
lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
-#line 3046 ""
+#line 3038 ""
} else {
/* Same staff */
-#line 3050 ""
+#line 3042 ""
ntrbbb_(&im, "r", all_1.ulq + (commvl_1.ivx +
all_1.ibmcnt[commvl_1.ivx - 1] * 24 - 25), &ivxp,
notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
-#line 3051 ""
+#line 3043 ""
}
-#line 3052 ""
+#line 3044 ""
/* L1: */
-#line 3052 ""
+#line 3044 ""
}
-#line 3053 ""
+#line 3045 ""
}
-#line 3054 ""
+#line 3046 ""
}
/* Check for beamed, dotted 2-note tremolo */
-#line 3058 ""
+#line 3050 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (r__1 =
all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12.f -
all_1.nodur[commvl_1.ivx + (ip1 + 1) * 24 - 25] / 12, dabs(r__1))
< .001f) {
-#line 3060 ""
+#line 3052 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 3060 ""
+#line 3052 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 3061 ""
+#line 3053 ""
gotnote = TRUE_;
-#line 3062 ""
+#line 3054 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 3063 ""
+#line 3055 ""
i__3[0] = 1, a__2[0] = " ";
-#line 3063 ""
+#line 3055 ""
i__3[1] = 1, a__2[1] = noteq;
-#line 3063 ""
+#line 3055 ""
s_cat(noteq, a__2, i__3, &c__2, (ftnlen)8);
-#line 3064 ""
+#line 3056 ""
lnoten = 2;
-#line 3065 ""
+#line 3057 ""
}
-#line 3066 ""
+#line 3058 ""
}
/* Put in the note, but check first for open-head beamed tremolo. */
-#line 3070 ""
+#line 3062 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && all_1.nodur[
commvl_1.ivx + (ip1 + 1) * 24 - 25] >= 32) {
/* 2-note open head tremolo */
-#line 3074 ""
+#line 3066 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 3075 ""
+#line 3067 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 3075 ""
+#line 3067 ""
i__2[1] = 1, a__1[1] = all_1.sq;
-#line 3075 ""
+#line 3067 ""
i__2[2] = 2, a__1[2] = "hb";
-#line 3075 ""
+#line 3067 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 3076 ""
+#line 3068 ""
} else {
/* Writing concatenation */
-#line 3077 ""
+#line 3069 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 3077 ""
+#line 3069 ""
i__3[1] = 2, a__2[1] = "hb";
-#line 3077 ""
+#line 3069 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3078 ""
+#line 3070 ""
}
-#line 3079 ""
+#line 3071 ""
} else {
-#line 3080 ""
+#line 3072 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 3081 ""
+#line 3073 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 3081 ""
+#line 3073 ""
i__2[1] = 1, a__1[1] = all_1.sq;
-#line 3081 ""
+#line 3073 ""
i__2[2] = 2, a__1[2] = "qb";
-#line 3081 ""
+#line 3073 ""
s_cat(notexq, a__1, i__2, &c__3, (ftnlen)79);
-#line 3082 ""
+#line 3074 ""
} else {
/* Writing concatenation */
-#line 3083 ""
+#line 3075 ""
i__3[0] = 1, a__2[0] = all_1.sq;
-#line 3083 ""
+#line 3075 ""
i__3[1] = 2, a__2[1] = "qb";
-#line 3083 ""
+#line 3075 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3084 ""
+#line 3076 ""
}
-#line 3085 ""
+#line 3077 ""
}
-#line 3086 ""
+#line 3078 ""
*lnote += 3;
-#line 3087 ""
+#line 3079 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],2) && (all_1.nodur[
commvl_1.ivx + (ip1 + 1) * 24 - 25] == 24 || all_1.nodur[
commvl_1.ivx + (ip1 + 1) * 24 - 25] == 12 || all_1.nodur[
@@ -7881,177 +7875,177 @@ L5:
/* 2-note trem on dotted note */
/* Writing concatenation */
-#line 3093 ""
+#line 3085 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3093 ""
+#line 3085 ""
i__3[1] = 1, a__2[1] = "p";
-#line 3093 ""
+#line 3085 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3094 ""
+#line 3086 ""
++(*lnote);
-#line 3095 ""
+#line 3087 ""
}
/* Check for dot */
-#line 3099 ""
+#line 3091 ""
isdotm = FALSE_;
-#line 3100 ""
+#line 3092 ""
if (! comxtup_1.vxtup[commvl_1.ivx - 1]) {
-#line 3101 ""
+#line 3093 ""
nd = all_1.nodur[commvl_1.ivx + all_1.ipo[all_1.jn - 1] * 24 - 25];
-#line 3102 ""
+#line 3094 ""
if (nd != 0) {
-#line 3103 ""
+#line 3095 ""
i__1 = log2_(&nd);
-#line 3103 ""
+#line 3095 ""
if (pow_ii(&c__2, &i__1) != nd) {
-#line 3104 ""
+#line 3096 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip1 * 24 - 1],13)) {
-#line 3105 ""
+#line 3097 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip1 * 24 - 25],
3)) {
/* Writing concatenation */
-#line 3106 ""
+#line 3098 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3106 ""
+#line 3098 ""
i__3[1] = 1, a__2[1] = "p";
-#line 3106 ""
+#line 3098 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3107 ""
+#line 3099 ""
} else {
/* Double dot */
/* Writing concatenation */
-#line 3111 ""
+#line 3103 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3111 ""
+#line 3103 ""
i__3[1] = 2, a__2[1] = "pp";
-#line 3111 ""
+#line 3103 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3112 ""
+#line 3104 ""
++(*lnote);
-#line 3113 ""
+#line 3105 ""
}
-#line 3114 ""
+#line 3106 ""
} else {
/* Writing concatenation */
-#line 3115 ""
+#line 3107 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3115 ""
+#line 3107 ""
i__3[1] = 1, a__2[1] = "m";
-#line 3115 ""
+#line 3107 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3116 ""
+#line 3108 ""
isdotm = TRUE_;
-#line 3117 ""
+#line 3109 ""
}
-#line 3118 ""
+#line 3110 ""
++(*lnote);
-#line 3119 ""
+#line 3111 ""
}
-#line 3120 ""
+#line 3112 ""
}
-#line 3121 ""
+#line 3113 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],19) ||
bit_test(all_1.nacc[commvl_1.ivx + ip1 * 24 - 25],27)) {
/* In an xtup with special 2:1 notation with a dot on 1st note, or normal dot */
/* Writing concatenation */
-#line 3126 ""
+#line 3118 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3126 ""
+#line 3118 ""
i__3[1] = 1, a__2[1] = "p";
-#line 3126 ""
+#line 3118 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3127 ""
+#line 3119 ""
++(*lnote);
-#line 3128 ""
+#line 3120 ""
}
/* Do the number; 0 if 12 */
/* 5/25/08 allow >12 */
-#line 3133 ""
+#line 3125 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip1 * 24 - 25],24)) {
-#line 3134 ""
+#line 3126 ""
i__1 = commvl_1.ivx % 24;
-#line 3134 ""
+#line 3126 ""
istring_(&i__1, numq, &len, (ftnlen)8);
-#line 3135 ""
+#line 3127 ""
} else {
/* 1st note of staff-jumping beam */
-#line 3139 ""
+#line 3131 ""
i__1 = combjmp_1.ivbj1 % 24;
-#line 3139 ""
+#line 3131 ""
istring_(&i__1, numq, &len, (ftnlen)8);
-#line 3140 ""
+#line 3132 ""
}
/* Writing concatenation */
-#line 3141 ""
+#line 3133 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3141 ""
+#line 3133 ""
i__3[1] = len, a__2[1] = numq;
-#line 3141 ""
+#line 3133 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3142 ""
+#line 3134 ""
*lnote += len;
-#line 3143 ""
+#line 3135 ""
if (! gotnote) {
-#line 3144 ""
+#line 3136 ""
i__1 = ncmid_(&all_1.iv, &ip1);
-#line 3144 ""
+#line 3136 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 3145 ""
+#line 3137 ""
}
/* Writing concatenation */
-#line 3146 ""
+#line 3138 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3146 ""
+#line 3138 ""
i__3[1] = lnoten, a__2[1] = noteq;
-#line 3146 ""
+#line 3138 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3147 ""
+#line 3139 ""
*lnote += lnoten;
-#line 3148 ""
+#line 3140 ""
if (isdotm) {
-#line 3149 ""
+#line 3141 ""
if (lnoten == 1) {
/* Writing concatenation */
-#line 3150 ""
+#line 3142 ""
i__6[0] = *lnote, a__5[0] = notexq;
-#line 3150 ""
+#line 3142 ""
i__6[1] = 1, a__5[1] = "{";
-#line 3150 ""
+#line 3142 ""
i__6[2] = 1, a__5[2] = noteq;
-#line 3150 ""
+#line 3142 ""
i__6[3] = 1, a__5[3] = "}";
-#line 3150 ""
+#line 3142 ""
s_cat(notexq, a__5, i__6, &c__4, (ftnlen)79);
-#line 3151 ""
+#line 3143 ""
*lnote += 3;
-#line 3152 ""
+#line 3144 ""
} else {
-#line 3153 ""
+#line 3145 ""
i__1 = lnoten - 2;
/* Writing concatenation */
-#line 3153 ""
+#line 3145 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 3153 ""
+#line 3145 ""
i__3[1] = lnoten - 1 - i__1, a__2[1] = noteq + i__1;
-#line 3153 ""
+#line 3145 ""
s_cat(notexq, a__2, i__3, &c__2, (ftnlen)79);
-#line 3154 ""
+#line 3146 ""
++(*lnote);
-#line 3155 ""
+#line 3147 ""
}
-#line 3156 ""
+#line 3148 ""
}
-#line 3157 ""
+#line 3149 ""
return 0;
} /* beamn1_ */
@@ -8132,33 +8126,33 @@ L5:
/* The following is just to save the outputs from SetupB for the case of */
/* xtups starting with a rest, where beamstrt is called twice. */
-#line 3209 ""
+#line 3201 ""
/* Parameter adjustments */
-#line 3209 ""
+#line 3201 ""
--squez;
-#line 3209 ""
+#line 3201 ""
--space;
-#line 3209 ""
+#line 3201 ""
ihornb -= 25;
-#line 3209 ""
+#line 3201 ""
--nornb;
-#line 3209 ""
+#line 3201 ""
-#line 3209 ""
+#line 3201 ""
/* Function Body */
-#line 3209 ""
+#line 3201 ""
writebrests = TRUE_;
-#line 3210 ""
+#line 3202 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
-#line 3211 ""
+#line 3203 ""
ipb1 = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
-#line 3212 ""
+#line 3204 ""
multb = (15 & all_1.mult[commvl_1.ivx + ipb1 * 24 - 25]) - 8;
-#line 3213 ""
+#line 3205 ""
ip = all_1.ipo[all_1.jn - 1];
-#line 3214 ""
+#line 3206 ""
*lnote = 0;
-#line 3215 ""
+#line 3207 ""
nvtrem = 0;
/* Compute slopes and note offsets from start of beam. Inside SetupB, for each */
@@ -8166,14 +8160,14 @@ L5:
/* gets islope(ivx), transferred in common. */
/* Vertical adjustment beams for tremolo */
-#line 3221 ""
+#line 3213 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && ! bit_test(all_1.nacc[
commvl_1.ivx + ip * 24 - 25],21)) {
-#line 3221 ""
+#line 3213 ""
setupb_(comxtup_1.xelsk, &comipb_1.nnb, &comipb_1.sumx, &
comipb_1.sumy, comipb_1.ipb, &comipb_1.smed, &
strtmid_1.ixrest[commvl_1.ivx - 1]);
-#line 3221 ""
+#line 3213 ""
}
/* Will always come past here after entering beamstrt for 2-note tremolo, and */
@@ -8182,213 +8176,213 @@ L5:
/* string, under the tacet assumption that there is no horizontal shift */
/* enacted by the action just before and after the call to beamstrt. */
-#line 3230 ""
+#line 3222 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2) && igetbits_(&
all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &c__5) > 0) {
-#line 3232 ""
+#line 3224 ""
nindent = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &
c__2, &c__5);
/* Writing concatenation */
-#line 3233 ""
+#line 3225 ""
i__1[0] = 1, a__1[0] = all_1.sq;
-#line 3233 ""
+#line 3225 ""
i__1[1] = 12, a__1[1] = "roffset{.7}{";
-#line 3233 ""
+#line 3225 ""
i__1[2] = 1, a__1[2] = all_1.sq;
-#line 3233 ""
+#line 3225 ""
i__1[3] = 2, a__1[3] = "ib";
-#line 3233 ""
+#line 3225 ""
s_cat(tempq, a__1, i__1, &c__4, (ftnlen)79);
-#line 3234 ""
+#line 3226 ""
ltemp = 16;
-#line 3235 ""
+#line 3227 ""
if (nindent == 2) {
/* Writing concatenation */
-#line 3236 ""
+#line 3228 ""
i__2[0] = 16, a__2[0] = tempq;
-#line 3236 ""
+#line 3228 ""
i__2[1] = 1, a__2[1] = "b";
-#line 3236 ""
+#line 3228 ""
s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3237 ""
+#line 3229 ""
ltemp = 17;
-#line 3238 ""
+#line 3230 ""
} else if (nindent == 3) {
/* Writing concatenation */
-#line 3239 ""
+#line 3231 ""
i__2[0] = 16, a__2[0] = tempq;
-#line 3239 ""
+#line 3231 ""
i__2[1] = 2, a__2[1] = "bb";
-#line 3239 ""
+#line 3231 ""
s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3240 ""
+#line 3232 ""
ltemp = 18;
-#line 3241 ""
+#line 3233 ""
}
/* Use beam # 0 for indented beams */
/* Writing concatenation */
-#line 3245 ""
+#line 3237 ""
i__3[0] = ltemp, a__3[0] = tempq;
-#line 3245 ""
+#line 3237 ""
i__3[1] = 1, a__3[1] = all_1.ulq + (commvl_1.ivx + ibc * 24 - 25);
-#line 3245 ""
+#line 3237 ""
i__3[2] = 1, a__3[2] = "0";
-#line 3245 ""
+#line 3237 ""
s_cat(tempq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3246 ""
+#line 3238 ""
ltemp += 2;
/* Get adjustment to nolev1 for main beam based on nindent */
-#line 3250 ""
+#line 3242 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u')
{
-#line 3251 ""
+#line 3243 ""
nvtrem = nindent - 1;
-#line 3252 ""
+#line 3244 ""
} else {
-#line 3253 ""
+#line 3245 ""
nvtrem = 1 - nindent;
-#line 3254 ""
+#line 3246 ""
}
/* Get numerical position of initiation for main beam. Will adjust height at */
/* closing to account for nindent */
-#line 3259 ""
+#line 3251 ""
numinit = comxtup_1.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &
ipb1) + 4;
/* Get forced beam height tweak, apply here for indented beams */
-#line 3263 ""
+#line 3255 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__11) - 30;
-#line 3264 ""
+#line 3256 ""
if (iadj != -30) {
-#line 3264 ""
+#line 3256 ""
numinit += iadj;
-#line 3264 ""
+#line 3256 ""
}
-#line 3265 ""
+#line 3257 ""
if (numinit >= 0 && numinit <= 9) {
-#line 3266 ""
+#line 3258 ""
s_wsfi(&io___223);
-#line 3266 ""
+#line 3258 ""
do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
-#line 3266 ""
+#line 3258 ""
e_wsfi();
-#line 3267 ""
+#line 3259 ""
lnoten = 1;
-#line 3268 ""
+#line 3260 ""
} else {
-#line 3269 ""
+#line 3261 ""
s_wsfi(&io___225);
-#line 3269 ""
+#line 3261 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 3269 ""
+#line 3261 ""
do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
-#line 3269 ""
+#line 3261 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 3269 ""
+#line 3261 ""
e_wsfi();
-#line 3270 ""
+#line 3262 ""
lnoten = 4;
-#line 3271 ""
+#line 3263 ""
}
/* Writing concatenation */
-#line 3272 ""
+#line 3264 ""
i__2[0] = ltemp, a__2[0] = tempq;
-#line 3272 ""
+#line 3264 ""
i__2[1] = lnoten, a__2[1] = noteq;
-#line 3272 ""
+#line 3264 ""
s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3273 ""
+#line 3265 ""
ltemp += lnoten;
/* Now do the slope. */
/* 170408 Baseline is in islope(ivx). Apply slope tweak if present. */
-#line 3278 ""
+#line 3270 ""
numinit = comxtup_1.islope[commvl_1.ivx - 1];
-#line 3279 ""
+#line 3271 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__17) - 30;
-#line 3280 ""
+#line 3272 ""
if (iadj != -30) {
-#line 3280 ""
+#line 3272 ""
numinit += iadj;
-#line 3280 ""
+#line 3272 ""
}
-#line 3281 ""
+#line 3273 ""
if (numinit >= 0 && numinit <= 9) {
-#line 3282 ""
+#line 3274 ""
s_wsfi(&io___226);
-#line 3282 ""
+#line 3274 ""
do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
-#line 3282 ""
+#line 3274 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 3282 ""
+#line 3274 ""
e_wsfi();
-#line 3283 ""
+#line 3275 ""
lnoten = 2;
-#line 3284 ""
+#line 3276 ""
} else {
-#line 3285 ""
+#line 3277 ""
s_wsfi(&io___227);
-#line 3285 ""
+#line 3277 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 3285 ""
+#line 3277 ""
do_fio(&c__1, (char *)&numinit, (ftnlen)sizeof(integer));
-#line 3285 ""
+#line 3277 ""
do_fio(&c__1, "}}", (ftnlen)2);
-#line 3285 ""
+#line 3277 ""
e_wsfi();
-#line 3286 ""
+#line 3278 ""
lnoten = 5;
-#line 3287 ""
+#line 3279 ""
}
/* Writing concatenation */
-#line 3288 ""
+#line 3280 ""
i__2[0] = ltemp, a__2[0] = tempq;
-#line 3288 ""
+#line 3280 ""
i__2[1] = lnoten, a__2[1] = noteq;
-#line 3288 ""
+#line 3280 ""
s_cat(tempq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3289 ""
+#line 3281 ""
ltemp += lnoten;
-#line 3290 ""
+#line 3282 ""
s_copy(notexq, tempq, (ftnlen)79, (ftnlen)79);
-#line 3291 ""
+#line 3283 ""
*lnote = ltemp;
-#line 3292 ""
+#line 3284 ""
}
-#line 3293 ""
+#line 3285 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) {
/* This is start of later segment of single-slope beam group so use slope and */
/* height from prior beam. Slope is already OK. */
-#line 3298 ""
+#line 3290 ""
++comxtup_1.issb[commvl_1.ivx - 1];
-#line 3299 ""
+#line 3291 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = comxtup_1.lev1ssb[commvl_1.ivx +
comxtup_1.issb[commvl_1.ivx - 1] * 24 - 25];
-#line 3300 ""
+#line 3292 ""
}
/* Move this up to before indented beams for tremolo */
/* lnote = 0 */
-#line 3304 ""
+#line 3296 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
-#line 3305 ""
+#line 3297 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) &&
strtmid_1.ixrest[commvl_1.ivx - 1] != 2) {
-#line 3306 ""
+#line 3298 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
-#line 3307 ""
+#line 3299 ""
++comxtup_1.nxtinbm[commvl_1.ivx - 1];
/* irest(28)=>Xtup starts on this note. Set up for xtuplet. */
@@ -8403,169 +8397,169 @@ L5:
/* iflop 0 1 -1 0 ...direction of flop */
/* iup -1 1 -1 1 ...direction of number and bracket */
-#line 3321 ""
+#line 3313 ""
iud = 1;
-#line 3322 ""
+#line 3314 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u')
{
-#line 3322 ""
+#line 3314 ""
iud = -1;
-#line 3322 ""
+#line 3314 ""
}
/* Get ip#, note level of middle note (or gap) in xtup */
-#line 3326 ""
+#line 3318 ""
ipmid = ipb1 + comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] / 2;
/* 130129 If middle note is a rest, go to next note. Note last note cannot */
/* be a rest */
-#line 3331 ""
+#line 3323 ""
L14:
-#line 3332 ""
+#line 3324 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipmid * 24 - 25],0)) {
-#line 3333 ""
+#line 3325 ""
++ipmid;
-#line 3334 ""
+#line 3326 ""
goto L14;
-#line 3335 ""
+#line 3327 ""
}
-#line 3336 ""
+#line 3328 ""
i__4 = ncmid_(&all_1.iv, &ipmid);
-#line 3336 ""
+#line 3328 ""
i__5 = (15 & all_1.mult[commvl_1.ivx + ipmid * 24 - 25]) - 8;
-#line 3336 ""
+#line 3328 ""
xnlmid = (real) levrn_(&all_1.nolev[commvl_1.ivx + ipmid * 24 - 25], &
all_1.irest[commvl_1.ivx + ipmid * 24 - 25], &iud, &i__4, &
i__5);
-#line 3338 ""
+#line 3330 ""
if (comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[commvl_1.ivx - 1]
* 24 - 25] % 2 == 0) {
-#line 3338 ""
+#line 3330 ""
i__5 = ipmid - 1;
-#line 3338 ""
+#line 3330 ""
i__4 = ncmid_(&all_1.iv, &i__5);
-#line 3338 ""
+#line 3330 ""
i__6 = (15 & all_1.mult[commvl_1.ivx + (ipmid - 1) * 24 - 25]) -
8;
-#line 3338 ""
+#line 3330 ""
xnlmid = (xnlmid + levrn_(&all_1.nolev[commvl_1.ivx + (ipmid - 1)
* 24 - 25], &all_1.irest[commvl_1.ivx + (ipmid - 1) * 24
- 25], &iud, &i__4, &i__6)) / 2;
-#line 3338 ""
+#line 3330 ""
}
-#line 3341 ""
+#line 3333 ""
iflop = 0;
-#line 3342 ""
+#line 3334 ""
if ((r__1 = xnlmid - ncmid_(&all_1.iv, &ipb1), dabs(r__1)) < 3.f) {
-#line 3342 ""
+#line 3334 ""
iflop = -iud;
-#line 3342 ""
+#line 3334 ""
}
-#line 3343 ""
+#line 3335 ""
iup = iud + (iflop << 1);
-#line 3344 ""
+#line 3336 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],14)) {
/* Alter iud, iflop, iup to flip number/bracket. (Stare at above pic) */
-#line 3348 ""
+#line 3340 ""
iup = -iup;
-#line 3349 ""
+#line 3341 ""
iflop = 0;
-#line 3350 ""
+#line 3342 ""
if (iud * iup < 0) {
-#line 3350 ""
+#line 3342 ""
iflop = iup;
-#line 3350 ""
+#line 3342 ""
}
-#line 3351 ""
+#line 3343 ""
}
/* Determine if a beam is to be drawn. */
/* Had problem w/ half-note 2-note xtups always F, so add a test */
-#line 3356 ""
+#line 3348 ""
if (igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &
c__3) != 0) {
-#line 3357 ""
+#line 3349 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
-#line 3358 ""
+#line 3350 ""
goto L6;
-#line 3359 ""
+#line 3351 ""
}
-#line 3360 ""
+#line 3352 ""
i__4 = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
-#line 3360 ""
+#line 3352 ""
for (ipp = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ipp <= i__4;
++ipp) {
-#line 3361 ""
+#line 3353 ""
if ((15 & all_1.mult[commvl_1.ivx + ipp * 24 - 25]) - 8 <= 0) {
-#line 3362 ""
+#line 3354 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_;
-#line 3363 ""
+#line 3355 ""
goto L6;
-#line 3364 ""
+#line 3356 ""
}
-#line 3365 ""
+#line 3357 ""
/* L5: */
-#line 3365 ""
+#line 3357 ""
}
-#line 3366 ""
+#line 3358 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = ! bit_test(all_1.islur[
commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25] * 24
- 25],18);
-#line 3367 ""
+#line 3359 ""
L6:
/* Are we using tuplet.tex? */
-#line 3371 ""
+#line 3363 ""
usexnumt = comnvst_1.cstuplet && ! comdraw_1.drawbm[commvl_1.ivx - 1];
/* Check for single note xtup 171217 */
-#line 3375 ""
+#line 3367 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],28) &&
comipb_1.nnb == 1) {
-#line 3376 ""
+#line 3368 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = FALSE_;
-#line 3377 ""
+#line 3369 ""
}
/* Place xtup number if needed */
-#line 3381 ""
+#line 3373 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31) ||
multb <= 0) {
-#line 3382 ""
+#line 3374 ""
mprint = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
c__5, &c__22);
-#line 3383 ""
+#line 3375 ""
if (mprint == 0) {
-#line 3383 ""
+#line 3375 ""
mprint = comxtup_1.mtupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25];
-#line 3383 ""
+#line 3375 ""
}
/* Stab in the dark! Note: tried setting unbeam flag islur18 but no go. */
-#line 3385 ""
+#line 3377 ""
if (comipb_1.nnb == 1) {
-#line 3386 ""
+#line 3378 ""
xnlmid = (real) comxtup_1.nolev1[commvl_1.ivx - 1];
-#line 3387 ""
+#line 3379 ""
comxtup_1.islope[commvl_1.ivx - 1] = 0;
/* Move up, outside number check block, so all 1-note xtups ar unbeamed */
/* drawbm(ivx) = .false. */
-#line 3392 ""
+#line 3384 ""
}
-#line 3393 ""
+#line 3385 ""
i__4 = ncmid_(&all_1.iv, &ipb1);
-#line 3393 ""
+#line 3385 ""
putxtn_(&mprint, &iflop, &multb, &iud, &comask_1.wheadpt, &
comask_1.poenom, &comxtup_1.nolev1[commvl_1.ivx - 1], &
comxtup_1.islope[commvl_1.ivx - 1], &all_1.slfac, &xnlmid,
@@ -8574,329 +8568,329 @@ L6:
comxtup_1.nxtinbm[commvl_1.ivx - 1] * 24 - 25], &iup, &
all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &all_1.mult[
commvl_1.ivx + ipb1 * 24 - 25], &usexnumt, (ftnlen)79);
-#line 3397 ""
+#line 3389 ""
}
-#line 3398 ""
+#line 3390 ""
if (! comdraw_1.drawbm[commvl_1.ivx - 1]) {
/* Xtuplet with no beam */
-#line 3402 ""
+#line 3394 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipb1 * 24 - 25],31)) {
/* Number printing has not been suppressed, so put in the bracket. */
/* scale = stretch factor for bracket if there are asx's */
/* xnsk = length of the bracket in \noteskips = (\elemskips)/(eon) */
-#line 3408 ""
+#line 3400 ""
r__1 = space[*ib] / squez[*ib];
-#line 3408 ""
+#line 3400 ""
xnsk = (comeskz2_1.eskz2[commvl_1.ivx + (ipb1 +
comxtup_1.ntupv[commvl_1.ivx + comxtup_1.nxtinbm[
commvl_1.ivx - 1] * 24 - 25] - 1) * 24 - 25] -
comeskz2_1.eskz2[commvl_1.ivx + ipb1 * 24 - 25]) /
squez[*ib] / feon_(&r__1);
-#line 3410 ""
+#line 3402 ""
if (iup == 1) {
-#line 3411 ""
+#line 3403 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 3412 ""
+#line 3404 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3412 ""
+#line 3404 ""
i__3[1] = 1, a__3[1] = all_1.sq;
-#line 3412 ""
+#line 3404 ""
i__3[2] = 5, a__3[2] = "ovbkt";
-#line 3412 ""
+#line 3404 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3413 ""
+#line 3405 ""
} else {
/* Writing concatenation */
-#line 3414 ""
+#line 3406 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3414 ""
+#line 3406 ""
i__2[1] = 5, a__2[1] = "ovbkt";
-#line 3414 ""
+#line 3406 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3415 ""
+#line 3407 ""
}
-#line 3416 ""
+#line 3408 ""
} else {
-#line 3417 ""
+#line 3409 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 3418 ""
+#line 3410 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3418 ""
+#line 3410 ""
i__3[1] = 1, a__3[1] = all_1.sq;
-#line 3418 ""
+#line 3410 ""
i__3[2] = 5, a__3[2] = "unbkt";
-#line 3418 ""
+#line 3410 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3419 ""
+#line 3411 ""
} else {
/* Introduced 12/5/98, req'd due to possible presence of in-line TeX */
/* Writing concatenation */
-#line 3423 ""
+#line 3415 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3423 ""
+#line 3415 ""
i__2[1] = 5, a__2[1] = "unbkt";
-#line 3423 ""
+#line 3415 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3424 ""
+#line 3416 ""
}
-#line 3425 ""
+#line 3417 ""
}
-#line 3426 ""
+#line 3418 ""
*lnote += 6;
-#line 3427 ""
+#line 3419 ""
if (all_1.iline == 1) {
-#line 3428 ""
+#line 3420 ""
comipb_1.smed /= 1.f - comtop_1.fracindent;
-#line 3429 ""
+#line 3421 ""
}
-#line 3430 ""
+#line 3422 ""
xslope = comipb_1.smed * 1.8f * all_1.slfac;
-#line 3431 ""
+#line 3423 ""
comxtup_1.islope[commvl_1.ivx - 1] = i_nint(&xslope);
-#line 3432 ""
+#line 3424 ""
r__1 = comipb_1.smed * comxtup_1.eloff[commvl_1.ivx - 1];
-#line 3432 ""
+#line 3424 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = nlnum - i_nint(&r__1);
-#line 3433 ""
+#line 3425 ""
if (comxtup_1.islope[commvl_1.ivx - 1] == 0) {
-#line 3433 ""
+#line 3425 ""
--comxtup_1.nolev1[commvl_1.ivx - 1];
-#line 3433 ""
+#line 3425 ""
}
-#line 3434 ""
+#line 3426 ""
if (iup == 1) {
-#line 3434 ""
+#line 3426 ""
comxtup_1.nolev1[commvl_1.ivx - 1] += 4;
-#line 3434 ""
+#line 3426 ""
}
-#line 3435 ""
+#line 3427 ""
levbracket = comxtup_1.nolev1[commvl_1.ivx - 1];
-#line 3436 ""
+#line 3428 ""
if (iup == 1 && comnvst_1.cstuplet) {
-#line 3436 ""
+#line 3428 ""
--levbracket;
-#line 3436 ""
+#line 3428 ""
}
-#line 3437 ""
+#line 3429 ""
i__4 = ncmid_(&all_1.iv, &ipb1);
-#line 3437 ""
+#line 3429 ""
notefq_(noteq, &lnoten, &levbracket, &i__4, (ftnlen)8);
-#line 3438 ""
+#line 3430 ""
if (lnoten == 1) {
-#line 3438 ""
+#line 3430 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 3438 ""
+#line 3430 ""
}
/* Writing concatenation */
-#line 3439 ""
+#line 3431 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3439 ""
+#line 3431 ""
i__3[1] = lnoten, a__3[1] = noteq;
-#line 3439 ""
+#line 3431 ""
i__3[2] = 1, a__3[2] = "{";
-#line 3439 ""
+#line 3431 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3440 ""
+#line 3432 ""
*lnote = *lnote + lnoten + 1;
-#line 3441 ""
+#line 3433 ""
if (xnsk < .995f) {
-#line 3442 ""
+#line 3434 ""
i__4 = *lnote;
-#line 3442 ""
+#line 3434 ""
ici__1.icierr = 0;
-#line 3442 ""
+#line 3434 ""
ici__1.icirnum = 1;
-#line 3442 ""
+#line 3434 ""
ici__1.icirlen = *lnote + 4 - i__4;
-#line 3442 ""
+#line 3434 ""
ici__1.iciunit = notexq + i__4;
-#line 3442 ""
+#line 3434 ""
ici__1.icifmt = "(i1,f3.2)";
-#line 3442 ""
+#line 3434 ""
s_wsfi(&ici__1);
-#line 3442 ""
+#line 3434 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 3442 ""
+#line 3434 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
-#line 3442 ""
+#line 3434 ""
e_wsfi();
-#line 3443 ""
+#line 3435 ""
*lnote += 4;
-#line 3444 ""
+#line 3436 ""
} else if (xnsk < 9.995f) {
-#line 3445 ""
+#line 3437 ""
i__4 = *lnote;
-#line 3445 ""
+#line 3437 ""
ici__1.icierr = 0;
-#line 3445 ""
+#line 3437 ""
ici__1.icirnum = 1;
-#line 3445 ""
+#line 3437 ""
ici__1.icirlen = *lnote + 4 - i__4;
-#line 3445 ""
+#line 3437 ""
ici__1.iciunit = notexq + i__4;
-#line 3445 ""
+#line 3437 ""
ici__1.icifmt = "(f4.2)";
-#line 3445 ""
+#line 3437 ""
s_wsfi(&ici__1);
-#line 3445 ""
+#line 3437 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
-#line 3445 ""
+#line 3437 ""
e_wsfi();
-#line 3446 ""
+#line 3438 ""
*lnote += 4;
-#line 3447 ""
+#line 3439 ""
} else {
-#line 3448 ""
+#line 3440 ""
i__4 = *lnote;
-#line 3448 ""
+#line 3440 ""
ici__1.icierr = 0;
-#line 3448 ""
+#line 3440 ""
ici__1.icirnum = 1;
-#line 3448 ""
+#line 3440 ""
ici__1.icirlen = *lnote + 5 - i__4;
-#line 3448 ""
+#line 3440 ""
ici__1.iciunit = notexq + i__4;
-#line 3448 ""
+#line 3440 ""
ici__1.icifmt = "(f5.2)";
-#line 3448 ""
+#line 3440 ""
s_wsfi(&ici__1);
-#line 3448 ""
+#line 3440 ""
do_fio(&c__1, (char *)&xnsk, (ftnlen)sizeof(real));
-#line 3448 ""
+#line 3440 ""
e_wsfi();
-#line 3449 ""
+#line 3441 ""
*lnote += 5;
-#line 3450 ""
+#line 3442 ""
}
/* Writing concatenation */
-#line 3451 ""
+#line 3443 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3451 ""
+#line 3443 ""
i__2[1] = 1, a__2[1] = "}";
-#line 3451 ""
+#line 3443 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3452 ""
+#line 3444 ""
++(*lnote);
-#line 3453 ""
+#line 3445 ""
if (bit_test(all_1.mult[commvl_1.ivx + ipb1 * 24 - 25],4)) {
/* Tweak slope of bracket */
-#line 3457 ""
+#line 3449 ""
comxtup_1.islope[commvl_1.ivx - 1] = comxtup_1.islope[
commvl_1.ivx - 1] + igetbits_(&all_1.mult[
commvl_1.ivx + ipb1 * 24 - 25], &c__5, &c__5) -
16;
-#line 3458 ""
+#line 3450 ""
}
-#line 3459 ""
+#line 3451 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < 0 ||
comxtup_1.islope[commvl_1.ivx - 1] >= 10) {
/* Writing concatenation */
-#line 3460 ""
+#line 3452 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3460 ""
+#line 3452 ""
i__2[1] = 1, a__2[1] = "{";
-#line 3460 ""
+#line 3452 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3461 ""
+#line 3453 ""
++(*lnote);
-#line 3462 ""
+#line 3454 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < -9) {
-#line 3463 ""
+#line 3455 ""
i__4 = *lnote;
-#line 3463 ""
+#line 3455 ""
ici__1.icierr = 0;
-#line 3463 ""
+#line 3455 ""
ici__1.icirnum = 1;
-#line 3463 ""
+#line 3455 ""
ici__1.icirlen = *lnote + 3 - i__4;
-#line 3463 ""
+#line 3455 ""
ici__1.iciunit = notexq + i__4;
-#line 3463 ""
+#line 3455 ""
ici__1.icifmt = "(i3)";
-#line 3463 ""
+#line 3455 ""
s_wsfi(&ici__1);
-#line 3463 ""
+#line 3455 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
- 1], (ftnlen)sizeof(integer));
-#line 3463 ""
+#line 3455 ""
e_wsfi();
-#line 3464 ""
+#line 3456 ""
*lnote += 3;
-#line 3465 ""
+#line 3457 ""
} else {
-#line 3466 ""
+#line 3458 ""
i__4 = *lnote;
-#line 3466 ""
+#line 3458 ""
ici__1.icierr = 0;
-#line 3466 ""
+#line 3458 ""
ici__1.icirnum = 1;
-#line 3466 ""
+#line 3458 ""
ici__1.icirlen = *lnote + 2 - i__4;
-#line 3466 ""
+#line 3458 ""
ici__1.iciunit = notexq + i__4;
-#line 3466 ""
+#line 3458 ""
ici__1.icifmt = "(i2)";
-#line 3466 ""
+#line 3458 ""
s_wsfi(&ici__1);
-#line 3466 ""
+#line 3458 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx
- 1], (ftnlen)sizeof(integer));
-#line 3466 ""
+#line 3458 ""
e_wsfi();
-#line 3467 ""
+#line 3459 ""
*lnote += 2;
-#line 3468 ""
+#line 3460 ""
}
/* Writing concatenation */
-#line 3469 ""
+#line 3461 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3469 ""
+#line 3461 ""
i__2[1] = 1, a__2[1] = "}";
-#line 3469 ""
+#line 3461 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3470 ""
+#line 3462 ""
++(*lnote);
-#line 3471 ""
+#line 3463 ""
} else {
-#line 3472 ""
+#line 3464 ""
i__4 = *lnote;
-#line 3472 ""
+#line 3464 ""
ici__1.icierr = 0;
-#line 3472 ""
+#line 3464 ""
ici__1.icirnum = 1;
-#line 3472 ""
+#line 3464 ""
ici__1.icirlen = *lnote + 1 - i__4;
-#line 3472 ""
+#line 3464 ""
ici__1.iciunit = notexq + i__4;
-#line 3472 ""
+#line 3464 ""
ici__1.icifmt = "(i1)";
-#line 3472 ""
+#line 3464 ""
s_wsfi(&ici__1);
-#line 3472 ""
+#line 3464 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1],
(ftnlen)sizeof(integer));
-#line 3472 ""
+#line 3464 ""
e_wsfi();
-#line 3473 ""
+#line 3465 ""
++(*lnote);
-#line 3474 ""
+#line 3466 ""
}
/* Done with bracket */
-#line 3478 ""
+#line 3470 ""
}
-#line 3479 ""
+#line 3471 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) {
/* Put in the rest. Possible problem: Rest is a spacing char, but between */
@@ -8904,71 +8898,71 @@ L6:
/* 130126 Deal with vertical shifts of rest starting xtuplet */
-#line 3486 ""
+#line 3478 ""
lrest = 3;
-#line 3487 ""
+#line 3479 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
/* Writing concatenation */
-#line 3488 ""
+#line 3480 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3488 ""
+#line 3480 ""
i__2[1] = 2, a__2[1] = "sk";
-#line 3488 ""
+#line 3480 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
/* if (multb .eq. 0) then */
-#line 3490 ""
+#line 3482 ""
} else if (multb == 0) {
/* Writing concatenation */
-#line 3491 ""
+#line 3483 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3491 ""
+#line 3483 ""
i__2[1] = 2, a__2[1] = "qp";
-#line 3491 ""
+#line 3483 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
-#line 3492 ""
+#line 3484 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 1)
{
/* Writing concatenation */
-#line 3493 ""
+#line 3485 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3493 ""
+#line 3485 ""
i__2[1] = 2, a__2[1] = "ds";
-#line 3493 ""
+#line 3485 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
-#line 3494 ""
+#line 3486 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 2)
{
/* Writing concatenation */
-#line 3495 ""
+#line 3487 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3495 ""
+#line 3487 ""
i__2[1] = 2, a__2[1] = "qs";
-#line 3495 ""
+#line 3487 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
-#line 3496 ""
+#line 3488 ""
} else if (! comdraw_1.drawbm[commvl_1.ivx - 1] && multb == 3)
{
/* Writing concatenation */
-#line 3497 ""
+#line 3489 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3497 ""
+#line 3489 ""
i__2[1] = 2, a__2[1] = "hs";
-#line 3497 ""
+#line 3489 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
-#line 3498 ""
+#line 3490 ""
} else {
/* Writing concatenation */
-#line 3499 ""
+#line 3491 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3499 ""
+#line 3491 ""
i__2[1] = 6, a__2[1] = "hpause";
-#line 3499 ""
+#line 3491 ""
s_cat(restq, a__2, i__2, &c__2, (ftnlen)40);
-#line 3500 ""
+#line 3492 ""
lrest = 7;
-#line 3501 ""
+#line 3493 ""
}
-#line 3502 ""
+#line 3494 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],18) &&
bit_test(all_1.nacc[commvl_1.ivx + ipb1 * 24 - 25],19)
) {
@@ -8976,561 +8970,561 @@ L6:
/* VERY special case of rest at start of F-tuplet, needs dot */
/* Writing concatenation */
-#line 3507 ""
+#line 3499 ""
i__3[0] = 1, a__3[0] = all_1.sq;
-#line 3507 ""
+#line 3499 ""
i__3[1] = 3, a__3[1] = "pt4";
-#line 3507 ""
+#line 3499 ""
i__3[2] = lrest, a__3[2] = restq;
-#line 3507 ""
+#line 3499 ""
s_cat(restq, a__3, i__3, &c__3, (ftnlen)40);
-#line 3508 ""
+#line 3500 ""
lrest += 4;
-#line 3509 ""
+#line 3501 ""
}
-#line 3511 ""
+#line 3503 ""
nole = (all_1.nolev[commvl_1.ivx + ip * 24 - 25] + 20) % 100
- 20;
/* if (nole .eq. 0) then */
-#line 3513 ""
+#line 3505 ""
if (nole == 0 || bit_test(all_1.islur[commvl_1.ivx + ip * 24
- 25],29)) {
/* Rest blank or is not raised */
/* Writing concatenation */
-#line 3517 ""
+#line 3509 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3517 ""
+#line 3509 ""
i__2[1] = 40, a__2[1] = restq;
-#line 3517 ""
+#line 3509 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3518 ""
+#line 3510 ""
*lnote += lrest;
-#line 3519 ""
+#line 3511 ""
} else {
-#line 3520 ""
+#line 3512 ""
if (abs(nole) < 10) {
-#line 3521 ""
+#line 3513 ""
i__4 = abs(nole) + 48;
-#line 3521 ""
+#line 3513 ""
chax_(ch__1, (ftnlen)1, &i__4);
-#line 3521 ""
+#line 3513 ""
s_copy(tempq, ch__1, (ftnlen)79, (ftnlen)1);
-#line 3522 ""
+#line 3514 ""
ltemp = 1;
-#line 3523 ""
+#line 3515 ""
} else {
-#line 3524 ""
+#line 3516 ""
s_wsfi(&io___243);
-#line 3524 ""
+#line 3516 ""
i__4 = abs(nole);
-#line 3524 ""
+#line 3516 ""
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 3524 ""
+#line 3516 ""
e_wsfi();
-#line 3525 ""
+#line 3517 ""
ltemp = 2;
-#line 3526 ""
+#line 3518 ""
}
-#line 3527 ""
+#line 3519 ""
if (nole > 0) {
/* Writing concatenation */
-#line 3528 ""
+#line 3520 ""
i__7[0] = 1, a__4[0] = all_1.sq;
-#line 3528 ""
+#line 3520 ""
i__7[1] = 5, a__4[1] = "raise";
-#line 3528 ""
+#line 3520 ""
i__7[2] = ltemp, a__4[2] = tempq;
-#line 3528 ""
+#line 3520 ""
i__7[3] = 1, a__4[3] = all_1.sq;
-#line 3528 ""
+#line 3520 ""
i__7[4] = 9, a__4[4] = "internote";
-#line 3528 ""
+#line 3520 ""
s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79);
-#line 3529 ""
+#line 3521 ""
} else {
/* Writing concatenation */
-#line 3530 ""
+#line 3522 ""
i__7[0] = 1, a__4[0] = all_1.sq;
-#line 3530 ""
+#line 3522 ""
i__7[1] = 5, a__4[1] = "lower";
-#line 3530 ""
+#line 3522 ""
i__7[2] = ltemp, a__4[2] = tempq;
-#line 3530 ""
+#line 3522 ""
i__7[3] = 1, a__4[3] = all_1.sq;
-#line 3530 ""
+#line 3522 ""
i__7[4] = 9, a__4[4] = "internote";
-#line 3530 ""
+#line 3522 ""
s_cat(tempq, a__4, i__7, &c__5, (ftnlen)79);
-#line 3531 ""
+#line 3523 ""
}
-#line 3532 ""
+#line 3524 ""
ltemp += 16;
/* Writing concatenation */
-#line 3533 ""
+#line 3525 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3533 ""
+#line 3525 ""
i__3[1] = ltemp, a__3[1] = tempq;
-#line 3533 ""
+#line 3525 ""
i__3[2] = lrest, a__3[2] = restq;
-#line 3533 ""
+#line 3525 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3534 ""
+#line 3526 ""
*lnote = *lnote + ltemp + lrest;
-#line 3535 ""
+#line 3527 ""
}
/* No need to come back through this subroutine (as would if rest starts bar */
/* & multb>0), so do not advance ibm1. But must check in beamn1 and do nothing. */
-#line 3540 ""
+#line 3532 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
-#line 3541 ""
+#line 3533 ""
}
-#line 3542 ""
+#line 3534 ""
return 0;
-#line 3543 ""
+#line 3535 ""
}
/* End if block for non-beamed xtup start...note we returned */
-#line 3547 ""
+#line 3539 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 1) {
/* Insert rest at start of beamed xtup. See above note for possible problem. */
/* But first check if blank rest and if in forced beam (assuming xtuplet), */
/* and if so, count rest from beginning, add \sk's AFTER starting beam '\ib*' */
-#line 3553 ""
+#line 3545 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29) &&
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],30)) {
-#line 3554 ""
+#line 3546 ""
++xjbeambrests_1.nbrests;
-#line 3555 ""
+#line 3547 ""
writebrests = FALSE_;
-#line 3556 ""
+#line 3548 ""
} else {
-#line 3557 ""
+#line 3549 ""
i__4 = 4 - multb;
-#line 3557 ""
+#line 3549 ""
all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = pow_ii(&c__2, &
i__4);
-#line 3558 ""
+#line 3550 ""
notex_(tempq, &ltemp, (ftnlen)79);
-#line 3559 ""
+#line 3551 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 3560 ""
+#line 3552 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3560 ""
+#line 3552 ""
i__2[1] = ltemp, a__2[1] = tempq;
-#line 3560 ""
+#line 3552 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3561 ""
+#line 3553 ""
} else {
-#line 3562 ""
+#line 3554 ""
s_copy(notexq, tempq, (ftnlen)79, ltemp);
-#line 3563 ""
+#line 3555 ""
}
-#line 3564 ""
+#line 3556 ""
*lnote += ltemp;
-#line 3565 ""
+#line 3557 ""
}
/* Re-zero just in case! */
-#line 3569 ""
+#line 3561 ""
all_1.nodur[commvl_1.ivx + ipb1 * 24 - 25] = 0;
-#line 3570 ""
+#line 3562 ""
++all_1.ibm1[commvl_1.ivx + ibc * 24 - 25];
/* See if next note is a non-rest */
-#line 3574 ""
+#line 3566 ""
if (! bit_test(all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],0)
) {
-#line 3575 ""
+#line 3567 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 2;
-#line 3576 ""
+#line 3568 ""
} else {
/* Suppress reprinting xtup number next time through beamstrt */
-#line 3580 ""
+#line 3572 ""
all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set(
all_1.islur[commvl_1.ivx + (ipb1 + 1) * 24 - 25],31);
/* Set new xtup start flag */
-#line 3584 ""
+#line 3576 ""
all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25] = bit_set(
all_1.irest[commvl_1.ivx + (ipb1 + 1) * 24 - 25],28);
-#line 3585 ""
+#line 3577 ""
}
-#line 3586 ""
+#line 3578 ""
return 0;
-#line 3587 ""
+#line 3579 ""
}
-#line 3588 ""
+#line 3580 ""
}
/* Just ended if block for xtups */
-#line 3592 ""
+#line 3584 ""
if (comxtup_1.vxtup[commvl_1.ivx - 1] && ipb1 == all_1.ibm2[commvl_1.ivx
+ ibc * 24 - 25]) {
/* Move actual note writing to beamend */
-#line 3596 ""
+#line 3588 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 4;
-#line 3597 ""
+#line 3589 ""
return 0;
-#line 3598 ""
+#line 3590 ""
}
-#line 3599 ""
+#line 3591 ""
if (comxtup_1.issb[commvl_1.ivx - 1] == 0) {
/* 1st bmstrt in single-slope bm grp, Adjust start level(s) and slope if needed */
-#line 3603 ""
+#line 3595 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__11) - 30;
-#line 3604 ""
+#line 3596 ""
if (iadj != -30) {
-#line 3605 ""
+#line 3597 ""
comxtup_1.nolev1[commvl_1.ivx - 1] += iadj;
-#line 3606 ""
+#line 3598 ""
i__4 = comxtup_1.nssb[commvl_1.ivx - 1];
-#line 3606 ""
+#line 3598 ""
for (isssb = 1; isssb <= i__4; ++isssb) {
-#line 3607 ""
+#line 3599 ""
comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] += iadj;
-#line 3608 ""
+#line 3600 ""
/* L2: */
-#line 3608 ""
+#line 3600 ""
}
-#line 3609 ""
+#line 3601 ""
}
-#line 3610 ""
+#line 3602 ""
iadj = igetbits_(&all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25], &c__6, &
c__17) - 30;
-#line 3611 ""
+#line 3603 ""
if (iadj != -30) {
-#line 3612 ""
+#line 3604 ""
comxtup_1.islope[commvl_1.ivx - 1] += iadj;
-#line 3613 ""
+#line 3605 ""
if ((i__4 = comxtup_1.islope[commvl_1.ivx - 1], abs(i__4)) > 9) {
-#line 3613 ""
+#line 3605 ""
comxtup_1.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
comxtup_1.islope[commvl_1.ivx - 1]);
-#line 3613 ""
+#line 3605 ""
}
-#line 3614 ""
+#line 3606 ""
if (comxtup_1.nssb[commvl_1.ivx - 1] > 0) {
/* Cycle thru non-rest notes in SSBG, looking for bmstrts. */
-#line 3618 ""
+#line 3610 ""
isssb = 0;
-#line 3619 ""
+#line 3611 ""
i__4 = comipb_1.nnb;
-#line 3619 ""
+#line 3611 ""
for (inb = 2; inb <= i__4; ++inb) {
-#line 3620 ""
+#line 3612 ""
if (bit_test(all_1.nacc[commvl_1.ivx + comipb_1.ipb[inb -
1] * 24 - 25],21)) {
/* Beam segment start. New start level */
-#line 3623 ""
+#line 3615 ""
++isssb;
-#line 3624 ""
+#line 3616 ""
comxtup_1.lev1ssb[commvl_1.ivx + isssb * 24 - 25] +=
comxtup_1.islope[commvl_1.ivx - 1] *
comxtup_1.xelsk[inb - 1] / all_1.slfac;
-#line 3626 ""
+#line 3618 ""
}
-#line 3627 ""
+#line 3619 ""
/* L4: */
-#line 3627 ""
+#line 3619 ""
}
-#line 3628 ""
+#line 3620 ""
}
-#line 3629 ""
+#line 3621 ""
}
-#line 3630 ""
+#line 3622 ""
}
-#line 3631 ""
+#line 3623 ""
iadj = igetbits_(&all_1.islur[commvl_1.ivx + ipb1 * 24 - 25], &c__2, &
c__27);
-#line 3632 ""
+#line 3624 ""
addbrack = FALSE_;
-#line 3633 ""
+#line 3625 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ipb1 * 24 - 25],30)) {
/* Check for altered starting polarity. Only in forced beams. Nominal start */
/* level is nolev1. So beam level is nolev1 +/- 6, to be compared w/ nolev(.,.). */
-#line 3638 ""
+#line 3630 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u'
&& comxtup_1.nolev1[commvl_1.ivx - 1] + 6 < all_1.nolev[
commvl_1.ivx + ipb1 * 24 - 25]) {
-#line 3640 ""
+#line 3632 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 3641 ""
+#line 3633 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3641 ""
+#line 3633 ""
i__2[1] = 5, a__2[1] = "loff{";
-#line 3641 ""
+#line 3633 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3642 ""
+#line 3634 ""
} else {
/* Writing concatenation */
-#line 3643 ""
+#line 3635 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3643 ""
+#line 3635 ""
i__3[1] = 1, a__3[1] = all_1.sq;
-#line 3643 ""
+#line 3635 ""
i__3[2] = 5, a__3[2] = "loff{";
-#line 3643 ""
+#line 3635 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3644 ""
+#line 3636 ""
}
-#line 3645 ""
+#line 3637 ""
*lnote += 6;
-#line 3646 ""
+#line 3638 ""
addbrack = TRUE_;
-#line 3647 ""
+#line 3639 ""
} else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
== 'l' && comxtup_1.nolev1[commvl_1.ivx - 1] - 6 >
all_1.nolev[commvl_1.ivx + ipb1 * 24 - 25]) {
-#line 3649 ""
+#line 3641 ""
if (*lnote == 0) {
/* Writing concatenation */
-#line 3650 ""
+#line 3642 ""
i__2[0] = 1, a__2[0] = all_1.sq;
-#line 3650 ""
+#line 3642 ""
i__2[1] = 5, a__2[1] = "roff{";
-#line 3650 ""
+#line 3642 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3651 ""
+#line 3643 ""
} else {
/* Writing concatenation */
-#line 3652 ""
+#line 3644 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3652 ""
+#line 3644 ""
i__3[1] = 1, a__3[1] = all_1.sq;
-#line 3652 ""
+#line 3644 ""
i__3[2] = 5, a__3[2] = "roff{";
-#line 3652 ""
+#line 3644 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3653 ""
+#line 3645 ""
}
-#line 3654 ""
+#line 3646 ""
*lnote += 6;
-#line 3655 ""
+#line 3647 ""
addbrack = TRUE_;
-#line 3656 ""
+#line 3648 ""
}
/* Check end level for possible flipping in forced beam. Have to do it */
/* here since with multiple voices, xelsk will not be preserved. */
-#line 3661 ""
+#line 3653 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'u') {
-#line 3662 ""
+#line 3654 ""
bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] + 6 + comxtup_1.islope[
commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] /
all_1.slfac;
-#line 3663 ""
+#line 3655 ""
strtmid_1.flipend[commvl_1.ivx - 1] = bmlev < (real) all_1.nolev[
commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] *
24 - 25];
-#line 3664 ""
+#line 3656 ""
} else if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == 'l') {
-#line 3665 ""
+#line 3657 ""
bmlev = comxtup_1.nolev1[commvl_1.ivx - 1] - 6 + comxtup_1.islope[
commvl_1.ivx - 1] * comxtup_1.xelsk[comipb_1.nnb - 1] /
all_1.slfac;
-#line 3666 ""
+#line 3658 ""
strtmid_1.flipend[commvl_1.ivx - 1] = bmlev > (real) all_1.nolev[
commvl_1.ivx + all_1.ibm2[commvl_1.ivx + ibc * 24 - 25] *
24 - 25];
-#line 3667 ""
+#line 3659 ""
}
-#line 3668 ""
+#line 3660 ""
}
-#line 3669 ""
+#line 3661 ""
multbb = multb + iadj;
/* Tremolo starting? */
-#line 3673 ""
+#line 3665 ""
if (bit_test(all_1.irest[commvl_1.ivx + ipb1 * 24 - 25],2)) {
-#line 3673 ""
+#line 3665 ""
multbb = igetbits_(&all_1.irest[commvl_1.ivx + ipb1 * 24 - 25], &c__2,
&c__3);
-#line 3673 ""
+#line 3665 ""
}
-#line 3675 ""
+#line 3667 ""
ntrbbb_(&multbb, "i", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (ftnlen)79);
/* Put in name of start level and slope, after correcting nolev1 if xtup */
/* started with a rest. */
-#line 3680 ""
+#line 3672 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
-#line 3680 ""
+#line 3672 ""
r__1 = comxtup_1.nolev1[commvl_1.ivx - 1] + comxtup_1.xelsk[0] *
comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac;
-#line 3680 ""
+#line 3672 ""
comxtup_1.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
-#line 3680 ""
+#line 3672 ""
}
/* Add adjustment nvtrem to main beam to account for tremolo indented beams */
-#line 3685 ""
+#line 3677 ""
i__4 = comxtup_1.nolev1[commvl_1.ivx - 1] + nvtrem;
-#line 3685 ""
+#line 3677 ""
i__5 = ncmid_(&all_1.iv, &ipb1);
-#line 3685 ""
+#line 3677 ""
notefq_(noteq, &lnoten, &i__4, &i__5, (ftnlen)8);
-#line 3686 ""
+#line 3678 ""
if (comxtup_1.islope[commvl_1.ivx - 1] < 0) {
/* Writing concatenation */
-#line 3687 ""
+#line 3679 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3687 ""
+#line 3679 ""
i__3[1] = lnoten, a__3[1] = noteq;
-#line 3687 ""
+#line 3679 ""
i__3[2] = 1, a__3[2] = "{";
-#line 3687 ""
+#line 3679 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3688 ""
+#line 3680 ""
*lnote = *lnote + 4 + lnoten;
-#line 3689 ""
+#line 3681 ""
i__4 = *lnote - 3;
-#line 3689 ""
+#line 3681 ""
ici__1.icierr = 0;
-#line 3689 ""
+#line 3681 ""
ici__1.icirnum = 1;
-#line 3689 ""
+#line 3681 ""
ici__1.icirlen = *lnote - i__4;
-#line 3689 ""
+#line 3681 ""
ici__1.iciunit = notexq + i__4;
-#line 3689 ""
+#line 3681 ""
ici__1.icifmt = "(i2,a1)";
-#line 3689 ""
+#line 3681 ""
s_wsfi(&ici__1);
-#line 3689 ""
+#line 3681 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
sizeof(integer));
-#line 3689 ""
+#line 3681 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 3689 ""
+#line 3681 ""
e_wsfi();
-#line 3690 ""
+#line 3682 ""
} else {
/* Writing concatenation */
-#line 3691 ""
+#line 3683 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3691 ""
+#line 3683 ""
i__2[1] = lnoten, a__2[1] = noteq;
-#line 3691 ""
+#line 3683 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3692 ""
+#line 3684 ""
*lnote = *lnote + 1 + lnoten;
-#line 3693 ""
+#line 3685 ""
ici__1.icierr = 0;
-#line 3693 ""
+#line 3685 ""
ici__1.icirnum = 1;
-#line 3693 ""
+#line 3685 ""
ici__1.icirlen = 1;
-#line 3693 ""
+#line 3685 ""
ici__1.iciunit = notexq + (*lnote - 1);
-#line 3693 ""
+#line 3685 ""
ici__1.icifmt = "(i1)";
-#line 3693 ""
+#line 3685 ""
s_wsfi(&ici__1);
-#line 3693 ""
+#line 3685 ""
do_fio(&c__1, (char *)&comxtup_1.islope[commvl_1.ivx - 1], (ftnlen)
sizeof(integer));
-#line 3693 ""
+#line 3685 ""
e_wsfi();
-#line 3694 ""
+#line 3686 ""
}
/* Check for beam-thk fine-tuning */
-#line 3698 ""
+#line 3690 ""
if (iadj > 0) {
-#line 3699 ""
+#line 3691 ""
i__4 = multb + 1;
-#line 3699 ""
+#line 3691 ""
for (imp = multb + iadj; imp >= i__4; --imp) {
-#line 3700 ""
+#line 3692 ""
ntrbbb_(&imp, "t", all_1.ulq + (commvl_1.ivx + ibc * 24 - 25), &
commvl_1.ivx, notexq, lnote, (ftnlen)1, (ftnlen)1, (
ftnlen)79);
-#line 3701 ""
+#line 3693 ""
/* L1: */
-#line 3701 ""
+#line 3693 ""
}
-#line 3702 ""
+#line 3694 ""
}
/* If we shifted, must close with right bracket */
-#line 3706 ""
+#line 3698 ""
if (addbrack) {
/* Writing concatenation */
-#line 3707 ""
+#line 3699 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 3707 ""
+#line 3699 ""
i__2[1] = 1, a__2[1] = "}";
-#line 3707 ""
+#line 3699 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 3708 ""
+#line 3700 ""
++(*lnote);
-#line 3709 ""
+#line 3701 ""
}
/* Add in \sk's for very special case of staff-crossing xtup chords */
/* Assumes we are in lower (first) voice of up-to-both beamed xtup */
/* that starts with blank rests (notes in upper voice here). */
-#line 3715 ""
+#line 3707 ""
if (xjbeambrests_1.nbrests > 0 && writebrests) {
-#line 3716 ""
+#line 3708 ""
i__4 = xjbeambrests_1.nbrests;
-#line 3716 ""
+#line 3708 ""
for (isk = 1; isk <= i__4; ++isk) {
/* Writing concatenation */
-#line 3717 ""
+#line 3709 ""
i__3[0] = *lnote, a__3[0] = notexq;
-#line 3717 ""
+#line 3709 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 3717 ""
+#line 3709 ""
i__3[1] = 1, a__3[1] = ch__1;
-#line 3717 ""
+#line 3709 ""
i__3[2] = 2, a__3[2] = "sk";
-#line 3717 ""
+#line 3709 ""
s_cat(notexq, a__3, i__3, &c__3, (ftnlen)79);
-#line 3718 ""
+#line 3710 ""
*lnote += 3;
-#line 3719 ""
+#line 3711 ""
/* L7: */
-#line 3719 ""
+#line 3711 ""
}
-#line 3720 ""
+#line 3712 ""
xjbeambrests_1.nbrests = 0;
-#line 3721 ""
+#line 3713 ""
}
/* Get 'floor' zmin for figures */
@@ -9538,100 +9532,100 @@ L6:
/* won't be adjusted. If anyone ever needs that, need to duplicate this */
/* functionality up above, before exiting. */
-#line 3728 ""
+#line 3720 ""
if (all_1.figbass && (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2)) {
-#line 3729 ""
+#line 3721 ""
if (commvl_1.ivx == 1) {
-#line 3730 ""
+#line 3722 ""
ivf = 1;
-#line 3731 ""
+#line 3723 ""
} else {
-#line 3732 ""
+#line 3724 ""
ivf = comfig_1.ivxfig2;
-#line 3733 ""
+#line 3725 ""
}
-#line 3734 ""
+#line 3726 ""
zmult = (multb - 1) * 1.2f;
-#line 3735 ""
+#line 3727 ""
ymin = 100.f;
-#line 3736 ""
+#line 3728 ""
i__4 = comipb_1.nnb;
-#line 3736 ""
+#line 3728 ""
for (inb = 1; inb <= i__4; ++inb) {
-#line 3737 ""
+#line 3729 ""
if (all_1.isfig[ivf + (comipb_1.ipb[inb - 1] << 1) - 3]) {
-#line 3738 ""
+#line 3730 ""
if (*(unsigned char *)&all_1.ulq[all_1.iv + ibc * 24 - 25] ==
'u') {
-#line 3739 ""
+#line 3731 ""
ybot = (real) all_1.nolev[all_1.iv + comipb_1.ipb[inb - 1]
* 24 - 25];
-#line 3740 ""
+#line 3732 ""
} else {
-#line 3741 ""
+#line 3733 ""
ybot = comxtup_1.islope[commvl_1.ivx - 1] / all_1.slfac *
comxtup_1.xelsk[inb - 1] + comxtup_1.nolev1[
commvl_1.ivx - 1] - all_1.stemlen - zmult;
-#line 3743 ""
+#line 3735 ""
}
-#line 3744 ""
+#line 3736 ""
ymin = dmin(ymin,ybot);
-#line 3745 ""
+#line 3737 ""
}
-#line 3746 ""
+#line 3738 ""
/* L3: */
-#line 3746 ""
+#line 3738 ""
}
-#line 3747 ""
+#line 3739 ""
maxdrop = ncmid_(&all_1.iv, &ipb1) - 4 - ymin + 5.01f;
/* Computing MAX */
-#line 3748 ""
+#line 3740 ""
i__4 = all_1.ifigdr[ivf + (all_1.iline << 1) - 3];
-#line 3748 ""
+#line 3740 ""
all_1.ifigdr[ivf + (all_1.iline << 1) - 3] = max(i__4,maxdrop);
-#line 3749 ""
+#line 3741 ""
}
/* Compute ornament levels if needed */
-#line 3753 ""
+#line 3745 ""
nomornlev = ncmid_(&all_1.iv, &ipb1) + 5;
-#line 3754 ""
+#line 3746 ""
iorn = 0;
-#line 3755 ""
+#line 3747 ""
i__4 = comipb_1.nnb;
-#line 3755 ""
+#line 3747 ""
for (inb = 1; inb <= i__4; ++inb) {
-#line 3756 ""
+#line 3748 ""
ip = comipb_1.ipb[inb - 1];
-#line 3757 ""
+#line 3749 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],23)) {
-#line 3757 ""
+#line 3749 ""
goto L8;
-#line 3757 ""
+#line 3749 ""
}
-#line 3758 ""
+#line 3750 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26) && *(
unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] ==
'l') {
/* letter-dynamic or hairpin ending under down-beamed */
-#line 3762 ""
+#line 3754 ""
++iorn;
-#line 3763 ""
+#line 3755 ""
ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] - all_1.stemlen +
comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[inb
- 1] / all_1.slfac + 1 - (multb - 1) * 1.2f;
/* Computing MIN */
-#line 3765 ""
+#line 3757 ""
r__1 = ybeam - 3.f;
-#line 3765 ""
+#line 3757 ""
i__5 = i_nint(&r__1), i__6 = nomornlev - 10;
-#line 3765 ""
+#line 3757 ""
ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6);
-#line 3766 ""
+#line 3758 ""
} else if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* Bits 0-13: (stmgx+Tupf._) , 14: Down fermata, was F */
@@ -9640,52 +9634,52 @@ L6:
/* Non-chord. There IS an ornament. Need ihornb only if upbeam, and if */
/* ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) */
-#line 3774 ""
+#line 3766 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] ==
'u' && (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] *
24 - 1] & 4163566) > 0) {
-#line 3776 ""
+#line 3768 ""
++iorn;
-#line 3777 ""
+#line 3769 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(all_1.iornq[
commvl_1.ivx + ip * 24 - 1],22);
-#line 3778 ""
+#line 3770 ""
ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] + all_1.stemlen +
comxtup_1.islope[commvl_1.ivx - 1] * comxtup_1.xelsk[
inb - 1] / all_1.slfac - 1 + (multb - 1) * 1.2f;
/* Computing MAX */
-#line 3780 ""
+#line 3772 ""
r__1 = ybeam + 3.f;
-#line 3780 ""
+#line 3772 ""
i__5 = i_nint(&r__1);
-#line 3780 ""
+#line 3772 ""
ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev);
-#line 3781 ""
+#line 3773 ""
}
-#line 3782 ""
+#line 3774 ""
} else {
/* In a chord. Orn may be on main note or non-main or both. Set ihornb if */
/* upbeam and highest note has orn, or down beam and lowest. Find 1st chord note */
-#line 3787 ""
+#line 3779 ""
i__5 = comtrill_1.ncrd;
-#line 3787 ""
+#line 3779 ""
for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__5;
++comtrill_1.icrd1) {
-#line 3788 ""
+#line 3780 ""
if ((255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1]) == ip && (
15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 -
1], (ftnlen)-8)) == commvl_1.ivx) {
-#line 3788 ""
+#line 3780 ""
goto L11;
-#line 3788 ""
+#line 3780 ""
}
-#line 3790 ""
+#line 3782 ""
/* L10: */
-#line 3790 ""
+#line 3782 ""
}
-#line 3791 ""
+#line 3783 ""
L11:
/* Find outermost note, min or max depending on beam direction ulq. xto is true */
@@ -9693,126 +9687,126 @@ L11:
/* on extreme chord note in beam, will move. */
/* So ornaments are all except 0,4,13 (,g,) */
-#line 3798 ""
+#line 3790 ""
levx = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
-#line 3799 ""
+#line 3791 ""
xto = (all_1.iornq[commvl_1.ivx + comipb_1.ipb[inb - 1] * 24 - 1]
& 4186094) > 0;
-#line 3800 ""
+#line 3792 ""
icrdx = 0;
-#line 3801 ""
+#line 3793 ""
i__5 = comtrill_1.ncrd;
-#line 3801 ""
+#line 3793 ""
for (icrd = comtrill_1.icrd1; icrd <= i__5; ++icrd) {
-#line 3802 ""
+#line 3794 ""
if ((255 & comtrill_1.icrdat[icrd - 1]) != ip || (15 &
lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)-8))
!= commvl_1.ivx) {
-#line 3802 ""
+#line 3794 ""
goto L13;
-#line 3802 ""
+#line 3794 ""
}
-#line 3804 ""
+#line 3796 ""
levc = 127 & lbit_shift(comtrill_1.icrdat[icrd - 1], (ftnlen)
-12);
-#line 3805 ""
+#line 3797 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
== 'u' && levc > levx || *(unsigned char *)&
all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'l' &&
levc < levx) {
-#line 3807 ""
+#line 3799 ""
levx = levc;
-#line 3808 ""
+#line 3800 ""
icrdx = icrd;
-#line 3809 ""
+#line 3801 ""
xto = (comtrill_1.icrdorn[icrd - 1] & 4186094) > 0;
-#line 3810 ""
+#line 3802 ""
}
-#line 3811 ""
+#line 3803 ""
/* L12: */
-#line 3811 ""
+#line 3803 ""
}
-#line 3812 ""
+#line 3804 ""
L13:
/* If there's orn on extreme note, do stuff */
-#line 3816 ""
+#line 3808 ""
if (xto) {
-#line 3817 ""
+#line 3809 ""
++iorn;
-#line 3818 ""
+#line 3810 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25]
== 'u') {
-#line 3819 ""
+#line 3811 ""
ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] +
all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1]
* comxtup_1.xelsk[inb - 1] / all_1.slfac - 1 + (
multb - 1) * 1.2f;
/* Computing MAX */
-#line 3821 ""
+#line 3813 ""
r__1 = ybeam + 3.f;
-#line 3821 ""
+#line 3813 ""
i__5 = i_nint(&r__1);
-#line 3821 ""
+#line 3813 ""
ihornb[commvl_1.ivx + iorn * 24] = max(i__5,nomornlev);
-#line 3822 ""
+#line 3814 ""
} else {
-#line 3823 ""
+#line 3815 ""
ybeam = comxtup_1.nolev1[commvl_1.ivx - 1] -
all_1.stemlen + comxtup_1.islope[commvl_1.ivx - 1]
* comxtup_1.xelsk[inb - 1] / all_1.slfac + 1 - (
multb - 1) * 1.2f;
/* Computing MIN */
-#line 3825 ""
+#line 3817 ""
r__1 = ybeam - 3.f;
-#line 3825 ""
+#line 3817 ""
i__5 = i_nint(&r__1), i__6 = nomornlev - 10;
-#line 3825 ""
+#line 3817 ""
ihornb[commvl_1.ivx + iorn * 24] = min(i__5,i__6);
-#line 3826 ""
+#line 3818 ""
}
-#line 3827 ""
+#line 3819 ""
if (icrdx == 0) {
/* Affected ornament is on main note */
-#line 3831 ""
+#line 3823 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
all_1.iornq[commvl_1.ivx + ip * 24 - 1],22);
-#line 3832 ""
+#line 3824 ""
} else {
-#line 3833 ""
+#line 3825 ""
comtrill_1.icrdorn[icrdx - 1] = bit_set(
comtrill_1.icrdorn[icrdx - 1],22);
-#line 3834 ""
+#line 3826 ""
}
-#line 3835 ""
+#line 3827 ""
}
-#line 3836 ""
+#line 3828 ""
}
-#line 3837 ""
+#line 3829 ""
L8:
-#line 3837 ""
+#line 3829 ""
;
-#line 3837 ""
+#line 3829 ""
}
/* Henceforth nornb will be a counter. */
-#line 3841 ""
+#line 3833 ""
if (iorn > 0) {
-#line 3841 ""
+#line 3833 ""
nornb[commvl_1.ivx] = 1;
-#line 3841 ""
+#line 3833 ""
}
-#line 3842 ""
+#line 3834 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 2) {
-#line 3842 ""
+#line 3834 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
-#line 3842 ""
+#line 3834 ""
}
-#line 3843 ""
+#line 3835 ""
return 0;
} /* beamstrt_ */
@@ -9834,47 +9828,45 @@ L8:
/* Local variables */
static integer iptr;
-/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
-/* logical gotclef */
-#line 3927 ""
+#line 3917 ""
i__1 = c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1;
-#line 3927 ""
+#line 3917 ""
for (iptr = c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1]; iptr <= i__1;
++iptr) {
-#line 3928 ""
+#line 3918 ""
if ((r__1 = *space - c1omnotes_1.durb[iptr - 1], dabs(r__1)) <
comtol_1.tol) {
-#line 3929 ""
+#line 3919 ""
if ((r__1 = *squez - c1omnotes_1.sqzb[iptr - 1], dabs(r__1)) <
comtol_1.tol) {
/* Increment pre-existing entry */
-#line 3933 ""
+#line 3923 ""
c1omnotes_1.nnpd[iptr - 1] += *nnsk;
-#line 3934 ""
+#line 3924 ""
return 0;
-#line 3935 ""
+#line 3925 ""
}
-#line 3936 ""
+#line 3926 ""
}
-#line 3937 ""
+#line 3927 ""
/* L16: */
-#line 3937 ""
+#line 3927 ""
}
/* Didn't find current duration & squez, so add a new entry. */
/* No particular reason to keep in order, so add at the end. */
-#line 3942 ""
+#line 3932 ""
c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *nnsk;
-#line 3943 ""
+#line 3933 ""
c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *space;
-#line 3944 ""
+#line 3934 ""
c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt] - 1] = *squez;
-#line 3945 ""
+#line 3935 ""
++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
-#line 3946 ""
+#line 3936 ""
return 0;
} /* catspace_ */
@@ -9884,9 +9876,9 @@ L8:
/* The only reason for this seemingly do-nothing function is to get around an */
/* apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! */
-#line 3953 ""
+#line 3943 ""
*(unsigned char *)ret_val = (char) (*n);
-#line 3954 ""
+#line 3944 ""
return ;
} /* chax_ */
@@ -9897,7 +9889,7 @@ L8:
address a__1[3];
integer i__1, i__2[3], i__3;
real r__1;
- char ch__1[4], ch__2[1];
+ char ch__1[1], ch__2[4];
icilist ici__1;
/* Builtin functions */
@@ -9921,238 +9913,244 @@ L8:
ftnlen, ftnlen);
static char dynsymq[4];
-#line 3961 ""
+#line 3951 ""
txtdyn = FALSE_;
/* On entry, iccount is on "D" */
-#line 3965 ""
+#line 3955 ""
i__1 = *iccount;
-#line 3965 ""
- if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
+#line 3955 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 3955 ""
+ if (s_cmp(lineq + i__1, ch__1, *iccount + 1 - i__1, (ftnlen)1) == 0) {
/* Dynamic text */
-#line 3970 ""
+#line 3960 ""
istart = *iccount + 2;
/* 1 past 1st quote */
-#line 3971 ""
+#line 3961 ""
L3:
-#line 3972 ""
- iend = i_indx(lineq + (istart - 1), "\"", 128 - (istart - 1), (ftnlen)
- 1);
-#line 3973 ""
+#line 3962 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 3962 ""
+ iend = i_indx(lineq + (istart - 1), ch__1, 128 - (istart - 1), (
+ ftnlen)1);
+#line 3963 ""
i__1 = istart + iend - 3;
-#line 3973 ""
- if (s_cmp(lineq + i__1, "\\", istart + iend - 2 - i__1, (ftnlen)1) ==
- 0) {
-#line 3974 ""
+#line 3963 ""
+ chax_(ch__1, (ftnlen)1, &c__92);
+#line 3963 ""
+ if (s_cmp(lineq + i__1, ch__1, istart + iend - 2 - i__1, (ftnlen)1) ==
+ 0) {
+#line 3964 ""
istart = *iccount + iend + 2;
-#line 3975 ""
+#line 3965 ""
goto L3;
-#line 3976 ""
+#line 3966 ""
}
-#line 3977 ""
+#line 3967 ""
if (iend == 0) {
-#line 3978 ""
+#line 3968 ""
i__1 = *iccount + 1;
-#line 3978 ""
+#line 3968 ""
errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit"\
"h double quote!", (ftnlen)128, (ftnlen)50);
-#line 3980 ""
+#line 3970 ""
stop1_();
-#line 3981 ""
+#line 3971 ""
}
/* Set iccount to character after 2nd ", and set ipm */
/* iccount = iccount+iend+2 */
-#line 3986 ""
+#line 3976 ""
*iccount = istart + iend;
-#line 3987 ""
+#line 3977 ""
ipm = i_indx("- +", lineq + (*iccount - 1), (ftnlen)3, (ftnlen)1);
-#line 3988 ""
+#line 3978 ""
if (ipm == 0) {
-#line 3989 ""
+#line 3979 ""
errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h"\
"ere!", (ftnlen)128, (ftnlen)33);
-#line 3991 ""
+#line 3981 ""
stop1_();
-#line 3992 ""
+#line 3982 ""
}
-#line 3993 ""
+#line 3983 ""
} else {
/* Expect ordinary dynamic */
-#line 3997 ""
+#line 3987 ""
for (iend = *iccount + 2; iend <= 128; ++iend) {
-#line 3998 ""
+#line 3988 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
-#line 3999 ""
+#line 3989 ""
if (ipm > 0) {
-#line 3999 ""
+#line 3989 ""
goto L2;
-#line 3999 ""
+#line 3989 ""
}
-#line 4000 ""
+#line 3990 ""
/* L1: */
-#line 4000 ""
+#line 3990 ""
}
-#line 4001 ""
+#line 3991 ""
L2:
-#line 4002 ""
+#line 3992 ""
if (iend - *iccount > 5 || iend - *iccount < 2) {
-#line 4003 ""
+#line 3993 ""
i__1 = iend - 1;
-#line 4003 ""
+#line 3993 ""
errmsg_(lineq, &i__1, ibar, "Wrong length for dynamic mark!", (
ftnlen)128, (ftnlen)30);
-#line 4005 ""
+#line 3995 ""
stop1_();
-#line 4006 ""
+#line 3996 ""
}
-#line 4007 ""
+#line 3997 ""
i__1 = *iccount;
-#line 4007 ""
+#line 3997 ""
ici__1.icierr = 0;
-#line 4007 ""
+#line 3997 ""
ici__1.iciend = 0;
-#line 4007 ""
+#line 3997 ""
ici__1.icirnum = 1;
-#line 4007 ""
+#line 3997 ""
ici__1.icirlen = iend - 1 - i__1;
-#line 4007 ""
+#line 3997 ""
ici__1.iciunit = lineq + i__1;
/* Writing concatenation */
-#line 4007 ""
+#line 3997 ""
i__2[0] = 2, a__1[0] = "(a";
-#line 4007 ""
+#line 3997 ""
i__3 = iend + 47 - *iccount;
-#line 4007 ""
- chax_(ch__2, (ftnlen)1, &i__3);
-#line 4007 ""
- i__2[1] = 1, a__1[1] = ch__2;
-#line 4007 ""
+#line 3997 ""
+ chax_(ch__1, (ftnlen)1, &i__3);
+#line 3997 ""
+ i__2[1] = 1, a__1[1] = ch__1;
+#line 3997 ""
i__2[2] = 1, a__1[2] = ")";
-#line 4007 ""
- ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
-#line 4007 ""
+#line 3997 ""
+ ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2);
+#line 3997 ""
s_rsfi(&ici__1);
-#line 4007 ""
+#line 3997 ""
do_fio(&c__1, dynsymq, (ftnlen)4);
-#line 4007 ""
+#line 3997 ""
e_rsfi();
-#line 4009 ""
+#line 3999 ""
idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< "\
"> ", dynsymq, (ftnlen)56, (ftnlen)4) + 3) / 4;
-#line 4012 ""
+#line 4002 ""
if (idno == 0) {
-#line 4013 ""
+#line 4003 ""
i__1 = *iccount + 1;
-#line 4013 ""
+#line 4003 ""
errmsg_(lineq, &i__1, ibar, "Illegal dynamic mark!", (ftnlen)128,
(ftnlen)21);
-#line 4014 ""
+#line 4004 ""
stop1_();
-#line 4015 ""
+#line 4005 ""
}
-#line 4016 ""
+#line 4006 ""
*iccount = iend;
-#line 4017 ""
+#line 4007 ""
}
-#line 4018 ""
+#line 4008 ""
if (ipm != 2) {
/* There is a vertical shift, have "+" or "-" */
-#line 4022 ""
+#line 4012 ""
++(*iccount);
-#line 4023 ""
+#line 4013 ""
if (i_indx("0123456789", lineq + (*iccount - 1), (ftnlen)10, (ftnlen)
1) == 0) {
-#line 4024 ""
+#line 4014 ""
errmsg_(lineq, iccount, ibar, "Expected integer here for vertica"\
"l offset!", (ftnlen)128, (ftnlen)42);
-#line 4026 ""
+#line 4016 ""
stop1_();
-#line 4027 ""
+#line 4017 ""
}
-#line 4028 ""
+#line 4018 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 4029 ""
+#line 4019 ""
idno = i_nint(&fnum);
-#line 4030 ""
+#line 4020 ""
if (idno > 63) {
-#line 4031 ""
+#line 4021 ""
i__1 = *iccount - 1;
-#line 4031 ""
+#line 4021 ""
errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu"\
"st be (-63,63)!", (ftnlen)128, (ftnlen)50);
-#line 4033 ""
+#line 4023 ""
stop1_();
-#line 4034 ""
+#line 4024 ""
}
-#line 4035 ""
+#line 4025 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
-#line 4036 ""
+#line 4026 ""
if (ipm == 0) {
-#line 4037 ""
+#line 4027 ""
errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h"\
"ere!", (ftnlen)128, (ftnlen)33);
-#line 4039 ""
+#line 4029 ""
stop1_();
-#line 4040 ""
+#line 4030 ""
}
-#line 4041 ""
+#line 4031 ""
if (ipm != 2) {
/* There is a horizontal shift */
-#line 4045 ""
+#line 4035 ""
++(*iccount);
-#line 4046 ""
+#line 4036 ""
if (i_indx(".0123456789", lineq + (*iccount - 1), (ftnlen)11, (
ftnlen)1) == 0) {
-#line 4047 ""
+#line 4037 ""
errmsg_(lineq, iccount, ibar, "Expected number here for hori"\
"zontal offset!", (ftnlen)128, (ftnlen)43);
-#line 4049 ""
+#line 4039 ""
stop1_();
-#line 4050 ""
+#line 4040 ""
}
-#line 4051 ""
+#line 4041 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 4052 ""
+#line 4042 ""
r__1 = fnum * 10;
-#line 4052 ""
+#line 4042 ""
idno = i_nint(&r__1);
-#line 4053 ""
+#line 4043 ""
if (idno > 255) {
-#line 4054 ""
+#line 4044 ""
i__1 = *iccount - 1;
-#line 4054 ""
+#line 4044 ""
errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m"\
"ark must be (-25.5,25.5)!", (ftnlen)128, (ftnlen)56);
-#line 4056 ""
+#line 4046 ""
stop1_();
-#line 4057 ""
+#line 4047 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 4058 ""
+#line 4048 ""
errmsg_(lineq, iccount, ibar, "There should be a blank here!",
(ftnlen)128, (ftnlen)29);
-#line 4060 ""
+#line 4050 ""
stop1_();
-#line 4061 ""
+#line 4051 ""
}
-#line 4062 ""
+#line 4052 ""
}
/* iccount should be on the blank at the end of the entire symbol */
-#line 4066 ""
+#line 4056 ""
}
-#line 4067 ""
+#line 4057 ""
return 0;
} /* checkdyn_ */
@@ -10171,15 +10169,15 @@ L2:
/* subroutine chkarp(found1,ncrd,icrdat,icrdot,ivx,ip,isacc,isarp, */
/* * icashft) */
-#line 4074 ""
+#line 4064 ""
/* Parameter adjustments */
-#line 4074 ""
+#line 4064 ""
--icrdat;
-#line 4074 ""
+#line 4064 ""
-#line 4074 ""
+#line 4064 ""
/* Function Body */
-#line 4074 ""
+#line 4064 ""
found1 = FALSE_;
/* icashft will be max left shift of accid's in chord notes. */
@@ -10187,19 +10185,19 @@ L2:
/* Will include left shift of chord note itself. */
/* Rezero after use. */
-#line 4081 ""
+#line 4071 ""
i__1 = *ncrd;
-#line 4081 ""
+#line 4071 ""
for (icrd = 1; icrd <= i__1; ++icrd) {
/* This if block cycles thru all chord notes on ivx,ip; then returns. */
-#line 4085 ""
+#line 4075 ""
if ((255 & icrdat[icrd]) == *ip && (15 & lbit_shift(icrdat[icrd], (
ftnlen)-8)) == *ivx) {
-#line 4087 ""
+#line 4077 ""
found1 = TRUE_;
-#line 4088 ""
+#line 4078 ""
*iscacc = *iscacc || bit_test(icrdat[icrd],19) && ! bit_test(
icrdat[icrd],27);
@@ -10223,19 +10221,19 @@ L2:
/* if (irshft .lt. 64) icashft = max(icashft,64-irshft) */
/* end if */
/* end if */
-#line 4111 ""
+#line 4101 ""
*isarp = *isarp || bit_test(icrdat[icrd],25);
-#line 4112 ""
+#line 4102 ""
} else if (found1) {
-#line 4113 ""
+#line 4103 ""
return 0;
-#line 4114 ""
+#line 4104 ""
}
-#line 4115 ""
+#line 4105 ""
/* L18: */
-#line 4115 ""
+#line 4105 ""
}
-#line 4116 ""
+#line 4106 ""
return 0;
} /* chkarp_ */
@@ -10252,36 +10250,36 @@ L2:
static cilist io___277 = { 0, 6, 0, "(a6,2x,4i8)", 0 };
-#line 4129 ""
+#line 4119 ""
if (commidi_1.imidi[*icm] >= 24576) {
-#line 4130 ""
+#line 4120 ""
s_wsle(&io___275);
-#line 4130 ""
+#line 4120 ""
e_wsle();
-#line 4131 ""
+#line 4121 ""
s_wsle(&io___276);
-#line 4131 ""
+#line 4121 ""
do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or"\
" worse", (ftnlen)52);
-#line 4131 ""
+#line 4121 ""
e_wsle();
-#line 4132 ""
+#line 4122 ""
s_wsfe(&io___277);
-#line 4132 ""
+#line 4122 ""
do_fio(&c__1, "imidi:", (ftnlen)6);
-#line 4132 ""
+#line 4122 ""
do_fio(&c__1, (char *)&commidi_1.imidi[0], (ftnlen)sizeof(integer));
-#line 4132 ""
+#line 4122 ""
do_fio(&c__1, (char *)&commidi_1.imidi[1], (ftnlen)sizeof(integer));
-#line 4132 ""
+#line 4122 ""
do_fio(&c__1, (char *)&commidi_1.imidi[2], (ftnlen)sizeof(integer));
-#line 4132 ""
+#line 4122 ""
do_fio(&c__1, (char *)&commidi_1.imidi[3], (ftnlen)sizeof(integer));
-#line 4132 ""
+#line 4122 ""
e_wsfe();
-#line 4134 ""
+#line 4124 ""
}
-#line 4135 ""
+#line 4125 ""
return 0;
} /* chkimidi_ */
@@ -10319,223 +10317,223 @@ L2:
/* otherwise next prior note. Relative to bottom line. */
/* if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then */
-#line 4157 ""
+#line 4147 ""
/* Parameter adjustments */
-#line 4157 ""
+#line 4147 ""
ipl -= 25;
-#line 4157 ""
+#line 4147 ""
mult -= 25;
-#line 4157 ""
+#line 4147 ""
--levbotr;
-#line 4157 ""
+#line 4147 ""
--levtopr;
-#line 4157 ""
+#line 4147 ""
nodur -= 25;
-#line 4157 ""
+#line 4147 ""
nib -= 25;
-#line 4157 ""
+#line 4147 ""
ivmx -= 25;
-#line 4157 ""
+#line 4147 ""
nolev -= 25;
-#line 4157 ""
+#line 4147 ""
irest -= 25;
-#line 4157 ""
+#line 4147 ""
islur -= 25;
-#line 4157 ""
+#line 4147 ""
--nn;
-#line 4157 ""
+#line 4147 ""
-#line 4157 ""
+#line 4147 ""
/* Function Body */
-#line 4157 ""
+#line 4147 ""
if (*ip != nn[*ivx] && ! bit_test(ipl[*ivx + *ip * 24],1)) {
/* Not the last note and not "look-left" for level */
-#line 4161 ""
+#line 4151 ""
i__1 = nn[*ivx];
-#line 4161 ""
+#line 4151 ""
for (kkp = *ip + 1; kkp <= i__1; ++kkp) {
-#line 4162 ""
+#line 4152 ""
if (bit_test(islur[*ivx + kkp * 24],29)) {
-#line 4162 ""
+#line 4152 ""
goto L4;
-#line 4162 ""
+#line 4152 ""
}
-#line 4163 ""
+#line 4153 ""
if (! bit_test(irest[*ivx + kkp * 24],0)) {
-#line 4164 ""
+#line 4154 ""
levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
/* Relative to botto */
-#line 4165 ""
+#line 4155 ""
goto L9;
-#line 4166 ""
+#line 4156 ""
}
-#line 4167 ""
+#line 4157 ""
/* L8: */
-#line 4167 ""
+#line 4157 ""
}
-#line 4168 ""
+#line 4158 ""
}
-#line 4169 ""
+#line 4159 ""
L4:
/* If here, there were no following notes or came to a blank rest, or */
/* "look-left" option set. So look before */
/* if (ip .eq. 1) go to 2 ! Get out if this is the first note. */
-#line 4175 ""
+#line 4165 ""
if (*ip == 1) {
-#line 4175 ""
+#line 4165 ""
return 0;
-#line 4175 ""
+#line 4165 ""
}
/* Get out if this is the first note. */
-#line 4176 ""
+#line 4166 ""
for (kkp = *ip - 1; kkp >= 1; --kkp) {
-#line 4177 ""
+#line 4167 ""
if (! bit_test(irest[*ivx + kkp * 24],0)) {
-#line 4178 ""
+#line 4168 ""
levnext = nolev[*ivx + kkp * 24] - ncmid_(iv, &kkp) + 4;
/* Relative to bottom */
-#line 4179 ""
+#line 4169 ""
goto L9;
-#line 4180 ""
+#line 4170 ""
}
-#line 4181 ""
+#line 4171 ""
/* L3: */
-#line 4181 ""
+#line 4171 ""
}
/* go to 2 ! Pretty odd, should never be here, but get out if so. */
-#line 4183 ""
+#line 4173 ""
return 0;
/* Pretty odd, should never be here, but get out if so. */
-#line 4184 ""
+#line 4174 ""
L9:
/* Find note in other voice at same time */
-#line 4188 ""
+#line 4178 ""
i__1 = *ivx - *nv - 1;
-#line 4188 ""
+#line 4178 ""
iupdown = i_sign(&c__1, &i__1);
-#line 4189 ""
+#line 4179 ""
ivother = ivmx[*iv + (3 - iupdown) / 2 * 24];
-#line 4190 ""
+#line 4180 ""
tother = 0.f;
-#line 4191 ""
+#line 4181 ""
i__1 = nib[ivother + *ibar * 24];
-#line 4191 ""
+#line 4181 ""
for (kkp = 1; kkp <= i__1; ++kkp) {
-#line 4192 ""
+#line 4182 ""
if ((r__1 = tother - *tnow, dabs(r__1)) < *tol) {
-#line 4192 ""
+#line 4182 ""
goto L6;
-#line 4192 ""
+#line 4182 ""
}
-#line 4193 ""
+#line 4183 ""
tother += nodur[ivother + kkp * 24];
-#line 4194 ""
+#line 4184 ""
/* L5: */
-#line 4194 ""
+#line 4184 ""
}
/* If here, then no note starts in other voice at same time, so set default */
-#line 4198 ""
+#line 4188 ""
levother = -iupdown * 50;
-#line 4199 ""
+#line 4189 ""
goto L7;
-#line 4200 ""
+#line 4190 ""
L6:
/* If here, have just identified a simultaneous note or rest in other voice */
-#line 4204 ""
+#line 4194 ""
if (! bit_test(irest[ivother + kkp * 24],0)) {
/* Not a rest, use it */
-#line 4205 ""
+#line 4195 ""
levother = nolev[ivother + kkp * 24] - ncmid_(iv, ip) + 4;
-#line 4206 ""
+#line 4196 ""
} else {
-#line 4207 ""
+#line 4197 ""
if (nodur[ivother + kkp * 24] == nodur[*ivx + *ip * 24]) {
/* Rest in other voice has same duration, get out (so defualt spacing is used) */
/* go to 2 */
-#line 4212 ""
+#line 4202 ""
return 0;
-#line 4213 ""
+#line 4203 ""
}
-#line 4214 ""
+#line 4204 ""
levother = -iupdown * 50;
-#line 4215 ""
+#line 4205 ""
}
-#line 4216 ""
+#line 4206 ""
L7:
-#line 4217 ""
+#line 4207 ""
if (*mode == 1) {
-#line 4218 ""
+#line 4208 ""
indxr = log2_(&nodur[*ivx + *ip * 24]) + 1;
-#line 4219 ""
+#line 4209 ""
} else {
/* nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) */
-#line 4221 ""
+#line 4211 ""
indxr = 4 - ((mult[*ivx + *ip * 24] & 15) - 8) + 1;
-#line 4222 ""
+#line 4212 ""
}
-#line 4223 ""
+#line 4213 ""
if (iupdown < 0) {
-#line 4224 ""
+#line 4214 ""
levtop = levtopr[indxr];
-#line 4225 ""
+#line 4215 ""
iraise1 = levother - levtop - 3;
/* Based on other note */
-#line 4226 ""
+#line 4216 ""
iraise2 = levnext - levtop;
/* Based on following note */
-#line 4227 ""
+#line 4217 ""
if (indxr == 5 && levnext < 1) {
-#line 4227 ""
+#line 4217 ""
iraise2 += 2;
-#line 4227 ""
+#line 4217 ""
}
-#line 4228 ""
+#line 4218 ""
iraise = min(iraise1,iraise2);
-#line 4229 ""
+#line 4219 ""
if ((iraise + 50) % 2 == 1 && iraise + levtop > -1) {
-#line 4229 ""
+#line 4219 ""
--iraise;
-#line 4229 ""
+#line 4219 ""
}
-#line 4231 ""
+#line 4221 ""
} else {
-#line 4232 ""
+#line 4222 ""
levbot = levbotr[indxr];
-#line 4233 ""
+#line 4223 ""
iraise1 = levother - levbot + 3;
-#line 4234 ""
+#line 4224 ""
iraise2 = levnext - levbot;
-#line 4235 ""
+#line 4225 ""
if (indxr == 5 && levnext > 8) {
-#line 4235 ""
+#line 4225 ""
--iraise2;
-#line 4235 ""
+#line 4225 ""
}
-#line 4236 ""
+#line 4226 ""
iraise = max(iraise1,iraise2);
-#line 4237 ""
+#line 4227 ""
if ((iraise + 50) % 2 == 1 && iraise + levbot <= 9) {
-#line 4237 ""
+#line 4227 ""
--iraise;
-#line 4237 ""
+#line 4227 ""
}
-#line 4239 ""
+#line 4229 ""
}
-#line 4240 ""
+#line 4230 ""
nolev[*ivx + *ip * 24] = iraise + 100;
-#line 4241 ""
+#line 4231 ""
return 0;
} /* chkkbdrests_ */
@@ -10552,80 +10550,80 @@ L7:
extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
ftnlen);
-#line 4246 ""
+#line 4236 ""
*literr = 0;
-#line 4247 ""
+#line 4237 ""
itype = 1;
-#line 4248 ""
+#line 4238 ""
L17:
-#line 4248 ""
+#line 4238 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 4249 ""
+#line 4239 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 4249 ""
+#line 4239 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
-#line 4250 ""
+#line 4240 ""
++itype;
-#line 4251 ""
+#line 4241 ""
if (itype > 3) {
-#line 4252 ""
+#line 4242 ""
*literr = 1;
-#line 4253 ""
+#line 4243 ""
return 0;
-#line 4254 ""
+#line 4244 ""
}
-#line 4255 ""
+#line 4245 ""
goto L17;
-#line 4256 ""
+#line 4246 ""
}
-#line 4257 ""
+#line 4247 ""
lenlit = itype;
-#line 4258 ""
+#line 4248 ""
L18:
-#line 4258 ""
+#line 4248 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 4259 ""
+#line 4249 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 4259 ""
+#line 4249 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
-#line 4260 ""
+#line 4250 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 4261 ""
+#line 4251 ""
if (*(unsigned char *)charq != ' ') {
/* Starting a new tex command withing the string */
-#line 4265 ""
+#line 4255 ""
lenlit += 2;
-#line 4266 ""
+#line 4256 ""
if (lenlit > 128) {
-#line 4267 ""
+#line 4257 ""
*literr = 2;
-#line 4268 ""
+#line 4258 ""
return 0;
-#line 4269 ""
+#line 4259 ""
}
-#line 4270 ""
+#line 4260 ""
goto L18;
-#line 4271 ""
+#line 4261 ""
}
-#line 4272 ""
+#line 4262 ""
} else {
-#line 4273 ""
+#line 4263 ""
++lenlit;
-#line 4274 ""
+#line 4264 ""
if (lenlit > 128) {
-#line 4275 ""
+#line 4265 ""
*literr = 2;
-#line 4276 ""
+#line 4266 ""
return 0;
-#line 4277 ""
+#line 4267 ""
}
-#line 4278 ""
+#line 4268 ""
goto L18;
-#line 4279 ""
+#line 4269 ""
}
-#line 4280 ""
+#line 4270 ""
return 0;
} /* chklit_ */
@@ -10657,11 +10655,11 @@ L18:
/* numbers. If moved=.true., iccount on exit is on end of last number. */
/* If moved=.false., iccount still on +/- */
-#line 4293 ""
+#line 4283 ""
i__1 = *iccount - 2;
-#line 4293 ""
+#line 4283 ""
i__2 = *iccount;
-#line 4293 ""
+#line 4283 ""
if (i_indx("sfnA", lineq + i__1, (ftnlen)4, *iccount - 1 - i__1) > 0 &&
i_indx("0123456789.", lineq + i__2, (ftnlen)11, *iccount + 1 -
i__2) > 0) {
@@ -10669,100 +10667,100 @@ L18:
/* Prior char was accid & next is #; this may be start of accidental shift. */
/* Must test for "." above in case we get "<" or ">" */
-#line 4299 ""
+#line 4289 ""
ipm = i_indx("- +< >", lineq + (*iccount - 1), (ftnlen)6, (ftnlen)1)
- 2;
-#line 4300 ""
+#line 4290 ""
i__1 = *iccount + 1;
-#line 4300 ""
+#line 4290 ""
i__2 = *iccount;
-#line 4300 ""
+#line 4290 ""
if (s_cmp(lineq + i__2, ".", *iccount + 1 - i__2, (ftnlen)1) == 0 &&
i_indx("0123456789", lineq + i__1, (ftnlen)10, *iccount + 2 -
i__1) == 0) {
/* Rare case of [accid][+/-].[letter]. Bail out */
-#line 4305 ""
+#line 4295 ""
*moved = FALSE_;
-#line 4306 ""
+#line 4296 ""
return 0;
-#line 4307 ""
+#line 4297 ""
}
-#line 4308 ""
+#line 4298 ""
ishorz = ipm > 1;
/* Save iccount in case it's not accid shift and we have to reset. */
-#line 4312 ""
+#line 4302 ""
icsav = *iccount;
-#line 4313 ""
+#line 4303 ""
++(*iccount);
-#line 4314 ""
+#line 4304 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 4315 ""
+#line 4305 ""
if (ishorz || i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* This has to be accidental shift. Set vert. shift. */
-#line 4319 ""
+#line 4309 ""
if (! ishorz) {
/* +/- syntax, both shifts set, vertical first */
-#line 4323 ""
+#line 4313 ""
i__1 = (integer) (ipm * fnum + 32.5f);
-#line 4323 ""
+#line 4313 ""
setbits_(nacc, &c__6, &c__4, &i__1);
-#line 4324 ""
+#line 4314 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
-#line 4325 ""
+#line 4315 ""
++(*iccount);
-#line 4326 ""
+#line 4316 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 4327 ""
+#line 4317 ""
} else {
/* </> syntax, only horiz set */
-#line 4331 ""
+#line 4321 ""
ipm += -3;
-#line 4332 ""
+#line 4322 ""
}
/* Set horiz. shift */
-#line 4336 ""
+#line 4326 ""
r__1 = (ipm * fnum + 5.35f) * 20;
-#line 4336 ""
+#line 4326 ""
i__1 = i_nint(&r__1);
-#line 4336 ""
+#line 4326 ""
setbits_(nacc, &c__7, &c__10, &i__1);
-#line 4337 ""
+#line 4327 ""
--(*iccount);
-#line 4338 ""
+#line 4328 ""
*moved = TRUE_;
-#line 4339 ""
+#line 4329 ""
} else {
/* False alarm. Reset everything and flow onward */
-#line 4343 ""
+#line 4333 ""
*moved = FALSE_;
-#line 4344 ""
+#line 4334 ""
*iccount = icsav;
-#line 4345 ""
+#line 4335 ""
}
-#line 4346 ""
+#line 4336 ""
} else {
/* Either prior char was not 'sfn' or next was not digit, so take no action */
-#line 4350 ""
+#line 4340 ""
*moved = FALSE_;
-#line 4351 ""
+#line 4341 ""
}
-#line 4352 ""
+#line 4342 ""
return 0;
} /* chkpm4ac_ */
@@ -10785,62 +10783,62 @@ L18:
/* Returns string calling Don's TeX macro \pmxclef, for drawing small clefs. */
-#line 4360 ""
+#line 4350 ""
*nclef = lbit_shift(*isl, (ftnlen)-12) & 7;
-#line 4361 ""
+#line 4351 ""
if (*nclef == 0) {
/* treble */
-#line 4365 ""
+#line 4355 ""
nlev = 2;
-#line 4366 ""
+#line 4356 ""
} else if (*nclef > 6) {
/* French violin */
-#line 4370 ""
+#line 4360 ""
nlev = 0;
-#line 4371 ""
+#line 4361 ""
} else if (*nclef < 5) {
/* C-clef */
-#line 4375 ""
+#line 4365 ""
nlev = (*nclef << 1) - 2;
-#line 4376 ""
+#line 4366 ""
} else {
/* F-clef */
-#line 4380 ""
+#line 4370 ""
nlev = (*nclef << 1) - 6;
-#line 4381 ""
+#line 4371 ""
}
/* Writing concatenation */
-#line 4382 ""
+#line 4372 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 4382 ""
+#line 4372 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 4382 ""
+#line 4372 ""
i__1[1] = 7, a__1[1] = "pmxclef";
-#line 4382 ""
+#line 4372 ""
i__2 = min(*nclef,7) + 48;
-#line 4382 ""
+#line 4372 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 4382 ""
+#line 4372 ""
i__1[2] = 1, a__1[2] = ch__2;
-#line 4382 ""
+#line 4372 ""
i__3 = nlev + 48;
-#line 4382 ""
+#line 4372 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 4382 ""
+#line 4372 ""
i__1[3] = 1, a__1[3] = ch__3;
-#line 4382 ""
+#line 4372 ""
s_cat(notexq, a__1, i__1, &c__4, notexq_len);
-#line 4384 ""
+#line 4374 ""
*lnote = 10;
-#line 4385 ""
+#line 4375 ""
return 0;
} /* clefsym_ */
@@ -10915,17 +10913,17 @@ L18:
/* icrdot(icrd)(27-29) = level rank of chord-note among accid-notes */
/* twooftwo will be true 2nd time thru; signal to store shifts w/ notes */
-#line 4412 ""
+#line 4402 ""
/* Parameter adjustments */
-#line 4412 ""
+#line 4402 ""
--ksegrb0;
-#line 4412 ""
+#line 4402 ""
segrb0 -= 3;
-#line 4412 ""
+#line 4402 ""
--micrd;
-#line 4412 ""
+#line 4402 ""
-#line 4412 ""
+#line 4402 ""
/* Function Body */
/* Fancy sharp boundary. fl,sh,na,dfl,dsh */
@@ -10942,152 +10940,152 @@ L18:
/* Set up barrier segrb(iseg,ipoint) to define coords of corner points */
/* on stem+notes */
-#line 4443 ""
+#line 4433 ""
i__1 = *nsegrb0;
-#line 4443 ""
+#line 4433 ""
for (iseg = 1; iseg <= i__1; ++iseg) {
-#line 4444 ""
+#line 4434 ""
segrb[(iseg << 1) - 2] = segrb0[(iseg << 1) + 1];
-#line 4445 ""
+#line 4435 ""
segrb[(iseg << 1) - 1] = segrb0[(iseg << 1) + 2];
-#line 4446 ""
+#line 4436 ""
ksegrb[iseg - 1] = ksegrb0[iseg];
-#line 4447 ""
+#line 4437 ""
/* L11: */
-#line 4447 ""
+#line 4437 ""
}
-#line 4448 ""
+#line 4438 ""
nsegrb = *nsegrb0;
-#line 4449 ""
+#line 4439 ""
*rmsshift = 0.f;
-#line 4450 ""
+#line 4440 ""
shiftmin = 1e3f;
-#line 4451 ""
+#line 4441 ""
i__1 = *naccid;
-#line 4451 ""
+#line 4441 ""
for (iwa = 1; iwa <= i__1; ++iwa) {
/* Initialize shift for this note */
-#line 4455 ""
+#line 4445 ""
shift = 0.f;
-#line 4456 ""
+#line 4446 ""
mainnote = micrd[iwa] == 0;
-#line 4457 ""
+#line 4447 ""
isetshft[iwa - 1] = -1;
/* Get note level and accidental type */
-#line 4461 ""
+#line 4451 ""
if (mainnote) {
-#line 4462 ""
+#line 4452 ""
nolev = *nolevm;
-#line 4463 ""
+#line 4453 ""
iacctype = iacctbl[igetbits_(nacc, &c__3, &c__0) - 1];
-#line 4464 ""
+#line 4454 ""
} else {
-#line 4465 ""
+#line 4455 ""
nolev = igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &c__7, &
c__12);
-#line 4466 ""
+#line 4456 ""
iacctype = iacctbl[igetbits_(&comtrill_1.icrdat[micrd[iwa] - 1], &
c__3, &c__20) - 1];
-#line 4467 ""
+#line 4457 ""
}
/* Cycle thru segments on right edge of this accidental */
-#line 4471 ""
+#line 4461 ""
i__2 = nsegar[iacctype - 1] - 1;
-#line 4471 ""
+#line 4461 ""
for (isega = 1; isega <= i__2; ++isega) {
-#line 4472 ""
+#line 4462 ""
ybotaseg = nolev + segar[iacctype + ((isega << 1) + 2) * 5 - 16];
-#line 4473 ""
+#line 4463 ""
ytopaseg = nolev + segar[iacctype + ((isega + 1 << 1) + 2) * 5 -
16];
/* Cycle thru segments of right-hand barrier */
-#line 4477 ""
+#line 4467 ""
i__3 = nsegrb - 1;
-#line 4477 ""
+#line 4467 ""
for (isegrb = 1; isegrb <= i__3; ++isegrb) {
/* Must find all barrier segments that start below ytopseg & end above ybotseg */
-#line 4481 ""
+#line 4471 ""
if (segrb[(isegrb << 1) - 1] < ytopaseg) {
/* Barrier seg starts below top of accid */
/* Check if barrier seg ends above bottom of accid */
-#line 4486 ""
+#line 4476 ""
if (segrb[(isegrb + 1 << 1) - 1] > ybotaseg) {
-#line 4487 ""
+#line 4477 ""
if (shift > segrb[(isegrb << 1) - 2] - segar[iacctype
+ ((isega << 1) + 1) * 5 - 16]) {
-#line 4489 ""
+#line 4479 ""
shift = segrb[(isegrb << 1) - 2] - segar[iacctype
+ ((isega << 1) + 1) * 5 - 16];
/* Record the cause of the shift */
-#line 4493 ""
+#line 4483 ""
isetshft[iwa - 1] = ksegrb[isegrb - 1];
-#line 4494 ""
+#line 4484 ""
}
-#line 4495 ""
+#line 4485 ""
}
/* Does barrier segment end above top of accid seg? */
-#line 4499 ""
+#line 4489 ""
if (segrb[(isegrb + 1 << 1) - 1] > ytopaseg) {
-#line 4499 ""
+#line 4489 ""
goto L4;
-#line 4499 ""
+#line 4489 ""
}
-#line 4500 ""
+#line 4490 ""
}
-#line 4501 ""
+#line 4491 ""
/* L3: */
-#line 4501 ""
+#line 4491 ""
}
-#line 4502 ""
+#line 4492 ""
L4:
-#line 4503 ""
+#line 4493 ""
/* L2: */
-#line 4503 ""
+#line 4493 ""
;
-#line 4503 ""
+#line 4493 ""
}
-#line 4504 ""
+#line 4494 ""
if (! bit_test(*nacc,28) && dabs(shift) > 1e-4f && ! (*lasttime)) {
/* if (nolev .eq. levmaxacc) then */
-#line 4507 ""
+#line 4497 ""
if (nolev == *levmaxacc && isetshft[iwa - 1] == -1) {
-#line 4508 ""
+#line 4498 ""
*rmsshift = 1e3f;
-#line 4509 ""
+#line 4499 ""
return 0;
-#line 4510 ""
+#line 4500 ""
}
/* Does the following properly account for left-shifted noteheads? */
/* Top-down rank of this note we just shifted */
-#line 4516 ""
+#line 4506 ""
if (mainnote) {
-#line 4517 ""
+#line 4507 ""
irank = *icrdot0;
-#line 4518 ""
+#line 4508 ""
} else {
-#line 4519 ""
+#line 4509 ""
irank = igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__3, &
c__27);
-#line 4520 ""
+#line 4510 ""
}
/* Compare level-rank of this note vs. that of note that caused the shift. */
@@ -11100,264 +11098,264 @@ L4:
/* icrd: Chord-note accidental */
/* isetshft(i),i=1,naccid: what set shift for this accid, same codes */
-#line 4532 ""
+#line 4522 ""
if (isetshft[iwa - 1] < 0) {
-#line 4533 ""
+#line 4523 ""
iranksetter = 0;
-#line 4534 ""
+#line 4524 ""
} else if (isetshft[iwa - 1] == 0) {
-#line 4535 ""
+#line 4525 ""
iranksetter = *icrdot0;
-#line 4536 ""
+#line 4526 ""
} else {
-#line 4537 ""
+#line 4527 ""
iranksetter = igetbits_(&comtrill_1.icrdot[isetshft[iwa - 1]
- 1], &c__3, &c__27);
-#line 4538 ""
+#line 4528 ""
}
-#line 4539 ""
+#line 4529 ""
if (iranksetter != 0 && irank != iranksetter + 1) {
-#line 4540 ""
+#line 4530 ""
*rmsshift = 1e3f;
-#line 4541 ""
+#line 4531 ""
return 0;
-#line 4542 ""
+#line 4532 ""
}
-#line 4543 ""
+#line 4533 ""
}
/* Computing 2nd power */
-#line 4544 ""
+#line 4534 ""
r__1 = shift;
-#line 4544 ""
+#line 4534 ""
*rmsshift += r__1 * r__1;
-#line 4545 ""
+#line 4535 ""
if (*lasttime && dabs(shift) > 1e-4f) {
-#line 4546 ""
+#line 4536 ""
if (mainnote) {
-#line 4547 ""
+#line 4537 ""
if (! bit_test(*nacc,29)) {
-#line 4547 ""
+#line 4537 ""
goto L10;
-#line 4547 ""
+#line 4537 ""
}
-#line 4548 ""
+#line 4538 ""
} else {
-#line 4549 ""
+#line 4539 ""
if (! bit_test(comtrill_1.icrdat[micrd[iwa] - 1],29)) {
-#line 4549 ""
+#line 4539 ""
goto L10;
-#line 4549 ""
+#line 4539 ""
}
-#line 4550 ""
+#line 4540 ""
}
/* If here, "A" was set on a manual shift, so must cumulate the shift. Note that if there */
/* was a manual shift but auto-shift was zero, will not come thru here, but shift value */
/* will be left intact. */
-#line 4556 ""
+#line 4546 ""
if (mainnote) {
-#line 4557 ""
+#line 4547 ""
shift += (igetbits_(nacc, &c__7, &c__10) - 107) * .05f;
-#line 4558 ""
+#line 4548 ""
} else {
-#line 4559 ""
+#line 4549 ""
shift += (igetbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7,
&c__20) - 107) * .05f;
-#line 4560 ""
+#line 4550 ""
}
-#line 4561 ""
+#line 4551 ""
L10:
-#line 4562 ""
+#line 4552 ""
if (*twooftwo) {
/* Record the shift for this accidental */
-#line 4566 ""
+#line 4556 ""
if (shift < -5.35f) {
-#line 4567 ""
+#line 4557 ""
printl_(" ", (ftnlen)1);
-#line 4568 ""
+#line 4558 ""
printl_("WARNING: auto-generated accidental shift too bi"\
"g for PMX, ignoring", (ftnlen)66);
-#line 4570 ""
+#line 4560 ""
} else {
-#line 4571 ""
+#line 4561 ""
r__1 = (shift + 5.35f) * 20;
-#line 4571 ""
+#line 4561 ""
ishift = i_nint(&r__1);
-#line 4572 ""
+#line 4562 ""
if (mainnote) {
-#line 4573 ""
+#line 4563 ""
setbits_(nacc, &c__7, &c__10, &ishift);
-#line 4574 ""
+#line 4564 ""
} else {
-#line 4575 ""
+#line 4565 ""
setbits_(&comtrill_1.icrdot[micrd[iwa] - 1], &c__7, &
c__20, &ishift);
-#line 4576 ""
+#line 4566 ""
}
-#line 4577 ""
+#line 4567 ""
}
-#line 4578 ""
+#line 4568 ""
} else {
/* This is the earlier call to precrd, so need minimum shift */
-#line 4582 ""
+#line 4572 ""
shiftmin = dmin(shiftmin,shift);
-#line 4583 ""
+#line 4573 ""
}
-#line 4584 ""
+#line 4574 ""
}
/* Bail out if this is the last accidental to check */
-#line 4588 ""
+#line 4578 ""
if (iwa == *naccid) {
-#line 4588 ""
+#line 4578 ""
goto L1;
-#line 4588 ""
+#line 4578 ""
}
/* Add this accidental to the right barrier! Count down from highest barrier segment, */
/* find 1st one starting below top of accid, and first one starting below bot. */
-#line 4593 ""
+#line 4583 ""
for (ibelowtop = nsegrb; ibelowtop >= 1; --ibelowtop) {
-#line 4594 ""
+#line 4584 ""
if (segrb[(ibelowtop << 1) - 1] < nolev + segal[iacctype + ((
nsegal[iacctype - 1] << 1) + 2) * 5 - 16]) {
-#line 4596 ""
+#line 4586 ""
for (ibelowbot = ibelowtop; ibelowbot >= 1; --ibelowbot) {
-#line 4597 ""
+#line 4587 ""
if (segrb[(ibelowbot << 1) - 1] < nolev + segal[iacctype
+ 4]) {
-#line 4597 ""
+#line 4587 ""
goto L6;
-#line 4597 ""
+#line 4587 ""
}
-#line 4599 ""
+#line 4589 ""
/* L9: */
-#line 4599 ""
+#line 4589 ""
}
-#line 4600 ""
+#line 4590 ""
s_wsle(&io___324);
-#line 4600 ""
+#line 4590 ""
do_lio(&c__9, &c__1, "Oops2!", (ftnlen)6);
-#line 4600 ""
+#line 4590 ""
e_wsle();
-#line 4601 ""
+#line 4591 ""
stop1_();
-#line 4602 ""
+#line 4592 ""
}
-#line 4603 ""
+#line 4593 ""
/* L5: */
-#line 4603 ""
+#line 4593 ""
}
-#line 4604 ""
+#line 4594 ""
s_wsle(&io___325);
-#line 4604 ""
+#line 4594 ""
do_lio(&c__9, &c__1, "Ugh0! in crdaccs", (ftnlen)16);
-#line 4604 ""
+#line 4594 ""
e_wsle();
-#line 4605 ""
+#line 4595 ""
stop1_();
-#line 4606 ""
+#line 4596 ""
L6:
-#line 4607 ""
+#line 4597 ""
netgain = nsegal[iacctype - 1] - ibelowtop + ibelowbot;
/* Shift high segments up */
-#line 4611 ""
+#line 4601 ""
if (netgain >= 0) {
-#line 4612 ""
+#line 4602 ""
i__2 = ibelowtop + 1;
-#line 4612 ""
+#line 4602 ""
for (isegrb = nsegrb; isegrb >= i__2; --isegrb) {
-#line 4613 ""
+#line 4603 ""
segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
-#line 4614 ""
+#line 4604 ""
segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
-#line 4615 ""
+#line 4605 ""
ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
-#line 4616 ""
+#line 4606 ""
/* L7: */
-#line 4616 ""
+#line 4606 ""
}
/* Set up 1st segment above accid */
-#line 4620 ""
+#line 4610 ""
segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
2];
-#line 4621 ""
+#line 4611 ""
segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
(nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
-#line 4623 ""
+#line 4613 ""
ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
-#line 4624 ""
+#line 4614 ""
} else {
/* netgain<0, must remove segments. Use same coding but reverse order, */
/* work from bottom up */
-#line 4629 ""
+#line 4619 ""
segrb[(ibelowtop + netgain << 1) - 2] = segrb[(ibelowtop << 1) -
2];
-#line 4630 ""
+#line 4620 ""
segrb[(ibelowtop + netgain << 1) - 1] = nolev + segal[iacctype + (
(nsegal[iacctype - 1] << 1) + 2) * 5 - 16];
-#line 4632 ""
+#line 4622 ""
ksegrb[ibelowtop + netgain - 1] = ksegrb[ibelowtop - 1];
-#line 4633 ""
+#line 4623 ""
i__2 = nsegrb;
-#line 4633 ""
+#line 4623 ""
for (isegrb = ibelowtop + 1; isegrb <= i__2; ++isegrb) {
-#line 4634 ""
+#line 4624 ""
segrb[(isegrb + netgain << 1) - 2] = segrb[(isegrb << 1) - 2];
-#line 4635 ""
+#line 4625 ""
segrb[(isegrb + netgain << 1) - 1] = segrb[(isegrb << 1) - 1];
-#line 4636 ""
+#line 4626 ""
ksegrb[isegrb + netgain - 1] = ksegrb[isegrb - 1];
-#line 4637 ""
+#line 4627 ""
/* L12: */
-#line 4637 ""
+#line 4627 ""
}
-#line 4638 ""
+#line 4628 ""
}
/* Insert new segments */
-#line 4642 ""
+#line 4632 ""
i__2 = nsegal[iacctype - 1] - 1;
-#line 4642 ""
+#line 4632 ""
for (isega = 1; isega <= i__2; ++isega) {
-#line 4643 ""
+#line 4633 ""
segrb[(ibelowbot + isega << 1) - 2] = shift + segal[iacctype + ((
isega << 1) + 1) * 5 - 16];
-#line 4644 ""
+#line 4634 ""
segrb[(ibelowbot + isega << 1) - 1] = nolev + segal[iacctype + ((
isega << 1) + 2) * 5 - 16];
-#line 4645 ""
+#line 4635 ""
if (mainnote) {
-#line 4646 ""
+#line 4636 ""
ksegrb[ibelowbot + isega - 1] = 0;
-#line 4647 ""
+#line 4637 ""
} else {
-#line 4648 ""
+#line 4638 ""
ksegrb[ibelowbot + isega - 1] = micrd[iwa];
-#line 4649 ""
+#line 4639 ""
}
-#line 4650 ""
+#line 4640 ""
/* L8: */
-#line 4650 ""
+#line 4640 ""
}
/* Update number of barrier segments */
-#line 4654 ""
+#line 4644 ""
nsegrb += netgain;
/* c */
/* c Temporary printout for boundary segments as built up */
@@ -11368,23 +11366,23 @@ L6:
/* write(15,'(a/(2i5))')' micrd isetshft', */
/* * (micrd(iwa1),isetshft(iwa1),iwa1=1,iwa) */
/* c */
-#line 4664 ""
+#line 4654 ""
L1:
-#line 4664 ""
+#line 4654 ""
;
-#line 4664 ""
+#line 4654 ""
}
/* next accidental */
-#line 4665 ""
+#line 4655 ""
if (*lasttime && ! (*twooftwo)) {
/* This is the final call on the pre-ask pass, so compute left-shift rqmt. */
-#line 4669 ""
+#line 4659 ""
r__1 = shiftmin * -20;
-#line 4669 ""
+#line 4659 ""
*icashft = i_nint(&r__1);
-#line 4670 ""
+#line 4660 ""
}
/* c */
/* c Temporary printout for boundary segments */
@@ -11397,7 +11395,7 @@ L1:
/* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */
/* end if */
/* c */
-#line 4682 ""
+#line 4672 ""
return 0;
} /* crdacc_ */
@@ -11467,27 +11465,27 @@ L1:
/* Initialize right-barrier */
-#line 4722 ""
+#line 4712 ""
/* Parameter adjustments */
-#line 4722 ""
+#line 4712 ""
--kicrd;
-#line 4722 ""
+#line 4712 ""
-#line 4722 ""
+#line 4712 ""
/* Function Body */
-#line 4722 ""
+#line 4712 ""
segrb0[0] = 0.f;
-#line 4723 ""
+#line 4713 ""
segrb0[1] = -1e3f;
-#line 4724 ""
+#line 4714 ""
segrb0[2] = 0.f;
-#line 4725 ""
+#line 4715 ""
segrb0[3] = 1e3f;
-#line 4726 ""
+#line 4716 ""
nsegrb0 = 2;
-#line 4727 ""
+#line 4717 ""
ksegrb0[0] = -1;
-#line 4728 ""
+#line 4718 ""
ksegrb0[1] = -1;
/* Search for left-shifted notes, Make up the initial right-barrier, which */
@@ -11495,124 +11493,124 @@ L1:
/* irest()(27) is set if any notes are left-shifted */
/* Must use ALL chord notes, not just ones w/ accid's. */
-#line 4735 ""
+#line 4725 ""
if (bit_test(*irest,27)) {
-#line 4736 ""
+#line 4726 ""
i__1 = comtrill_1.icrd2;
-#line 4736 ""
+#line 4726 ""
for (icrd = comtrill_1.icrd1 - 1; icrd <= i__1; ++icrd) {
-#line 4737 ""
+#line 4727 ""
if (icrd == comtrill_1.icrd1 - 1) {
/* Main note */
/* lshift = btest(ipl,8) */
-#line 4742 ""
+#line 4732 ""
lshift = bit_test(*ipl,8) || bit_test(*nacc,31);
-#line 4743 ""
+#line 4733 ""
if (lshift) {
-#line 4743 ""
+#line 4733 ""
nolev = *nolevm;
-#line 4743 ""
+#line 4733 ""
}
-#line 4744 ""
+#line 4734 ""
} else {
/* Chord note */
-#line 4748 ""
+#line 4738 ""
lshift = bit_test(comtrill_1.icrdat[icrd - 1],23);
/* if (lshift) nolev = igetbits(icrdat(icrd),7,12) */
-#line 4750 ""
+#line 4740 ""
if (lshift) {
-#line 4751 ""
+#line 4741 ""
nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &
c__12);
-#line 4752 ""
+#line 4742 ""
if (bit_test(*nacc,31) && nolev == *nolevm + 1) {
/* This note is not really shifted, It is the upper of a 2nd with the main */
/* note on an upstem, and Main note must be shifted. */
/* nacc(31) signals the real truth. */
-#line 4758 ""
+#line 4748 ""
lshift = FALSE_;
-#line 4759 ""
+#line 4749 ""
}
-#line 4760 ""
+#line 4750 ""
}
-#line 4761 ""
+#line 4751 ""
}
-#line 4762 ""
+#line 4752 ""
if (lshift) {
-#line 4763 ""
+#line 4753 ""
i__2 = nsegrb0 - 1;
-#line 4763 ""
+#line 4753 ""
for (isegrb = 1; isegrb <= i__2; ++isegrb) {
-#line 4764 ""
+#line 4754 ""
if (segrb0[(isegrb + 1 << 1) - 1] > (real) (nolev - 1)) {
/* Add this notehead to the right boundary here. Move all higher segs up 2. */
-#line 4768 ""
+#line 4758 ""
i__3 = isegrb + 1;
-#line 4768 ""
+#line 4758 ""
for (iiseg = nsegrb0; iiseg >= i__3; --iiseg) {
-#line 4769 ""
+#line 4759 ""
segrb0[(iiseg + 2 << 1) - 2] = segrb0[(iiseg << 1)
- 2];
-#line 4770 ""
+#line 4760 ""
segrb0[(iiseg + 2 << 1) - 1] = segrb0[(iiseg << 1)
- 1];
-#line 4771 ""
+#line 4761 ""
ksegrb0[iiseg + 1] = ksegrb0[iiseg - 1];
-#line 4772 ""
+#line 4762 ""
/* L17: */
-#line 4772 ""
+#line 4762 ""
}
-#line 4773 ""
+#line 4763 ""
goto L18;
-#line 4774 ""
+#line 4764 ""
}
-#line 4775 ""
+#line 4765 ""
/* L16: */
-#line 4775 ""
+#line 4765 ""
}
-#line 4776 ""
+#line 4766 ""
L18:
/* Insert notehead into list. Set kseg=-2 to signal notehead shift. */
-#line 4780 ""
+#line 4770 ""
iiseg = isegrb + 1;
-#line 4781 ""
+#line 4771 ""
segrb0[(iiseg << 1) - 2] = -1.2f;
-#line 4782 ""
+#line 4772 ""
segrb0[(iiseg << 1) - 1] = nolev - 1.f;
-#line 4783 ""
+#line 4773 ""
ksegrb0[iiseg - 1] = -2;
-#line 4784 ""
+#line 4774 ""
segrb0[(iiseg + 1 << 1) - 2] = 0.f;
-#line 4785 ""
+#line 4775 ""
segrb0[(iiseg + 1 << 1) - 1] = nolev + 1.f;
-#line 4786 ""
+#line 4776 ""
ksegrb0[iiseg] = -1;
-#line 4787 ""
+#line 4777 ""
nsegrb0 += 2;
-#line 4788 ""
+#line 4778 ""
}
-#line 4789 ""
+#line 4779 ""
/* L15: */
-#line 4789 ""
+#line 4779 ""
}
-#line 4790 ""
+#line 4780 ""
}
/* Done setting right barrier for left-shifted noteheads */
-#line 4794 ""
+#line 4784 ""
tagged = FALSE_;
-#line 4795 ""
+#line 4785 ""
manual = FALSE_;
/* Preprocess to check for manual shifts. */
@@ -11626,302 +11624,302 @@ L18:
/* End if */
/* End if */
-#line 4808 ""
+#line 4798 ""
maxmanshft = 0;
-#line 4809 ""
+#line 4799 ""
i__1 = *naccid;
-#line 4809 ""
+#line 4799 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4810 ""
+#line 4800 ""
if (kicrd[i__] == 0) {
/* Main note */
-#line 4814 ""
+#line 4804 ""
manshft = igetbits_(nacc, &c__7, &c__10);
-#line 4815 ""
+#line 4805 ""
if (manshft != 0) {
-#line 4816 ""
+#line 4806 ""
manual = TRUE_;
-#line 4817 ""
+#line 4807 ""
if (bit_test(*nacc,29)) {
-#line 4818 ""
+#line 4808 ""
tagged = TRUE_;
-#line 4819 ""
+#line 4809 ""
} else {
/* maxmanshft = max(maxmanshft,64-manshft) */
/* Computing MAX */
-#line 4821 ""
+#line 4811 ""
i__2 = maxmanshft, i__3 = 107 - manshft;
-#line 4821 ""
+#line 4811 ""
maxmanshft = max(i__2,i__3);
-#line 4822 ""
+#line 4812 ""
}
-#line 4823 ""
+#line 4813 ""
}
-#line 4824 ""
+#line 4814 ""
} else {
/* Chord note */
-#line 4828 ""
+#line 4818 ""
manshft = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
c__20);
-#line 4829 ""
+#line 4819 ""
if (manshft != 0) {
-#line 4830 ""
+#line 4820 ""
manual = TRUE_;
-#line 4831 ""
+#line 4821 ""
if (bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
-#line 4832 ""
+#line 4822 ""
tagged = TRUE_;
-#line 4833 ""
+#line 4823 ""
} else {
/* maxmanshft = max(maxmanshft,64-manshft) */
/* Computing MAX */
-#line 4835 ""
+#line 4825 ""
i__2 = maxmanshft, i__3 = 107 - manshft;
-#line 4835 ""
+#line 4825 ""
maxmanshft = max(i__2,i__3);
-#line 4836 ""
+#line 4826 ""
}
-#line 4837 ""
+#line 4827 ""
}
-#line 4838 ""
+#line 4828 ""
}
-#line 4839 ""
+#line 4829 ""
/* L13: */
-#line 4839 ""
+#line 4829 ""
}
-#line 4840 ""
+#line 4830 ""
if (manual) {
-#line 4841 ""
+#line 4831 ""
if (tagged) {
/* zero out all untagged shifts */
-#line 4845 ""
+#line 4835 ""
i__1 = *naccid;
-#line 4845 ""
+#line 4835 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4846 ""
+#line 4836 ""
if (kicrd[i__] == 0) {
-#line 4847 ""
+#line 4837 ""
if (! bit_test(*nacc,29)) {
-#line 4847 ""
+#line 4837 ""
setbits_(nacc, &c__7, &c__10, &c__0);
-#line 4847 ""
+#line 4837 ""
}
-#line 4848 ""
+#line 4838 ""
} else {
-#line 4849 ""
+#line 4839 ""
if (! bit_test(comtrill_1.icrdat[kicrd[i__] - 1],29)) {
-#line 4849 ""
+#line 4839 ""
setbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__7, &
c__20, &c__0);
-#line 4849 ""
+#line 4839 ""
}
-#line 4851 ""
+#line 4841 ""
}
-#line 4852 ""
+#line 4842 ""
/* L14: */
-#line 4852 ""
+#line 4842 ""
}
-#line 4853 ""
+#line 4843 ""
} else {
/* There are manual shifts but none tagged. Only proceed if "Ao" was entered */
-#line 4857 ""
+#line 4847 ""
if (! bit_test(*nacc,28)) {
-#line 4858 ""
+#line 4848 ""
*icashft = maxmanshft;
-#line 4859 ""
+#line 4849 ""
return 0;
-#line 4860 ""
+#line 4850 ""
}
-#line 4861 ""
+#line 4851 ""
}
-#line 4862 ""
+#line 4852 ""
}
-#line 4863 ""
+#line 4853 ""
if (bit_test(*nacc,28)) {
/* Take the accidentals in order as originally input, then exit. */
-#line 4867 ""
+#line 4857 ""
crdacc_(nacc, naccid, &kicrd[1], nolevm, &rmsshift, &c_true, &idummy,
&idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
-#line 4869 ""
+#line 4859 ""
return 0;
/* end if */
-#line 4871 ""
+#line 4861 ""
} else if (*naccid == 3) {
/* Special treatment if 3 accidentals in chord. If there aren't accids on a 2nd */
/* then place in order top, bottom, middle. */
-#line 4876 ""
+#line 4866 ""
for (i__ = 1; i__ <= 3; ++i__) {
-#line 4877 ""
+#line 4867 ""
if (kicrd[i__] == 0) {
-#line 4878 ""
+#line 4868 ""
irank = *icrdot0;
-#line 4879 ""
+#line 4869 ""
nolev = *nolevm;
-#line 4880 ""
+#line 4870 ""
} else {
-#line 4881 ""
+#line 4871 ""
irank = igetbits_(&comtrill_1.icrdot[kicrd[i__] - 1], &c__3, &
c__27);
-#line 4882 ""
+#line 4872 ""
nolev = igetbits_(&comtrill_1.icrdat[kicrd[i__] - 1], &c__7, &
c__12);
-#line 4883 ""
+#line 4873 ""
}
-#line 4884 ""
+#line 4874 ""
if (irank == 1) {
-#line 4885 ""
+#line 4875 ""
micrd[0] = kicrd[i__];
-#line 4886 ""
+#line 4876 ""
} else {
-#line 4887 ""
+#line 4877 ""
micrd[5 - irank - 1] = kicrd[i__];
-#line 4888 ""
+#line 4878 ""
}
-#line 4889 ""
+#line 4879 ""
if (irank == 2) {
-#line 4890 ""
+#line 4880 ""
levmidacc = nolev;
-#line 4891 ""
+#line 4881 ""
}
-#line 4892 ""
+#line 4882 ""
/* L20: */
-#line 4892 ""
+#line 4882 ""
}
-#line 4893 ""
+#line 4883 ""
if (*levmaxacc != levmidacc + 1 && levmidacc != *levminacc + 1) {
-#line 4895 ""
+#line 4885 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy,
&idummy, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
-#line 4897 ""
+#line 4887 ""
return 0;
-#line 4898 ""
+#line 4888 ""
}
-#line 4899 ""
+#line 4889 ""
}
-#line 4900 ""
+#line 4890 ""
rmsmin = 1e5f;
/* Initialize permutation array */
-#line 4904 ""
+#line 4894 ""
i__1 = *naccid;
-#line 4904 ""
+#line 4894 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4905 ""
+#line 4895 ""
iperm[i__ - 1] = i__;
-#line 4906 ""
+#line 4896 ""
/* L7: */
-#line 4906 ""
+#line 4896 ""
}
/* Start looping over permutations */
-#line 4910 ""
+#line 4900 ""
for (ip = 1; ip <= 5041; ++ip) {
-#line 4911 ""
+#line 4901 ""
if (ip != 1) {
/* Work the magic algorithm to get the next permutation */
-#line 4915 ""
+#line 4905 ""
for (k = *naccid - 1; k >= 1; --k) {
-#line 4916 ""
+#line 4906 ""
if (iperm[k - 1] <= iperm[k]) {
-#line 4916 ""
+#line 4906 ""
goto L2;
-#line 4916 ""
+#line 4906 ""
}
-#line 4917 ""
+#line 4907 ""
/* L1: */
-#line 4917 ""
+#line 4907 ""
}
/* If here, we just got the last permutation, so exit the loop over permutations */
-#line 4921 ""
+#line 4911 ""
goto L10;
-#line 4922 ""
+#line 4912 ""
L2:
-#line 4923 ""
+#line 4913 ""
for (j = *naccid; j >= 1; --j) {
-#line 4924 ""
+#line 4914 ""
if (iperm[k - 1] <= iperm[j - 1]) {
-#line 4924 ""
+#line 4914 ""
goto L4;
-#line 4924 ""
+#line 4914 ""
}
-#line 4925 ""
+#line 4915 ""
/* L3: */
-#line 4925 ""
+#line 4915 ""
}
-#line 4926 ""
+#line 4916 ""
L4:
-#line 4927 ""
+#line 4917 ""
it = iperm[j - 1];
-#line 4928 ""
+#line 4918 ""
iperm[j - 1] = iperm[k - 1];
-#line 4929 ""
+#line 4919 ""
iperm[k - 1] = it;
-#line 4930 ""
+#line 4920 ""
is = k + 1;
-#line 4931 ""
+#line 4921 ""
for (ir = *naccid; ir >= 1; --ir) {
-#line 4932 ""
+#line 4922 ""
if (ir <= is) {
-#line 4932 ""
+#line 4922 ""
goto L6;
-#line 4932 ""
+#line 4922 ""
}
-#line 4933 ""
+#line 4923 ""
it = iperm[ir - 1];
-#line 4934 ""
+#line 4924 ""
iperm[ir - 1] = iperm[is - 1];
-#line 4935 ""
+#line 4925 ""
iperm[is - 1] = it;
-#line 4936 ""
+#line 4926 ""
++is;
-#line 4937 ""
+#line 4927 ""
/* L5: */
-#line 4937 ""
+#line 4927 ""
}
-#line 4938 ""
+#line 4928 ""
L6:
-#line 4939 ""
+#line 4929 ""
;
-#line 4939 ""
+#line 4929 ""
}
/* New we have a permutation. Take icrd values out of kicrd and put them into */
/* micrd in the order of the permutation */
-#line 4944 ""
+#line 4934 ""
i__1 = *naccid;
-#line 4944 ""
+#line 4934 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4945 ""
+#line 4935 ""
micrd[i__ - 1] = kicrd[iperm[i__ - 1]];
-#line 4946 ""
+#line 4936 ""
/* L9: */
-#line 4946 ""
+#line 4936 ""
}
/* c */
/* c Temporary printout */
/* c */
/* write(15,'(/a6,10i3)')'perm:',(iperm(i),i=1,naccid) */
/* c */
-#line 4952 ""
+#line 4942 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_false, levmaxacc,
icrdot0, segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
/* c */
@@ -11929,61 +11927,61 @@ L6:
/* c */
/* write(15,*)'perm done, rmsshift:',rmsshift */
/* c */
-#line 4959 ""
+#line 4949 ""
if (rmsshift < rmsmin) {
/* Save this permutation, reset minrms */
-#line 4963 ""
+#line 4953 ""
i__1 = *naccid;
-#line 4963 ""
+#line 4953 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4964 ""
+#line 4954 ""
ipermsav[i__ - 1] = iperm[i__ - 1];
-#line 4965 ""
+#line 4955 ""
rmsmin = rmsshift;
-#line 4966 ""
+#line 4956 ""
/* L11: */
-#line 4966 ""
+#line 4956 ""
}
-#line 4967 ""
+#line 4957 ""
}
-#line 4968 ""
+#line 4958 ""
/* L8: */
-#line 4968 ""
+#line 4958 ""
}
-#line 4969 ""
+#line 4959 ""
s_wsle(&io___354);
-#line 4969 ""
+#line 4959 ""
do_lio(&c__9, &c__1, "Should not BEEEEEE here!", (ftnlen)24);
-#line 4969 ""
+#line 4959 ""
e_wsle();
-#line 4970 ""
+#line 4960 ""
stop1_();
-#line 4971 ""
+#line 4961 ""
L10:
/* Done looping, get info for the final choice */
-#line 4975 ""
+#line 4965 ""
i__1 = *naccid;
-#line 4975 ""
+#line 4965 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 4976 ""
+#line 4966 ""
micrd[i__ - 1] = kicrd[ipermsav[i__ - 1]];
-#line 4977 ""
+#line 4967 ""
/* L12: */
-#line 4977 ""
+#line 4967 ""
}
/* c */
/* c Temporary printout */
/* c */
/* write(15,'(/a6,10i3)')'Final perm:',(ipermsav(i),i=1,naccid) */
/* c */
-#line 4983 ""
+#line 4973 ""
crdacc_(nacc, naccid, micrd, nolevm, &rmsshift, &c_true, &idummy, &idummy,
segrb0, ksegrb0, &nsegrb0, twooftwo, icashft);
-#line 4985 ""
+#line 4975 ""
return 0;
} /* crdaccs_ */
@@ -12017,191 +12015,191 @@ L10:
static char acsymq[3];
static integer lnoten;
-#line 4993 ""
+#line 4983 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 4993 ""
+#line 4983 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 4994 ""
+#line 4984 ""
if (*ihshft == -107) {
-#line 4994 ""
+#line 4984 ""
*ihshft = 0;
-#line 4994 ""
+#line 4984 ""
}
/* c */
/* c If main note shifted left, so shift accid. Terminate below, when acc. is done. */
/* c */
-#line 4998 ""
+#line 4988 ""
if (*ihshft != 0) {
/* Accid must be shifted horizontally */
-#line 5002 ""
+#line 4992 ""
if (*ihshft < 0) {
/* Writing concatenation */
-#line 5003 ""
+#line 4993 ""
i__1[0] = 1, a__1[0] = sq;
-#line 5003 ""
+#line 4993 ""
i__1[1] = 8, a__1[1] = "loffset{";
-#line 5003 ""
+#line 4993 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5004 ""
+#line 4994 ""
*ihshft = -(*ihshft);
-#line 5005 ""
+#line 4995 ""
} else {
/* Writing concatenation */
-#line 5006 ""
+#line 4996 ""
i__1[0] = 1, a__1[0] = sq;
-#line 5006 ""
+#line 4996 ""
i__1[1] = 8, a__1[1] = "roffset{";
-#line 5006 ""
+#line 4996 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5007 ""
+#line 4997 ""
}
-#line 5008 ""
+#line 4998 ""
hshft = *ihshft * .05f;
-#line 5009 ""
+#line 4999 ""
if (hshft < 1.f) {
-#line 5010 ""
+#line 5000 ""
ici__1.icierr = 0;
-#line 5010 ""
+#line 5000 ""
ici__1.icirnum = 1;
-#line 5010 ""
+#line 5000 ""
ici__1.icirlen = 3;
-#line 5010 ""
+#line 5000 ""
ici__1.iciunit = notexq + 9;
-#line 5010 ""
+#line 5000 ""
ici__1.icifmt = "(f3.2)";
-#line 5010 ""
+#line 5000 ""
s_wsfi(&ici__1);
-#line 5010 ""
+#line 5000 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
-#line 5010 ""
+#line 5000 ""
e_wsfi();
-#line 5011 ""
+#line 5001 ""
*lnote = 12;
-#line 5012 ""
+#line 5002 ""
} else {
-#line 5013 ""
+#line 5003 ""
ici__1.icierr = 0;
-#line 5013 ""
+#line 5003 ""
ici__1.icirnum = 1;
-#line 5013 ""
+#line 5003 ""
ici__1.icirlen = 4;
-#line 5013 ""
+#line 5003 ""
ici__1.iciunit = notexq + 9;
-#line 5013 ""
+#line 5003 ""
ici__1.icifmt = "(f4.2)";
-#line 5013 ""
+#line 5003 ""
s_wsfi(&ici__1);
-#line 5013 ""
+#line 5003 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
-#line 5013 ""
+#line 5003 ""
e_wsfi();
-#line 5014 ""
+#line 5004 ""
*lnote = 13;
-#line 5015 ""
+#line 5005 ""
}
/* Writing concatenation */
-#line 5016 ""
+#line 5006 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 5016 ""
+#line 5006 ""
i__2[1] = 2, a__2[1] = "}{";
-#line 5016 ""
+#line 5006 ""
i__2[2] = 1, a__2[2] = sq;
-#line 5016 ""
+#line 5006 ""
s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
-#line 5017 ""
+#line 5007 ""
*lnote += 3;
-#line 5018 ""
+#line 5008 ""
} else {
-#line 5019 ""
+#line 5009 ""
s_copy(notexq, sq, (ftnlen)79, (ftnlen)1);
-#line 5020 ""
+#line 5010 ""
*lnote = 1;
-#line 5021 ""
+#line 5011 ""
}
-#line 5022 ""
+#line 5012 ""
if (bit_test(*nacc,3)) {
/* Writing concatenation */
-#line 5023 ""
+#line 5013 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 5023 ""
+#line 5013 ""
i__1[1] = 3, a__1[1] = "big";
-#line 5023 ""
+#line 5013 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5024 ""
+#line 5014 ""
*lnote += 3;
-#line 5025 ""
+#line 5015 ""
}
-#line 5026 ""
+#line 5016 ""
if (*caut) {
/* Cautionary accidental. Need to define bigcna,... in pmx.tex */
/* Writing concatenation */
-#line 5030 ""
+#line 5020 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 5030 ""
+#line 5020 ""
i__1[1] = 1, a__1[1] = "c";
-#line 5030 ""
+#line 5020 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5031 ""
+#line 5021 ""
++(*lnote);
-#line 5032 ""
+#line 5022 ""
}
-#line 5033 ""
+#line 5023 ""
accsym_(nacc, acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
-#line 5034 ""
+#line 5024 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 5034 ""
+#line 5024 ""
i__1[1] = lacc, a__1[1] = acsymq;
-#line 5034 ""
+#line 5024 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5035 ""
+#line 5025 ""
*lnote += lacc;
-#line 5036 ""
+#line 5026 ""
noleva = *nolev;
-#line 5037 ""
+#line 5027 ""
if (*ivshft != 0) {
-#line 5037 ""
+#line 5027 ""
noleva = noleva + *ivshft - 32;
-#line 5037 ""
+#line 5027 ""
}
-#line 5038 ""
+#line 5028 ""
notefq_(noteq, &lnoten, &noleva, ncm, (ftnlen)8);
-#line 5039 ""
+#line 5029 ""
if (lnoten == 1) {
-#line 5039 ""
+#line 5029 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 5039 ""
+#line 5029 ""
}
/* Writing concatenation */
-#line 5040 ""
+#line 5030 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 5040 ""
+#line 5030 ""
i__1[1] = lnoten, a__1[1] = noteq;
-#line 5040 ""
+#line 5030 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5041 ""
+#line 5031 ""
*lnote += lnoten;
-#line 5042 ""
+#line 5032 ""
if (*ihshft != 0) {
/* Terminate horizontal shift */
/* Writing concatenation */
-#line 5046 ""
+#line 5036 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 5046 ""
+#line 5036 ""
i__1[1] = 1, a__1[1] = "}";
-#line 5046 ""
+#line 5036 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 5047 ""
+#line 5037 ""
++(*lnote);
-#line 5048 ""
+#line 5038 ""
}
-#line 5049 ""
+#line 5039 ""
return 0;
} /* doacc_ */
@@ -12280,43 +12278,43 @@ L10:
/* Set counter (for this note) for chord notes present. Set notmain=T. */
/* Will test for notmain=.true. in addmidi to tell whether to save pitch. */
-#line 5103 ""
+#line 5093 ""
/* Parameter adjustments */
-#line 5103 ""
+#line 5093 ""
irest -= 25;
-#line 5103 ""
+#line 5093 ""
--nornb;
-#line 5103 ""
+#line 5093 ""
ihornb -= 25;
-#line 5103 ""
+#line 5093 ""
ulq -= 25;
-#line 5103 ""
+#line 5093 ""
-#line 5103 ""
+#line 5093 ""
/* Function Body */
-#line 5103 ""
+#line 5093 ""
commidi_1.nmidcrd = 0;
-#line 5104 ""
+#line 5094 ""
commidi_1.notmain = TRUE_;
-#line 5105 ""
+#line 5095 ""
commidi_1.crdacc = FALSE_;
-#line 5106 ""
+#line 5096 ""
i__1 = comtrill_1.icrd2;
-#line 5106 ""
+#line 5096 ""
for (icrd = comtrill_1.icrd1; icrd <= i__1; ++icrd) {
-#line 5107 ""
+#line 5097 ""
lnote = 0;
-#line 5108 ""
+#line 5098 ""
nolev = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12);
/* 3/8/03 save original pitch to use in midi, in case 2nds alter things. */
-#line 5112 ""
+#line 5102 ""
nolevo = nolev;
/* Check for special situations with 2nds (see precrd). */
-#line 5116 ""
+#line 5106 ""
if (bit_test(*nacc,30) && nolev == *nolevm - 1) {
/* Upstem, 2nd with upper as main, interchange pitches, */
@@ -12324,87 +12322,87 @@ L10:
/* if dotted, probably had shifted dot, dot parameters must be moved */
/* from chord to main */
-#line 5123 ""
+#line 5113 ""
nolev = *nolevm;
-#line 5124 ""
+#line 5114 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
/* Orig. chord note dot shift, must transfer to main. */
-#line 5128 ""
+#line 5118 ""
icrdotsav = comtrill_1.icrdot[icrd - 1];
-#line 5129 ""
+#line 5119 ""
icrdatsav = comtrill_1.icrdat[icrd - 1];
-#line 5130 ""
+#line 5120 ""
if (bit_test(irest[*ivx + *ip * 24],19)) {
/* Main note (upper) had a dot shift, must move it to chord */
-#line 5134 ""
+#line 5124 ""
setbits_(&comtrill_1.icrdat[icrd - 1], &c__1, &c__26, &
c__1);
-#line 5135 ""
+#line 5125 ""
r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1)
* 24 - 25] * 10;
-#line 5135 ""
+#line 5125 ""
i__2 = i_nint(&r__1) + 64;
-#line 5135 ""
+#line 5125 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &
i__2);
-#line 5137 ""
+#line 5127 ""
r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1)
* 24 - 25] * 10;
-#line 5137 ""
+#line 5127 ""
i__2 = i_nint(&r__1) + 64;
-#line 5137 ""
+#line 5127 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, &
i__2);
/* May need to worry about other chord params (accid shefts etc) later */
-#line 5142 ""
+#line 5132 ""
} else {
-#line 5143 ""
+#line 5133 ""
comtrill_1.icrdat[icrd - 1] = bit_clear(comtrill_1.icrdat[
icrd - 1],26);
-#line 5144 ""
+#line 5134 ""
}
/* We are adding a main note dot shift, so push any later ones back */
-#line 5149 ""
+#line 5139 ""
if (! bit_test(irest[*ivx + *ip * 24],19)) {
-#line 5150 ""
+#line 5140 ""
++comcc_1.maxdotmv[*ivx - 1];
-#line 5151 ""
+#line 5141 ""
i__2 = comcc_1.ndotmv[*ivx - 1] + 2;
-#line 5151 ""
+#line 5141 ""
for (indm = comcc_1.maxdotmv[*ivx - 1]; indm >= i__2;
--indm) {
-#line 5152 ""
+#line 5142 ""
comcc_1.updot[*ivx + indm * 24 - 25] = comcc_1.updot[*
ivx + (indm - 1) * 24 - 25];
-#line 5153 ""
+#line 5143 ""
comcc_1.rtdot[*ivx + indm * 24 - 25] = comcc_1.rtdot[*
ivx + (indm - 1) * 24 - 25];
-#line 5154 ""
+#line 5144 ""
/* L1: */
-#line 5154 ""
+#line 5144 ""
}
-#line 5155 ""
+#line 5145 ""
}
-#line 5156 ""
+#line 5146 ""
irest[*ivx + *ip * 24] = bit_set(irest[*ivx + *ip * 24],19);
-#line 5157 ""
+#line 5147 ""
comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25]
= ((127 & icrdotsav) - 64) * .1f;
-#line 5158 ""
+#line 5148 ""
comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24 - 25]
= ((127 & lbit_shift(icrdotsav, (ftnlen)-7)) - 64) *
.1f;
-#line 5160 ""
+#line 5150 ""
}
-#line 5161 ""
+#line 5151 ""
} else if (bit_test(*nacc,31) && nolev == *nolevm + 1) {
/* Downstem, 2nd with lower as main, interchange pitches, */
@@ -12412,63 +12410,63 @@ L10:
/* probably had shifted dot, dot parameters must be moved from */
/* main to chord */
-#line 5168 ""
+#line 5158 ""
nolev = *nolevm;
-#line 5169 ""
+#line 5159 ""
if (bit_test(irest[*ivx + *ip * 24],19)) {
-#line 5170 ""
+#line 5160 ""
icrdotsav = comtrill_1.icrdot[icrd - 1];
-#line 5171 ""
+#line 5161 ""
icrdatsav = comtrill_1.icrdat[icrd - 1];
-#line 5172 ""
+#line 5162 ""
comtrill_1.icrdat[icrd - 1] = bit_set(comtrill_1.icrdat[icrd
- 1],26);
/* bits in icrdot */
/* 0-6 10*abs(vertical dot shift in \internote) + 64 */
/* 7-13 10*abs(horizontal dot shift in \internote) + 64 */
/* Assuming >0 for now! */
-#line 5177 ""
+#line 5167 ""
r__1 = comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) *
24 - 25] * 10;
-#line 5177 ""
+#line 5167 ""
i__2 = i_nint(&r__1) + 64;
-#line 5177 ""
+#line 5167 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &i__2);
-#line 5179 ""
+#line 5169 ""
r__1 = comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) *
24 - 25] * 10;
-#line 5179 ""
+#line 5169 ""
i__2 = i_nint(&r__1) + 64;
-#line 5179 ""
+#line 5169 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__7, &i__2);
/* Must also set dot shift for (now) main note (orig. chord note). */
-#line 5184 ""
+#line 5174 ""
if (bit_test(icrdatsav,26)) {
-#line 5185 ""
+#line 5175 ""
comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
- 25] = ((127 & icrdotsav) - 64) * .1f;
-#line 5186 ""
+#line 5176 ""
comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
- 25] = ((127 & lbit_shift(icrdotsav, (ftnlen)-7))
- 64) * .1f;
-#line 5188 ""
+#line 5178 ""
} else {
/* No dot move on original chord (now main) note, */
-#line 5192 ""
+#line 5182 ""
comcc_1.updot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
- 25] = 0.f;
-#line 5193 ""
+#line 5183 ""
comcc_1.rtdot[*ivx + (comcc_1.ndotmv[*ivx - 1] + 1) * 24
- 25] = 0.f;
-#line 5194 ""
+#line 5184 ""
}
-#line 5195 ""
+#line 5185 ""
}
-#line 5196 ""
+#line 5186 ""
}
/* Lower dot for lower-voice notes?. Conditions are: */
@@ -12478,282 +12476,282 @@ L10:
/* 4. Not a rest (cannot be a rest in a chord!) */
/* . 5. Flag (lowdot) is set to true */
-#line 5205 ""
+#line 5195 ""
if (comarp_1.lowdot && *nvmx == 2 && *ivx <= *nv) {
-#line 5206 ""
+#line 5196 ""
i__2 = log2_(nodu);
-#line 5206 ""
+#line 5196 ""
if (pow_ii(&c__2, &i__2) != *nodu && (nolev - *ncm) % 2 == 0) {
-#line 5207 ""
+#line 5197 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
/* Note already in movdot list. Drop by 2. */
-#line 5211 ""
+#line 5201 ""
i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &
c__0) - 20;
-#line 5211 ""
+#line 5201 ""
setbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__0, &
i__2);
-#line 5213 ""
+#line 5203 ""
} else {
/* Not in list so just move it right now */
-#line 5217 ""
+#line 5207 ""
i__2 = igetbits_(islur, &c__1, &c__3);
-#line 5217 ""
+#line 5207 ""
dotmov_(&c_b1007, &c_b1008, soutq, lsout, &i__2, (ftnlen)
80);
-#line 5218 ""
+#line 5208 ""
}
-#line 5219 ""
+#line 5209 ""
}
-#line 5220 ""
+#line 5210 ""
}
-#line 5221 ""
+#line 5211 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],26)) {
/* Move the dot. Basic call for chord notes, not main note. */
-#line 5225 ""
+#line 5215 ""
updotc = ((127 & comtrill_1.icrdot[icrd - 1]) - 64) * .1f;
-#line 5226 ""
+#line 5216 ""
rtdotc = ((127 & lbit_shift(comtrill_1.icrdot[icrd - 1], (ftnlen)
-7)) - 64) * .1f;
-#line 5227 ""
+#line 5217 ""
i__2 = igetbits_(islur, &c__1, &c__3);
-#line 5227 ""
+#line 5217 ""
dotmov_(&updotc, &rtdotc, soutq, lsout, &i__2, (ftnlen)80);
-#line 5228 ""
+#line 5218 ""
}
-#line 5229 ""
+#line 5219 ""
isleft = bit_test(comtrill_1.icrdat[icrd - 1],23);
-#line 5230 ""
+#line 5220 ""
isright = bit_test(comtrill_1.icrdat[icrd - 1],24);
/* Check for ornament in chord. */
-#line 5234 ""
+#line 5224 ""
if (comtrill_1.icrdorn[icrd - 1] > 0) {
-#line 5235 ""
+#line 5225 ""
putorn_(&comtrill_1.icrdorn[icrd - 1], &nolev, nolevm, nodu, &
nornb[1], ulq + 25, ibmcnt, ivx, ncm, islur, nvmx, nv, &
ihornb[25], stemlen, outq, &lout, ip, &c__0, beamon, &
c_true, (ftnlen)1, (ftnlen)79);
-#line 5238 ""
+#line 5228 ""
addstr_(outq, &lout, soutq, lsout, (ftnlen)79, (ftnlen)80);
-#line 5239 ""
+#line 5229 ""
}
/* Chord-note symbol. First check for breve */
-#line 5243 ""
+#line 5233 ""
if (*nodu == 128) {
/* Writing concatenation */
-#line 5244 ""
+#line 5234 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5244 ""
+#line 5234 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5244 ""
+#line 5234 ""
i__3[1] = 6, a__1[1] = "zbreve";
-#line 5244 ""
+#line 5234 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5245 ""
+#line 5235 ""
lsym = 7;
-#line 5246 ""
+#line 5236 ""
} else {
/* Not a breve chord. Get first letters in chord-note symbol */
-#line 5250 ""
+#line 5240 ""
if (isleft) {
/* Writing concatenation */
-#line 5251 ""
+#line 5241 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5251 ""
+#line 5241 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5251 ""
+#line 5241 ""
i__3[1] = 1, a__1[1] = "l";
-#line 5251 ""
+#line 5241 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5252 ""
+#line 5242 ""
} else if (isright) {
/* Writing concatenation */
-#line 5253 ""
+#line 5243 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5253 ""
+#line 5243 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5253 ""
+#line 5243 ""
i__3[1] = 1, a__1[1] = "r";
-#line 5253 ""
+#line 5243 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5254 ""
+#line 5244 ""
} else {
/* Writing concatenation */
-#line 5255 ""
+#line 5245 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5255 ""
+#line 5245 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5255 ""
+#line 5245 ""
i__3[1] = 1, a__1[1] = "z";
-#line 5255 ""
+#line 5245 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5256 ""
+#line 5246 ""
}
-#line 5257 ""
+#line 5247 ""
if (*nodu >= 64) {
/* Writing concatenation */
-#line 5258 ""
+#line 5248 ""
i__3[0] = 2, a__1[0] = nosymq;
-#line 5258 ""
+#line 5248 ""
i__3[1] = 1, a__1[1] = "w";
-#line 5258 ""
+#line 5248 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5259 ""
+#line 5249 ""
} else if (*nodu >= 32) {
/* Writing concatenation */
-#line 5260 ""
+#line 5250 ""
i__3[0] = 2, a__1[0] = nosymq;
-#line 5260 ""
+#line 5250 ""
i__3[1] = 1, a__1[1] = "h";
-#line 5260 ""
+#line 5250 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5261 ""
+#line 5251 ""
} else {
/* Writing concatenation */
-#line 5262 ""
+#line 5252 ""
i__3[0] = 2, a__1[0] = nosymq;
-#line 5262 ""
+#line 5252 ""
i__3[1] = 1, a__1[1] = "q";
-#line 5262 ""
+#line 5252 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5263 ""
+#line 5253 ""
}
-#line 5264 ""
+#line 5254 ""
i__2 = log2_(nodu);
-#line 5264 ""
+#line 5254 ""
if (pow_ii(&c__2, &i__2) == *nodu && ! (*dotxtup)) {
-#line 5265 ""
+#line 5255 ""
lsym = 3;
-#line 5266 ""
+#line 5256 ""
} else if (! bit_test(*islur,3) || *dotxtup) {
/* Single dot */
/* Writing concatenation */
-#line 5270 ""
+#line 5260 ""
i__3[0] = 3, a__1[0] = nosymq;
-#line 5270 ""
+#line 5260 ""
i__3[1] = 1, a__1[1] = "p";
-#line 5270 ""
+#line 5260 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5271 ""
+#line 5261 ""
lsym = 4;
-#line 5272 ""
+#line 5262 ""
} else {
/* Double dot */
/* Writing concatenation */
-#line 5276 ""
+#line 5266 ""
i__3[0] = 3, a__1[0] = nosymq;
-#line 5276 ""
+#line 5266 ""
i__3[1] = 2, a__1[1] = "pp";
-#line 5276 ""
+#line 5266 ""
s_cat(nosymq, a__1, i__3, &c__2, (ftnlen)7);
-#line 5277 ""
+#line 5267 ""
lsym = 5;
-#line 5278 ""
+#line 5268 ""
}
-#line 5279 ""
+#line 5269 ""
}
-#line 5280 ""
+#line 5270 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],19) && ! bit_test(
comtrill_1.icrdat[icrd - 1],27)) {
/* Accidental and not MIDI-only. Build up bits 0-3 of nacc */
-#line 5284 ""
+#line 5274 ""
nactmp = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
/* Kluge for bigness. Only means 'As' has not been issued */
-#line 5288 ""
+#line 5278 ""
if (spfacs_1.bacfac != 1e6f) {
-#line 5288 ""
+#line 5278 ""
nactmp += 8;
-#line 5288 ""
+#line 5278 ""
}
-#line 5289 ""
+#line 5279 ""
i__2 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__7, &c__20) -
107;
-#line 5289 ""
+#line 5279 ""
i__4 = igetbits_(&comtrill_1.icrdot[icrd - 1], &c__6, &c__14);
-#line 5289 ""
+#line 5279 ""
i__5 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__7, &c__12);
-#line 5289 ""
+#line 5279 ""
i__6 = ncmid_(iv, ip);
-#line 5289 ""
+#line 5279 ""
L__1 = bit_test(comtrill_1.icrdat[icrd - 1],31);
-#line 5289 ""
+#line 5279 ""
doacc_(&i__2, &i__4, notexq, &lnote, &nactmp, &i__5, &i__6, &L__1,
(ftnlen)79);
/* * notexq,lnote,nactmp,nolev,ncmid(iv,ip)) */
/* Get original nolev, not altered to deal with 2nds */
/* * ncmid(iv,ip)) */
/* Writing concatenation */
-#line 5296 ""
+#line 5286 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5296 ""
+#line 5286 ""
i__3[1] = 7, a__1[1] = nosymq;
-#line 5296 ""
+#line 5286 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5297 ""
+#line 5287 ""
commidi_1.crdacc = TRUE_;
-#line 5298 ""
+#line 5288 ""
} else {
-#line 5299 ""
+#line 5289 ""
s_copy(notexq, nosymq, (ftnlen)79, (ftnlen)7);
-#line 5300 ""
+#line 5290 ""
}
-#line 5301 ""
+#line 5291 ""
lnote += lsym;
/* Get note name (again if accid, due to possible octave jump) */
-#line 5305 ""
+#line 5295 ""
notefq_(noteq, &lnoten, &nolev, ncm, (ftnlen)8);
-#line 5306 ""
+#line 5296 ""
if (lnoten == 1) {
-#line 5306 ""
+#line 5296 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 5306 ""
+#line 5296 ""
}
/* Put in note name */
/* Writing concatenation */
-#line 5310 ""
+#line 5300 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5310 ""
+#line 5300 ""
i__3[1] = 8, a__1[1] = noteq;
-#line 5310 ""
+#line 5300 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5311 ""
+#line 5301 ""
lnote += lnoten;
-#line 5312 ""
+#line 5302 ""
if (bit_test(comtrill_1.icrdat[icrd - 1],25)) {
/* Arpeggio signal */
-#line 5316 ""
+#line 5306 ""
putarp_(tnow, ivx, ip, &nolev, ncm, soutq, lsout, (ftnlen)80);
-#line 5317 ""
+#line 5307 ""
}
-#line 5318 ""
+#line 5308 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
-#line 5319 ""
+#line 5309 ""
if (commidi_1.ismidi) {
/* Here is where we collect MIDI pitch info for the chord note. By checking */
@@ -12761,53 +12759,53 @@ L10:
/* pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() */
/* for MAIN note, will put in note codes for all chord notes + main note. */
-#line 5326 ""
+#line 5316 ""
kv = 1;
-#line 5327 ""
+#line 5317 ""
if (*ivx > *iv) {
-#line 5327 ""
+#line 5317 ""
kv = 2;
-#line 5327 ""
+#line 5317 ""
}
-#line 5328 ""
+#line 5318 ""
++commidi_1.nmidcrd;
-#line 5329 ""
+#line 5319 ""
if (commidi_1.nmidcrd > 20) {
-#line 5330 ""
+#line 5320 ""
s_wsle(&io___382);
-#line 5330 ""
+#line 5320 ""
e_wsle();
-#line 5331 ""
+#line 5321 ""
s_wsle(&io___383);
-#line 5331 ""
+#line 5321 ""
do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr"\
"ocessor", (ftnlen)45);
-#line 5331 ""
+#line 5321 ""
e_wsle();
-#line 5332 ""
+#line 5322 ""
stop1_();
-#line 5333 ""
+#line 5323 ""
}
/* Use original saved pitch level, unaltered by 2nds logic. */
-#line 5337 ""
+#line 5327 ""
i__2 = nolevo + commvel_1.miditran[cominsttrans_1.instno[*iv - 1]
- 1];
-#line 5337 ""
+#line 5327 ""
i__4 = igetbits_(&comtrill_1.icrdat[icrd - 1], &c__3, &c__20);
-#line 5337 ""
+#line 5327 ""
addmidi_(&commidi_1.midchan[*iv + kv * 24 - 25], &i__2, &i__4, &
commidisig_1.midisig, &c_b1053, &c_false, &c_false);
-#line 5340 ""
+#line 5330 ""
}
-#line 5341 ""
+#line 5331 ""
/* L5: */
-#line 5341 ""
+#line 5331 ""
}
-#line 5342 ""
+#line 5332 ""
commidi_1.notmain = FALSE_;
-#line 5343 ""
+#line 5333 ""
return 0;
} /* docrd_ */
@@ -12882,196 +12880,196 @@ L10:
/* Inputs are array *elements* except ihornb,nornb,ulq */
-#line 5371 ""
+#line 5361 ""
/* Parameter adjustments */
-#line 5371 ""
+#line 5361 ""
ulq -= 25;
-#line 5371 ""
+#line 5361 ""
--nornb;
-#line 5371 ""
+#line 5361 ""
ihornb -= 25;
-#line 5371 ""
+#line 5361 ""
-#line 5371 ""
+#line 5361 ""
/* Function Body */
-#line 5372 ""
+#line 5362 ""
numdyn = 0;
/* Find dynamics for (ivx,ip) in list. May be as many as 4. Store idyn values */
/* in idynn(1...4) */
-#line 5377 ""
+#line 5367 ""
i__1 = comdyn_1.ndyn;
-#line 5377 ""
+#line 5367 ""
for (idyn = 1; idyn <= i__1; ++idyn) {
-#line 5378 ""
+#line 5368 ""
ivxtent = (comdyn_1.idyndat[idyn - 1] & 15) + (igetbits_(&
comdyn_1.idynda2[idyn - 1], &c__1, &c__10) << 4);
-#line 5380 ""
+#line 5370 ""
if (ivxtent == *ivx) {
-#line 5381 ""
+#line 5371 ""
iptent = igetbits_(&comdyn_1.idyndat[idyn - 1], &c__8, &c__4);
-#line 5382 ""
+#line 5372 ""
if (iptent == *ip) {
-#line 5383 ""
+#line 5373 ""
++numdyn;
-#line 5384 ""
+#line 5374 ""
idynn[numdyn - 1] = idyn;
-#line 5385 ""
+#line 5375 ""
} else if (iptent > *ip) {
/* I don't think there are any more possible for this ivx,ip, so exit loop */
-#line 5389 ""
+#line 5379 ""
goto L2;
-#line 5390 ""
+#line 5380 ""
}
-#line 5391 ""
+#line 5381 ""
}
-#line 5392 ""
+#line 5382 ""
/* L1: */
-#line 5392 ""
+#line 5382 ""
}
-#line 5393 ""
+#line 5383 ""
L2:
/* At this point there is a list of idyn's in idynn(1...numdyn) */
/* Compute level, and stem-dir'n-based horizontal tweaks */
-#line 5398 ""
+#line 5388 ""
hoffsd = 0.f;
/* Set upstem to false as default */
-#line 5402 ""
+#line 5392 ""
upstem = FALSE_;
-#line 5403 ""
+#line 5393 ""
if (bit_test(*irest,0)) {
/* It's a rest. Assume it doesn't go below the staff */
-#line 5407 ""
+#line 5397 ""
lbot = *ncm - 4;
-#line 5408 ""
+#line 5398 ""
} else if (! (*beamon)) {
-#line 5409 ""
+#line 5399 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, nvmx, ivx, nv);
-#line 5409 ""
+#line 5399 ""
if (*(unsigned char *)&ch__1[0] == 'u' || *nostem) {
-#line 5410 ""
+#line 5400 ""
upstem = TRUE_;
-#line 5411 ""
+#line 5401 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
-#line 5412 ""
+#line 5402 ""
i__1 = *nolev - 1, i__2 = *ncm - 4;
-#line 5412 ""
+#line 5402 ""
lbot = min(i__1,i__2);
-#line 5413 ""
+#line 5403 ""
} else {
/* Computing MIN */
-#line 5414 ""
+#line 5404 ""
i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
-#line 5414 ""
+#line 5404 ""
lbot = min(i__1,i__2);
-#line 5415 ""
+#line 5405 ""
}
-#line 5416 ""
+#line 5406 ""
} else {
-#line 5417 ""
+#line 5407 ""
hoffsd = -.5f;
-#line 5418 ""
+#line 5408 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
-#line 5419 ""
+#line 5409 ""
i__1 = *nolev - 7, i__2 = *ncm - 4;
-#line 5419 ""
+#line 5409 ""
lbot = min(i__1,i__2);
-#line 5420 ""
+#line 5410 ""
} else {
/* Computing MIN */
-#line 5421 ""
+#line 5411 ""
i__1 = comtrill_1.minlev - 7, i__2 = *ncm - 4;
-#line 5421 ""
+#line 5411 ""
lbot = min(i__1,i__2);
-#line 5422 ""
+#line 5412 ""
}
-#line 5423 ""
+#line 5413 ""
}
-#line 5424 ""
+#line 5414 ""
} else {
-#line 5425 ""
+#line 5415 ""
if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
-#line 5426 ""
+#line 5416 ""
upstem = TRUE_;
-#line 5427 ""
+#line 5417 ""
if (! bit_test(*ipl,10)) {
/* Computing MIN */
-#line 5428 ""
+#line 5418 ""
i__1 = *nolev - 1, i__2 = *ncm - 4;
-#line 5428 ""
+#line 5418 ""
lbot = min(i__1,i__2);
-#line 5429 ""
+#line 5419 ""
} else {
/* Computing MIN */
-#line 5430 ""
+#line 5420 ""
i__1 = comtrill_1.minlev - 1, i__2 = *ncm - 4;
-#line 5430 ""
+#line 5420 ""
lbot = min(i__1,i__2);
-#line 5431 ""
+#line 5421 ""
}
-#line 5432 ""
+#line 5422 ""
} else {
-#line 5433 ""
+#line 5423 ""
hoffsd = -.5f;
/* 171230 Desperation */
/* lbot = ihornb(ivx,nornb(ivx))+1 */
-#line 5437 ""
+#line 5427 ""
if (nornb[*ivx] == 0) {
-#line 5438 ""
+#line 5428 ""
lbot = 1;
-#line 5439 ""
+#line 5429 ""
} else {
-#line 5440 ""
+#line 5430 ""
lbot = ihornb[*ivx + nornb[*ivx] * 24] + 1;
-#line 5441 ""
+#line 5431 ""
}
-#line 5442 ""
+#line 5432 ""
if (lbot == 1) {
/* Kluge for non-beamed, down xtup, for which ihorb was never set. */
/* Assumes stem is shortened. */
-#line 5447 ""
+#line 5437 ""
lbot = *nolev - 5;
-#line 5448 ""
+#line 5438 ""
}
-#line 5449 ""
+#line 5439 ""
++nornb[*ivx];
-#line 5450 ""
+#line 5440 ""
}
-#line 5451 ""
+#line 5441 ""
}
-#line 5452 ""
+#line 5442 ""
lbot += -5;
-#line 5453 ""
+#line 5443 ""
jtxtdyn1 = 1;
/* Now ready to loop over current dyn's */
-#line 5457 ""
+#line 5447 ""
i__1 = numdyn;
-#line 5457 ""
+#line 5447 ""
for (icntdyn = 1; icntdyn <= i__1; ++icntdyn) {
-#line 5458 ""
+#line 5448 ""
idynd = comdyn_1.idyndat[idynn[icntdyn - 1] - 1];
-#line 5459 ""
+#line 5449 ""
idynd2 = comdyn_1.idynda2[idynn[icntdyn - 1] - 1];
-#line 5460 ""
+#line 5450 ""
idno = igetbits_(&idynd, &c__4, &c__12);
/* ivx = iand(15,idynd) */
-#line 5462 ""
+#line 5452 ""
*ivx = (15 & idynd) + (igetbits_(&idynd2, &c__1, &c__10) << 4);
/* Build the command into notex in stages. Insert name & rq'd args in order: */
@@ -13087,366 +13085,366 @@ L2:
/* d-mark */
/* X */
-#line 5477 ""
+#line 5467 ""
if (idno == 0) {
/* Text-dynamic */
/* Writing concatenation */
-#line 5481 ""
+#line 5471 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5481 ""
+#line 5471 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5481 ""
+#line 5471 ""
i__3[1] = 6, a__1[1] = "txtdyn";
-#line 5481 ""
+#line 5471 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5482 ""
+#line 5472 ""
lnote = 7;
-#line 5483 ""
+#line 5473 ""
} else if (idno <= 12) {
/* Letter-group */
/* Writing concatenation */
-#line 5487 ""
+#line 5477 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5487 ""
+#line 5477 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5487 ""
+#line 5477 ""
i__3[1] = 6, a__1[1] = "pmxdyn";
-#line 5487 ""
+#line 5477 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5488 ""
+#line 5478 ""
lnote = 7;
-#line 5489 ""
+#line 5479 ""
} else if (comslur_1.fontslur) {
-#line 5490 ""
+#line 5480 ""
lnote = 7;
-#line 5491 ""
+#line 5481 ""
if (idno == 13) {
/* Start a font-based hairpin */
/* Writing concatenation */
-#line 5495 ""
+#line 5485 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5495 ""
+#line 5485 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5495 ""
+#line 5485 ""
i__3[1] = 6, a__1[1] = "hpstrt";
-#line 5495 ""
+#line 5485 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5496 ""
+#line 5486 ""
} else if (idno == 14) {
/* End crescendo */
/* Writing concatenation */
-#line 5500 ""
+#line 5490 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5500 ""
+#line 5490 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5500 ""
+#line 5490 ""
i__3[1] = 6, a__1[1] = "hpcend";
-#line 5500 ""
+#line 5490 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5501 ""
+#line 5491 ""
} else {
/* End decrescendo */
/* Writing concatenation */
-#line 5505 ""
+#line 5495 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5505 ""
+#line 5495 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5505 ""
+#line 5495 ""
i__3[1] = 6, a__1[1] = "hpdend";
-#line 5505 ""
+#line 5495 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5506 ""
+#line 5496 ""
}
/* Put in voice number as ID for font-based hairpin */
-#line 5510 ""
+#line 5500 ""
if (*ivx <= 9) {
/* Writing concatenation */
-#line 5511 ""
+#line 5501 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5511 ""
+#line 5501 ""
*(unsigned char *)&ch__1[0] = *ivx + 48;
-#line 5511 ""
+#line 5501 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 5511 ""
+#line 5501 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5512 ""
+#line 5502 ""
++lnote;
-#line 5513 ""
+#line 5503 ""
} else if (*ivx <= 19) {
/* Writing concatenation */
-#line 5514 ""
+#line 5504 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 5514 ""
+#line 5504 ""
i__4[1] = 2, a__2[1] = "{1";
-#line 5514 ""
+#line 5504 ""
*(unsigned char *)&ch__1[0] = *ivx + 38;
-#line 5514 ""
+#line 5504 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 5514 ""
+#line 5504 ""
i__4[3] = 1, a__2[3] = "}";
-#line 5514 ""
+#line 5504 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 5515 ""
+#line 5505 ""
lnote += 4;
-#line 5516 ""
+#line 5506 ""
} else {
/* Writing concatenation */
-#line 5517 ""
+#line 5507 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 5517 ""
+#line 5507 ""
i__4[1] = 2, a__2[1] = "{2";
-#line 5517 ""
+#line 5507 ""
*(unsigned char *)&ch__1[0] = *ivx + 28;
-#line 5517 ""
+#line 5507 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 5517 ""
+#line 5507 ""
i__4[3] = 1, a__2[3] = "}";
-#line 5517 ""
+#line 5507 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 5518 ""
+#line 5508 ""
lnote += 4;
-#line 5519 ""
+#line 5509 ""
}
-#line 5520 ""
+#line 5510 ""
} else {
/* Postscript hairpins */
-#line 5524 ""
+#line 5514 ""
lnote = 7;
-#line 5525 ""
+#line 5515 ""
if (idno == 13) {
/* Writing concatenation */
-#line 5526 ""
+#line 5516 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5526 ""
+#line 5516 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5526 ""
+#line 5516 ""
i__3[1] = 6, a__1[1] = "Icresc";
-#line 5526 ""
+#line 5516 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5527 ""
+#line 5517 ""
} else if (idno == 14) {
/* Writing concatenation */
-#line 5528 ""
+#line 5518 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5528 ""
+#line 5518 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5528 ""
+#line 5518 ""
i__3[1] = 8, a__1[1] = "Idecresc";
-#line 5528 ""
+#line 5518 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5529 ""
+#line 5519 ""
lnote = 9;
-#line 5530 ""
+#line 5520 ""
} else {
/* Writing concatenation */
-#line 5531 ""
+#line 5521 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5531 ""
+#line 5521 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 5531 ""
+#line 5521 ""
i__3[1] = 6, a__1[1] = "Tcresc";
-#line 5531 ""
+#line 5521 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5532 ""
+#line 5522 ""
}
-#line 5533 ""
+#line 5523 ""
if (idno <= 14) {
/* Get and record ID no for start of ps hairpin */
/* Find first unused ID */
-#line 5538 ""
+#line 5528 ""
for (idh = 1; idh <= 24; ++idh) {
-#line 5539 ""
+#line 5529 ""
if (! bit_test(comhair_1.ihairuse,idh)) {
-#line 5539 ""
+#line 5529 ""
goto L9;
-#line 5539 ""
+#line 5529 ""
}
-#line 5540 ""
+#line 5530 ""
/* L8: */
-#line 5540 ""
+#line 5530 ""
}
-#line 5541 ""
+#line 5531 ""
printl_("Bad place in putdyn, call Dr. Don", (ftnlen)33);
-#line 5542 ""
+#line 5532 ""
stop1_();
-#line 5543 ""
+#line 5533 ""
L9:
-#line 5544 ""
+#line 5534 ""
comhair_1.ihairuse = bit_set(comhair_1.ihairuse,idh);
-#line 5545 ""
+#line 5535 ""
comhair_1.idhair[*ivx - 1] = idh;
-#line 5546 ""
+#line 5536 ""
} else {
/* Unrecord ID no for end of ps hairpin */
-#line 5550 ""
+#line 5540 ""
setbits_(&comhair_1.ihairuse, &c__1, &comhair_1.idhair[*ivx -
1], &c__0);
-#line 5551 ""
+#line 5541 ""
}
/* Write ID # for start or end of ps hairpin */
-#line 5555 ""
+#line 5545 ""
idh = comhair_1.idhair[*ivx - 1];
-#line 5556 ""
+#line 5546 ""
if (idh <= 9) {
/* Writing concatenation */
-#line 5557 ""
+#line 5547 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5557 ""
+#line 5547 ""
*(unsigned char *)&ch__1[0] = idh + 48;
-#line 5557 ""
+#line 5547 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 5557 ""
+#line 5547 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5558 ""
+#line 5548 ""
++lnote;
-#line 5559 ""
+#line 5549 ""
} else if (idh <= 19) {
/* Writing concatenation */
-#line 5560 ""
+#line 5550 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 5560 ""
+#line 5550 ""
i__4[1] = 2, a__2[1] = "{1";
-#line 5560 ""
+#line 5550 ""
*(unsigned char *)&ch__1[0] = idh + 38;
-#line 5560 ""
+#line 5550 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 5560 ""
+#line 5550 ""
i__4[3] = 1, a__2[3] = "}";
-#line 5560 ""
+#line 5550 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 5561 ""
+#line 5551 ""
lnote += 4;
-#line 5562 ""
+#line 5552 ""
} else {
/* Writing concatenation */
-#line 5563 ""
+#line 5553 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 5563 ""
+#line 5553 ""
i__4[1] = 2, a__2[1] = "{2";
-#line 5563 ""
+#line 5553 ""
*(unsigned char *)&ch__1[0] = idh + 28;
-#line 5563 ""
+#line 5553 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 5563 ""
+#line 5553 ""
i__4[3] = 1, a__2[3] = "}";
-#line 5563 ""
+#line 5553 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 5564 ""
+#line 5554 ""
lnote += 4;
-#line 5565 ""
+#line 5555 ""
}
-#line 5566 ""
+#line 5556 ""
}
/* Begin setting level */
-#line 5570 ""
+#line 5560 ""
lbot1 = lbot;
-#line 5571 ""
+#line 5561 ""
if (idno > 0 && idno <= 5) {
/* All letters are short so raise a bit. */
-#line 5575 ""
+#line 5565 ""
++lbot1;
-#line 5576 ""
+#line 5566 ""
} else if (idno >= 13) {
-#line 5577 ""
+#line 5567 ""
lbot1 += 2;
-#line 5578 ""
+#line 5568 ""
}
/* Convert so reference is bottom line */
-#line 5582 ""
+#line 5572 ""
lbot1 = lbot1 - *ncm + 4;
-#line 5583 ""
+#line 5573 ""
if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno
== 13 || idno == 14)) {
/* Hairpin start. Save level and user-tweak before applying user tweak. */
-#line 5588 ""
+#line 5578 ""
comdyn_1.levdsav[*ivx - 1] = lbot1;
-#line 5589 ""
+#line 5579 ""
comdyn_1.levhssav[*ivx - 1] = 0;
-#line 5590 ""
+#line 5580 ""
if (bit_test(idynd,16)) {
-#line 5590 ""
+#line 5580 ""
comdyn_1.levhssav[*ivx - 1] = igetbits_(&idynd, &c__7, &c__17)
- 64;
-#line 5590 ""
+#line 5580 ""
}
-#line 5591 ""
+#line 5581 ""
} else if (comslur_1.fontslur && idno >= 14 || idno == 15) {
/* Hairpin end; Compare level with saved start level before user-tweaks */
/* Computing MIN */
-#line 5595 ""
+#line 5585 ""
i__2 = lbot1, i__5 = comdyn_1.levdsav[*ivx - 1];
-#line 5595 ""
+#line 5585 ""
lbot1 = min(i__2,i__5);
/* Save pre-tweak level */
-#line 5599 ""
+#line 5589 ""
lpretweak = lbot1;
-#line 5600 ""
+#line 5590 ""
}
/* Check for user-defined vertical tweak */
-#line 5604 ""
+#line 5594 ""
if (bit_test(idynd,16)) {
-#line 5604 ""
+#line 5594 ""
lbot1 = lbot1 - 64 + igetbits_(&idynd, &c__7, &c__17);
-#line 5604 ""
+#line 5594 ""
}
/* Now horizontal stuff */
-#line 5608 ""
+#line 5598 ""
hoff = hoffsd;
/* Some special horizontal tweaks */
-#line 5612 ""
+#line 5602 ""
if (upstem && idno > 0 && (idno <= 4 || idno == 8 || idno == 9)) {
-#line 5612 ""
+#line 5602 ""
hoff += .4f;
-#line 5612 ""
+#line 5602 ""
}
/* User-defined tweaks */
-#line 5617 ""
+#line 5607 ""
if (bit_test(idynd2,0)) {
-#line 5617 ""
+#line 5607 ""
hoff += (igetbits_(&idynd2, &c__9, &c__1) - 256) * .1f;
-#line 5617 ""
+#line 5607 ""
}
-#line 5619 ""
+#line 5609 ""
if (numdyn > 1) {
/* Horizontal-interaction-based tweaks. */
@@ -13458,23 +13456,23 @@ L9:
/* 2 hrpnend hrpnstrt - hoh2h1(1...2) */
/* 3 hrpnend wrd-grp hrpnstrt ivowg,hoh2,hoh1 */
-#line 5630 ""
+#line 5620 ""
if (idno > 0 && idno <= 12) {
/* Word-group, may need vertical tweak to line up. */
-#line 5634 ""
+#line 5624 ""
lbot1 += comdyn_1.ivowg[idno - 1];
/* Protecting against hp start-stop on same note */
-#line 5638 ""
+#line 5628 ""
} else if ((comslur_1.fontslur && idno >= 14 || idno == 15) &&
icntdyn < numdyn) {
/* Hairpin ending, check next type */
-#line 5643 ""
+#line 5633 ""
if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
icntdyn] - 1], &c__4, &c__12) == 13 || !
comslur_1.fontslur && (igetbits_(&comdyn_1.idyndat[
@@ -13484,28 +13482,28 @@ L9:
/* Hairpin end then hairpin start, no words, (remember dealing with end now) */
-#line 5653 ""
+#line 5643 ""
hoff += comdyn_1.hoh2h1[0];
-#line 5654 ""
+#line 5644 ""
} else {
/* Hairpin end then word-group, need idno for w-g to set hp offset */
-#line 5658 ""
+#line 5648 ""
hoff += comdyn_1.hoh2[igetbits_(&comdyn_1.idyndat[idynn[
icntdyn] - 1], &c__4, &c__12) - 1];
-#line 5660 ""
+#line 5650 ""
}
/* Protecting against hp start-stop on same note */
-#line 5664 ""
+#line 5654 ""
} else if (icntdyn > 1 && idno > 0 && (comslur_1.fontslur && idno
< 14 || ! comslur_1.fontslur && idno < 15)) {
/* Hairpin start, check prior type */
-#line 5670 ""
+#line 5660 ""
if (comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[idynn[
icntdyn - 2] - 1], &c__4, &c__12) >= 14 || !
comslur_1.fontslur && igetbits_(&comdyn_1.idyndat[
@@ -13513,30 +13511,30 @@ L9:
/* Hairpin end then hairpin start, (remember dealing with start now) */
-#line 5679 ""
+#line 5669 ""
hoff += comdyn_1.hoh2h1[1];
-#line 5680 ""
+#line 5670 ""
} else {
/* Hairpin start after word-group, need idno for w-g to set hp offset */
-#line 5684 ""
+#line 5674 ""
hoff += comdyn_1.hoh1[igetbits_(&comdyn_1.idyndat[idynn[
icntdyn - 2] - 1], &c__4, &c__12) - 1];
-#line 5686 ""
+#line 5676 ""
}
-#line 5687 ""
+#line 5677 ""
}
-#line 5688 ""
+#line 5678 ""
}
/* End of if-block for 2- or 3-way interactions. */
-#line 5692 ""
+#line 5682 ""
if (! comslur_1.fontslur && idno >= 13) {
-#line 5692 ""
+#line 5682 ""
hoff = (hoff + .5f) * 6.f / 2.5f;
-#line 5692 ""
+#line 5682 ""
}
/* Slur font and hairpin. Add hoff, and change from \interneote to \qn@width */
@@ -13544,217 +13542,217 @@ L9:
/* Position corrections all done now. Put in the level. */
-#line 5700 ""
+#line 5690 ""
if (comslur_1.fontslur && idno == 13 || ! comslur_1.fontslur && (idno
== 13 || idno == 14)) {
/* Hairpin start. */
-#line 5705 ""
+#line 5695 ""
if (! comslur_1.fontslur) {
/* Postscript hairpin start...inset placeholder for start level. */
/* Writing concatenation */
-#line 5709 ""
+#line 5699 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5709 ""
+#line 5699 ""
i__3[1] = 5, a__1[1] = "{ }";
-#line 5709 ""
+#line 5699 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5710 ""
+#line 5700 ""
lnote += 5;
-#line 5711 ""
+#line 5701 ""
}
-#line 5712 ""
+#line 5702 ""
} else {
/* Insert actual level in all cases except hairpin start */
/* Create string with level in it */
-#line 5717 ""
+#line 5707 ""
if (lbot1 > 9) {
-#line 5718 ""
+#line 5708 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5719 ""
+#line 5709 ""
s_wsfi(&io___405);
-#line 5719 ""
+#line 5709 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5719 ""
+#line 5709 ""
e_wsfi();
/* Writing concatenation */
-#line 5720 ""
+#line 5710 ""
i__3[0] = 3, a__1[0] = numpq;
-#line 5720 ""
+#line 5710 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5720 ""
+#line 5710 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5721 ""
+#line 5711 ""
lnumpq = 4;
-#line 5722 ""
+#line 5712 ""
} else if (lbot1 > -1) {
-#line 5723 ""
+#line 5713 ""
*(unsigned char *)&ch__1[0] = lbot1 + 48;
-#line 5723 ""
+#line 5713 ""
s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
-#line 5724 ""
+#line 5714 ""
lnumpq = 1;
-#line 5725 ""
+#line 5715 ""
} else if (lbot1 > -10) {
-#line 5726 ""
+#line 5716 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5727 ""
+#line 5717 ""
s_wsfi(&io___407);
-#line 5727 ""
+#line 5717 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5727 ""
+#line 5717 ""
e_wsfi();
/* Writing concatenation */
-#line 5728 ""
+#line 5718 ""
i__3[0] = 3, a__1[0] = numpq;
-#line 5728 ""
+#line 5718 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5728 ""
+#line 5718 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5729 ""
+#line 5719 ""
lnumpq = 4;
-#line 5730 ""
+#line 5720 ""
} else {
-#line 5731 ""
+#line 5721 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5732 ""
+#line 5722 ""
s_wsfi(&io___408);
-#line 5732 ""
+#line 5722 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5732 ""
+#line 5722 ""
e_wsfi();
/* Writing concatenation */
-#line 5733 ""
+#line 5723 ""
i__3[0] = 4, a__1[0] = numpq;
-#line 5733 ""
+#line 5723 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5733 ""
+#line 5723 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5734 ""
+#line 5724 ""
lnumpq = 5;
-#line 5735 ""
+#line 5725 ""
}
/* Level has now been computed and stored in numpq */
/* Append the level */
/* Writing concatenation */
-#line 5740 ""
+#line 5730 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5740 ""
+#line 5730 ""
i__3[1] = lnumpq, a__1[1] = numpq;
-#line 5740 ""
+#line 5730 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5741 ""
+#line 5731 ""
lnote += lnumpq;
-#line 5742 ""
+#line 5732 ""
}
-#line 5743 ""
+#line 5733 ""
if (dabs(hoff) < .001f) {
/* No horiz offset */
/* Writing concatenation */
-#line 5747 ""
+#line 5737 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5747 ""
+#line 5737 ""
i__3[1] = 1, a__1[1] = "0";
-#line 5747 ""
+#line 5737 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5748 ""
+#line 5738 ""
++lnote;
-#line 5749 ""
+#line 5739 ""
} else {
/* Horizontal tweak */
-#line 5753 ""
+#line 5743 ""
lform = lfmt1_(&hoff);
/* Writing concatenation */
-#line 5754 ""
+#line 5744 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5754 ""
+#line 5744 ""
i__3[1] = 1, a__1[1] = "{";
-#line 5754 ""
+#line 5744 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5755 ""
+#line 5745 ""
++lnote;
-#line 5756 ""
+#line 5746 ""
i__2 = lnote;
-#line 5756 ""
+#line 5746 ""
ici__1.icierr = 0;
-#line 5756 ""
+#line 5746 ""
ici__1.icirnum = 1;
-#line 5756 ""
+#line 5746 ""
ici__1.icirlen = lnote + lform - i__2;
-#line 5756 ""
+#line 5746 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 5756 ""
+#line 5746 ""
i__6[0] = 2, a__3[0] = "(f";
-#line 5756 ""
+#line 5746 ""
i__5 = lform + 48;
-#line 5756 ""
+#line 5746 ""
chax_(ch__1, (ftnlen)1, &i__5);
-#line 5756 ""
+#line 5746 ""
i__6[1] = 1, a__3[1] = ch__1;
-#line 5756 ""
+#line 5746 ""
i__6[2] = 3, a__3[2] = ".1)";
-#line 5756 ""
+#line 5746 ""
ici__1.icifmt = (s_cat(ch__2, a__3, i__6, &c__3, (ftnlen)6),
ch__2);
-#line 5756 ""
+#line 5746 ""
s_wsfi(&ici__1);
-#line 5756 ""
+#line 5746 ""
do_fio(&c__1, (char *)&hoff, (ftnlen)sizeof(real));
-#line 5756 ""
+#line 5746 ""
e_wsfi();
-#line 5758 ""
+#line 5748 ""
lnote += lform;
/* Writing concatenation */
-#line 5759 ""
+#line 5749 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 5759 ""
+#line 5749 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5759 ""
+#line 5749 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 5760 ""
+#line 5750 ""
++lnote;
-#line 5761 ""
+#line 5751 ""
}
-#line 5762 ""
+#line 5752 ""
if (idno == 0) {
/* text-dynamic. Find the string and append it */
-#line 5766 ""
+#line 5756 ""
i__2 = comdyn_1.ntxtdyn;
-#line 5766 ""
+#line 5756 ""
for (jtxtdyn = jtxtdyn1; jtxtdyn <= i__2; ++jtxtdyn) {
/* ivxip = ivx+16*ip */
-#line 5768 ""
+#line 5758 ""
ivxip = *ivx + (*ip << 5);
-#line 5769 ""
+#line 5759 ""
if (ivxip == comdyn_1.ivxiptxt[jtxtdyn - 1]) {
-#line 5769 ""
+#line 5759 ""
goto L5;
-#line 5769 ""
+#line 5759 ""
}
-#line 5770 ""
+#line 5760 ""
/* L4: */
-#line 5770 ""
+#line 5760 ""
}
-#line 5771 ""
+#line 5761 ""
printl_("Abnormal stop in putdyn", (ftnlen)23);
-#line 5772 ""
+#line 5762 ""
stop1_();
-#line 5773 ""
+#line 5763 ""
L5:
-#line 5774 ""
+#line 5764 ""
ltxtdyn = lenstr_(comdyn_1.txtdynq + (jtxtdyn - 1 << 7), &c__128,
(ftnlen)128);
@@ -13780,264 +13778,264 @@ L5:
/* Do this to insert 1st 2 args of \txtdyn, allow 3rd to be longer (on next line) */
-#line 5798 ""
+#line 5788 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
-#line 5799 ""
+#line 5789 ""
if (commus_1.musize == 20) {
-#line 5800 ""
+#line 5790 ""
s_copy(notexq, "{\\medtype\\it ", (ftnlen)79, (ftnlen)13);
-#line 5801 ""
+#line 5791 ""
lnote = 13;
-#line 5802 ""
+#line 5792 ""
} else if (commus_1.musize == 16) {
-#line 5803 ""
+#line 5793 ""
s_copy(notexq, "{\\normtype\\it ", (ftnlen)79, (ftnlen)14);
-#line 5804 ""
+#line 5794 ""
lnote = 14;
-#line 5805 ""
+#line 5795 ""
} else if (commus_1.musize == 24) {
-#line 5806 ""
+#line 5796 ""
s_copy(notexq, "{\\bigtype\\it ", (ftnlen)79, (ftnlen)13);
-#line 5807 ""
+#line 5797 ""
lnote = 13;
-#line 5808 ""
+#line 5798 ""
} else if (commus_1.musize == 29) {
-#line 5809 ""
+#line 5799 ""
s_copy(notexq, "{\\Bigtype\\it ", (ftnlen)79, (ftnlen)13);
-#line 5810 ""
+#line 5800 ""
lnote = 13;
-#line 5811 ""
+#line 5801 ""
}
/* Writing concatenation */
-#line 5813 ""
+#line 5803 ""
i__6[0] = lnote, a__3[0] = notexq;
-#line 5813 ""
+#line 5803 ""
i__6[1] = ltxtdyn, a__3[1] = comdyn_1.txtdynq + (jtxtdyn - 1 << 7)
;
-#line 5813 ""
+#line 5803 ""
i__6[2] = 1, a__3[2] = "}";
-#line 5813 ""
+#line 5803 ""
s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
-#line 5814 ""
+#line 5804 ""
lnote = lnote + ltxtdyn + 1;
/* Reset jtxtdyn1 just in case >1 txtdyn on same note. */
-#line 5818 ""
+#line 5808 ""
jtxtdyn1 = jtxtdyn + 1;
-#line 5819 ""
+#line 5809 ""
} else if (idno <= 12) {
/* Letter-group dynamic. Append the letter-group command */
-#line 5823 ""
+#line 5813 ""
id = idno << 2;
-#line 5824 ""
+#line 5814 ""
i__2 = id - 4;
-#line 5824 ""
+#line 5814 ""
s_copy(dynstrq, dyntablq + i__2, (ftnlen)4, id - i__2);
-#line 5825 ""
+#line 5815 ""
id = lenstr_(dynstrq, &c__4, (ftnlen)4);
/* Writing concatenation */
-#line 5826 ""
+#line 5816 ""
i__6[0] = lnote, a__3[0] = notexq;
-#line 5826 ""
+#line 5816 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5826 ""
+#line 5816 ""
i__6[1] = 1, a__3[1] = ch__1;
-#line 5826 ""
+#line 5816 ""
i__6[2] = id, a__3[2] = dynstrq;
-#line 5826 ""
+#line 5816 ""
s_cat(notexq, a__3, i__6, &c__3, (ftnlen)79);
-#line 5827 ""
+#line 5817 ""
lnote = lnote + 1 + id;
-#line 5828 ""
+#line 5818 ""
}
-#line 5829 ""
+#line 5819 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
-#line 5830 ""
+#line 5820 ""
if (! comslur_1.fontslur && idno == 15) {
/* PS slurs on, hairpin is ending. Go back and set height at beginning. */
/* Add user-defined tweak to default level */
-#line 5835 ""
+#line 5825 ""
lbot1 = lpretweak + comdyn_1.levhssav[*ivx - 1];
-#line 5836 ""
+#line 5826 ""
if (lbot1 > 9) {
-#line 5837 ""
+#line 5827 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5838 ""
+#line 5828 ""
s_wsfi(&io___415);
-#line 5838 ""
+#line 5828 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5838 ""
+#line 5828 ""
e_wsfi();
/* Writing concatenation */
-#line 5839 ""
+#line 5829 ""
i__3[0] = 3, a__1[0] = numpq;
-#line 5839 ""
+#line 5829 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5839 ""
+#line 5829 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5840 ""
+#line 5830 ""
lnumpq = 4;
-#line 5841 ""
+#line 5831 ""
} else if (lbot1 > -1) {
-#line 5842 ""
+#line 5832 ""
*(unsigned char *)&ch__1[0] = lbot1 + 48;
-#line 5842 ""
+#line 5832 ""
s_copy(numpq, ch__1, (ftnlen)5, (ftnlen)1);
-#line 5843 ""
+#line 5833 ""
lnumpq = 1;
-#line 5844 ""
+#line 5834 ""
} else if (lbot1 > -10) {
-#line 5845 ""
+#line 5835 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5846 ""
+#line 5836 ""
s_wsfi(&io___416);
-#line 5846 ""
+#line 5836 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5846 ""
+#line 5836 ""
e_wsfi();
/* Writing concatenation */
-#line 5847 ""
+#line 5837 ""
i__3[0] = 3, a__1[0] = numpq;
-#line 5847 ""
+#line 5837 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5847 ""
+#line 5837 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5848 ""
+#line 5838 ""
lnumpq = 4;
-#line 5849 ""
+#line 5839 ""
} else {
-#line 5850 ""
+#line 5840 ""
s_copy(numpq, "{", (ftnlen)5, (ftnlen)1);
-#line 5851 ""
+#line 5841 ""
s_wsfi(&io___417);
-#line 5851 ""
+#line 5841 ""
do_fio(&c__1, (char *)&lbot1, (ftnlen)sizeof(integer));
-#line 5851 ""
+#line 5841 ""
e_wsfi();
/* Writing concatenation */
-#line 5852 ""
+#line 5842 ""
i__3[0] = 4, a__1[0] = numpq;
-#line 5852 ""
+#line 5842 ""
i__3[1] = 1, a__1[1] = "}";
-#line 5852 ""
+#line 5842 ""
s_cat(numpq, a__1, i__3, &c__2, (ftnlen)5);
-#line 5853 ""
+#line 5843 ""
lnumpq = 5;
-#line 5854 ""
+#line 5844 ""
}
/* Construct string to search backwards for placeholder */
-#line 5858 ""
+#line 5848 ""
if (idh <= 9) {
/* Writing concatenation */
-#line 5859 ""
+#line 5849 ""
i__6[0] = 5, a__3[0] = "cresc";
-#line 5859 ""
+#line 5849 ""
*(unsigned char *)&ch__1[0] = idh + 48;
-#line 5859 ""
+#line 5849 ""
i__6[1] = 1, a__3[1] = ch__1;
-#line 5859 ""
+#line 5849 ""
i__6[2] = 5, a__3[2] = "{ }";
-#line 5859 ""
+#line 5849 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
-#line 5860 ""
+#line 5850 ""
ltemp = 11;
-#line 5861 ""
+#line 5851 ""
} else if (idh <= 19) {
/* Writing concatenation */
-#line 5862 ""
+#line 5852 ""
i__6[0] = 7, a__3[0] = "cresc{1";
-#line 5862 ""
+#line 5852 ""
*(unsigned char *)&ch__1[0] = idh + 38;
-#line 5862 ""
+#line 5852 ""
i__6[1] = 1, a__3[1] = ch__1;
-#line 5862 ""
+#line 5852 ""
i__6[2] = 6, a__3[2] = "}{ }";
-#line 5862 ""
+#line 5852 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
-#line 5863 ""
+#line 5853 ""
ltemp = 14;
-#line 5864 ""
+#line 5854 ""
} else {
/* Writing concatenation */
-#line 5865 ""
+#line 5855 ""
i__6[0] = 7, a__3[0] = "cresc{2";
-#line 5865 ""
+#line 5855 ""
*(unsigned char *)&ch__1[0] = idh + 28;
-#line 5865 ""
+#line 5855 ""
i__6[1] = 1, a__3[1] = ch__1;
-#line 5865 ""
+#line 5855 ""
i__6[2] = 6, a__3[2] = "}{ }";
-#line 5865 ""
+#line 5855 ""
s_cat(tempq, a__3, i__6, &c__3, (ftnlen)48);
-#line 5866 ""
+#line 5856 ""
ltemp = 14;
-#line 5867 ""
+#line 5857 ""
}
-#line 5868 ""
+#line 5858 ""
s_wsfe(&io___420);
/* Writing concatenation */
-#line 5868 ""
+#line 5858 ""
i__3[0] = *lsout, a__1[0] = soutq;
-#line 5868 ""
+#line 5858 ""
i__3[1] = 1, a__1[1] = "%";
-#line 5868 ""
+#line 5858 ""
s_cat(ch__3, a__1, i__3, &c__2, (ftnlen)81);
-#line 5868 ""
+#line 5858 ""
do_fio(&c__1, ch__3, *lsout + 1);
-#line 5868 ""
+#line 5858 ""
e_wsfe();
-#line 5869 ""
+#line 5859 ""
*lsout = 0;
/* Writing concatenation */
-#line 5870 ""
+#line 5860 ""
i__3[0] = ltemp - 5, a__1[0] = tempq;
-#line 5870 ""
+#line 5860 ""
i__3[1] = lnumpq, a__1[1] = numpq;
-#line 5870 ""
+#line 5860 ""
s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)53);
-#line 5870 ""
+#line 5860 ""
i__2 = ltemp - 5 + lnumpq;
-#line 5870 ""
+#line 5860 ""
backfill_(&c__11, tempq, &ltemp, ch__4, &i__2, (ftnlen)48, ltemp
- 5 + lnumpq);
-#line 5872 ""
+#line 5862 ""
}
-#line 5873 ""
+#line 5863 ""
/* L3: */
-#line 5873 ""
+#line 5863 ""
}
/* Shrink arrays, decrease ndyn 111109 */
-#line 5877 ""
+#line 5867 ""
for (icntdyn = numdyn; icntdyn >= 1; --icntdyn) {
-#line 5878 ""
+#line 5868 ""
i__1 = comdyn_1.ndyn - 1;
-#line 5878 ""
+#line 5868 ""
for (jdyn = idynn[icntdyn - 1]; jdyn <= i__1; ++jdyn) {
-#line 5879 ""
+#line 5869 ""
comdyn_1.idyndat[jdyn - 1] = comdyn_1.idyndat[jdyn];
-#line 5880 ""
+#line 5870 ""
comdyn_1.idynda2[jdyn - 1] = comdyn_1.idynda2[jdyn];
-#line 5881 ""
+#line 5871 ""
/* L7: */
-#line 5881 ""
+#line 5871 ""
}
-#line 5882 ""
+#line 5872 ""
--comdyn_1.ndyn;
-#line 5883 ""
+#line 5873 ""
/* L6: */
-#line 5883 ""
+#line 5873 ""
}
-#line 5884 ""
+#line 5874 ""
return 0;
} /* dodyn_ */
@@ -14120,1426 +14118,1426 @@ L5:
/* It is only used to find ig. */
/* ig is returned to makeabar in case there's a slur that needs to be ended */
-#line 5923 ""
+#line 5913 ""
/* Parameter adjustments */
-#line 5923 ""
+#line 5913 ""
ulq -= 25;
-#line 5923 ""
+#line 5913 ""
--ptgr;
-#line 5923 ""
+#line 5913 ""
-#line 5923 ""
+#line 5913 ""
/* Function Body */
-#line 5923 ""
+#line 5913 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 5923 ""
+#line 5913 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 5924 ""
+#line 5914 ""
isgaft = bit_test(*ipl,29);
-#line 5925 ""
+#line 5915 ""
iswaft = bit_test(*ipl,31);
-#line 5926 ""
+#line 5916 ""
normsp = ! isgaft;
/* Find ig. */
-#line 5930 ""
+#line 5920 ""
i__1 = comgrace_1.ngrace;
-#line 5930 ""
+#line 5920 ""
for (*ig = 1; *ig <= i__1; ++(*ig)) {
-#line 5931 ""
+#line 5921 ""
if (comgrace_1.ipg[*ig - 1] == *ip && comgrace_1.ivg[*ig - 1] == *ivx)
{
-#line 5931 ""
+#line 5921 ""
goto L121;
-#line 5931 ""
+#line 5921 ""
}
-#line 5932 ""
+#line 5922 ""
/* L120: */
-#line 5932 ""
+#line 5922 ""
}
-#line 5933 ""
+#line 5923 ""
s_wsle(&io___426);
-#line 5933 ""
+#line 5923 ""
do_lio(&c__9, &c__1, "Problem finding grace index in dograce", (ftnlen)38)
;
-#line 5933 ""
+#line 5923 ""
e_wsle();
-#line 5934 ""
+#line 5924 ""
s_stop("", (ftnlen)0);
-#line 5935 ""
+#line 5925 ""
L121:
-#line 5936 ""
+#line 5926 ""
ngs = comgrace_1.ngstrt[*ig - 1];
-#line 5937 ""
+#line 5927 ""
mg = comgrace_1.multg[*ig - 1];
/* wheadpt1 = wheadpt*fullsize(ivx) */
-#line 5939 ""
+#line 5929 ""
wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[*instno - 1];
/* For way-after-graces at end of bar, must set the octave. */
-#line 5943 ""
+#line 5933 ""
if (*farend) {
-#line 5944 ""
+#line 5934 ""
comoct_1.noctup = 0;
-#line 5945 ""
+#line 5935 ""
if (*ncm == 23) {
-#line 5945 ""
+#line 5935 ""
comoct_1.noctup = -2;
-#line 5945 ""
+#line 5935 ""
}
-#line 5946 ""
+#line 5936 ""
}
-#line 5947 ""
+#line 5937 ""
if (comgrace_1.slurg[*ig - 1] && ! iswaft && ! isgaft) {
-#line 5948 ""
+#line 5938 ""
if (comslur_1.listslur == 16777215) {
-#line 5949 ""
+#line 5939 ""
s_wsle(&io___430);
-#line 5949 ""
+#line 5939 ""
e_wsle();
-#line 5950 ""
+#line 5940 ""
s_wsle(&io___431);
-#line 5950 ""
+#line 5940 ""
do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too "\
"many!", (ftnlen)47);
-#line 5950 ""
+#line 5940 ""
e_wsle();
-#line 5951 ""
+#line 5941 ""
s_wsfe(&io___432);
-#line 5951 ""
+#line 5941 ""
do_fio(&c__1, "You defined the twentyfifth slur, one too many!", (
ftnlen)47);
-#line 5951 ""
+#line 5941 ""
e_wsfe();
-#line 5953 ""
+#line 5943 ""
stop1_();
-#line 5954 ""
+#line 5944 ""
}
/* Slur on fore-grace. Get index of next slur not in use, from 23 down. */
-#line 5958 ""
+#line 5948 ""
i__1 = 16777215 - comslur_1.listslur;
-#line 5958 ""
+#line 5948 ""
comslur_1.ndxslur = log2_(&i__1);
-#line 5960 ""
+#line 5950 ""
}
-#line 5961 ""
+#line 5951 ""
if (comgrace_1.nng[*ig - 1] == 1) {
/* Single grace. */
-#line 5965 ""
+#line 5955 ""
if (normsp) {
/* Anything but GA */
/* Writing concatenation */
-#line 5969 ""
+#line 5959 ""
i__2[0] = 1, a__1[0] = sq;
-#line 5969 ""
+#line 5959 ""
i__2[1] = 5, a__1[1] = "shlft";
-#line 5969 ""
+#line 5959 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
-#line 5969 ""
+#line 5959 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
-#line 5970 ""
+#line 5960 ""
niptgr = i_nint(&ptgr[*ig]);
/* Empirical tweak for postscript. */
/* if (.not.fontslur) niptgr = niptgr+nint(wheadpt*.3) */
/* ++ */
-#line 5976 ""
+#line 5966 ""
if (niptgr < 10) {
/* Writing concatenation */
-#line 5977 ""
+#line 5967 ""
i__1 = niptgr + 48;
-#line 5977 ""
+#line 5967 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 5977 ""
+#line 5967 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 5977 ""
+#line 5967 ""
i__2[1] = 1, a__1[1] = "{";
-#line 5977 ""
+#line 5967 ""
s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)2);
-#line 5977 ""
+#line 5967 ""
addstr_(ch__3, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
-#line 5978 ""
+#line 5968 ""
} else if (niptgr < 100) {
-#line 5979 ""
+#line 5969 ""
s_wsfi(&io___435);
-#line 5979 ""
+#line 5969 ""
do_fio(&c__1, (char *)&niptgr, (ftnlen)sizeof(integer));
-#line 5979 ""
+#line 5969 ""
e_wsfi();
/* Writing concatenation */
-#line 5980 ""
+#line 5970 ""
i__3[0] = 1, a__2[0] = "{";
-#line 5980 ""
+#line 5970 ""
i__3[1] = 2, a__2[1] = notexq;
-#line 5980 ""
+#line 5970 ""
i__3[2] = 2, a__2[2] = "}{";
-#line 5980 ""
+#line 5970 ""
s_cat(ch__4, a__2, i__3, &c__3, (ftnlen)5);
-#line 5980 ""
+#line 5970 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
-#line 5981 ""
+#line 5971 ""
} else {
-#line 5982 ""
+#line 5972 ""
s_wsle(&io___436);
-#line 5982 ""
+#line 5972 ""
do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace "\
"note group > 99 pt", (ftnlen)56);
-#line 5982 ""
+#line 5972 ""
e_wsle();
-#line 5984 ""
+#line 5974 ""
s_stop("", (ftnlen)0);
-#line 5985 ""
+#line 5975 ""
}
-#line 5986 ""
+#line 5976 ""
} else {
/* Writing concatenation */
-#line 5987 ""
+#line 5977 ""
i__2[0] = 1, a__1[0] = sq;
-#line 5987 ""
+#line 5977 ""
i__2[1] = 10, a__1[1] = "gaft{1.5}{";
-#line 5987 ""
+#line 5977 ""
s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
-#line 5987 ""
+#line 5977 ""
addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
/* GA. Compute aftshft, for later use. */
-#line 5991 ""
+#line 5981 ""
comgrace_1.aftshft = spfacs_1.grafac;
-#line 5992 ""
+#line 5982 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
-#line 5992 ""
+#line 5982 ""
comgrace_1.aftshft += spfacs_1.agc1fac;
-#line 5992 ""
+#line 5982 ""
}
-#line 5993 ""
+#line 5983 ""
comgrace_1.aftshft *= comask_1.wheadpt;
-#line 5994 ""
+#line 5984 ""
}
-#line 5995 ""
+#line 5985 ""
if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
/* Start slur on pre-grace. No accounting needed since will be ended very soon. */
-#line 5999 ""
+#line 5989 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
-#line 6000 ""
+#line 5990 ""
if (comslur_1.fontslur) {
-#line 6001 ""
+#line 5991 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6002 ""
+#line 5992 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6002 ""
+#line 5992 ""
i__2[1] = 6, a__1[1] = "islurd";
-#line 6002 ""
+#line 5992 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
-#line 6002 ""
+#line 5992 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
-#line 6003 ""
+#line 5993 ""
} else {
/* Writing concatenation */
-#line 6004 ""
+#line 5994 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6004 ""
+#line 5994 ""
i__2[1] = 6, a__1[1] = "isluru";
-#line 6004 ""
+#line 5994 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
-#line 6004 ""
+#line 5994 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
-#line 6005 ""
+#line 5995 ""
}
-#line 6006 ""
+#line 5996 ""
} else {
/* Start Postscript slur. */
-#line 6010 ""
+#line 6000 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6011 ""
+#line 6001 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6011 ""
+#line 6001 ""
i__2[1] = 3, a__1[1] = "isd";
-#line 6011 ""
+#line 6001 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
-#line 6011 ""
+#line 6001 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
-#line 6012 ""
+#line 6002 ""
} else {
/* Writing concatenation */
-#line 6013 ""
+#line 6003 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6013 ""
+#line 6003 ""
i__2[1] = 3, a__1[1] = "isu";
-#line 6013 ""
+#line 6003 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
-#line 6013 ""
+#line 6003 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
-#line 6014 ""
+#line 6004 ""
}
-#line 6015 ""
+#line 6005 ""
}
/* Print slur number, 23-ndxslur */
-#line 6019 ""
+#line 6009 ""
lnote = 0;
-#line 6020 ""
+#line 6010 ""
if (23 - comslur_1.ndxslur < 10) {
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
-#line 6022 ""
+#line 6012 ""
i__1 = 71 - comslur_1.ndxslur;
-#line 6022 ""
+#line 6012 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6022 ""
+#line 6012 ""
s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
-#line 6023 ""
+#line 6013 ""
lnote = 1;
-#line 6024 ""
+#line 6014 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
-#line 6026 ""
+#line 6016 ""
i__3[0] = 2, a__2[0] = "{1";
-#line 6026 ""
+#line 6016 ""
i__1 = 61 - comslur_1.ndxslur;
-#line 6026 ""
+#line 6016 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6026 ""
+#line 6016 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 6026 ""
+#line 6016 ""
i__3[2] = 1, a__2[2] = "}";
-#line 6026 ""
+#line 6016 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 6027 ""
+#line 6017 ""
lnote = 4;
-#line 6028 ""
+#line 6018 ""
} else {
/* Writing concatenation */
-#line 6029 ""
+#line 6019 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 6029 ""
+#line 6019 ""
i__4[1] = 2, a__3[1] = "{2";
-#line 6029 ""
+#line 6019 ""
i__1 = 51 - comslur_1.ndxslur;
-#line 6029 ""
+#line 6019 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6029 ""
+#line 6019 ""
i__4[2] = 1, a__3[2] = ch__1;
-#line 6029 ""
+#line 6019 ""
i__4[3] = 1, a__3[3] = "}";
-#line 6029 ""
+#line 6019 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 6030 ""
+#line 6020 ""
lnote = 4;
-#line 6031 ""
+#line 6021 ""
}
/* Writing concatenation */
-#line 6032 ""
+#line 6022 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 6032 ""
+#line 6022 ""
i__2[1] = lnoten, a__1[1] = noteq;
-#line 6032 ""
+#line 6022 ""
s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
-#line 6032 ""
+#line 6022 ""
i__1 = lnote + lnoten;
-#line 6032 ""
+#line 6022 ""
addstr_(ch__8, &i__1, soutq, lsout, lnote + lnoten, (ftnlen)80);
-#line 6034 ""
+#line 6024 ""
if (! comslur_1.fontslur) {
/* Horizontal tweaks for postscript slur on single grace */
-#line 6038 ""
+#line 6028 ""
stemup = TRUE_;
-#line 6039 ""
+#line 6029 ""
if (comgrace_1.upg[*ig - 1]) {
/* Check for up-grace + down stem. Get stem direction */
-#line 6043 ""
+#line 6033 ""
if (! (*beamon)) {
/* Separate note. Get stem direction. */
-#line 6047 ""
+#line 6037 ""
udqq_(ch__1, (ftnlen)1, nolev, ncmidx, islur, nvmx,
ivx, nv);
-#line 6047 ""
+#line 6037 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
-#line 6049 ""
+#line 6039 ""
} else {
/* In a beam */
-#line 6053 ""
+#line 6043 ""
stemup = *(unsigned char *)&ulq[*ivx + *ibmcnt * 24]
== 'u';
-#line 6054 ""
+#line 6044 ""
}
/* Stop the shift if whole note */
-#line 6058 ""
+#line 6048 ""
stemup = stemup || *tnote > 63.f;
-#line 6059 ""
+#line 6049 ""
}
-#line 6060 ""
+#line 6050 ""
if (stemup) {
-#line 6061 ""
+#line 6051 ""
addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
80);
-#line 6062 ""
+#line 6052 ""
} else {
-#line 6063 ""
+#line 6053 ""
addstr_("{-.8}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)
80);
-#line 6064 ""
+#line 6054 ""
}
-#line 6065 ""
+#line 6055 ""
}
-#line 6066 ""
+#line 6056 ""
}
-#line 6067 ""
+#line 6057 ""
if (comgrace_1.naccg[ngs - 1] > 0) {
-#line 6068 ""
+#line 6058 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Save for checking octave shifts in GA */
-#line 6072 ""
+#line 6062 ""
if (isgaft) {
-#line 6073 ""
+#line 6063 ""
lnotenga = lnoten;
-#line 6074 ""
+#line 6064 ""
s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
-#line 6075 ""
+#line 6065 ""
}
-#line 6077 ""
+#line 6067 ""
if (lnoten == 1) {
-#line 6077 ""
+#line 6067 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 6077 ""
+#line 6067 ""
}
-#line 6078 ""
+#line 6068 ""
accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
-#line 6079 ""
+#line 6069 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6079 ""
+#line 6069 ""
i__4[1] = 3, a__3[1] = "big";
-#line 6079 ""
+#line 6069 ""
i__4[2] = lacc, a__3[2] = acsymq;
-#line 6079 ""
+#line 6069 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6079 ""
+#line 6069 ""
s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
-#line 6079 ""
+#line 6069 ""
i__1 = lacc + 4 + lnoten;
-#line 6079 ""
+#line 6069 ""
addstr_(ch__9, &i__1, soutq, lsout, lacc + 4 + lnoten, (ftnlen)80)
;
-#line 6081 ""
+#line 6071 ""
}
-#line 6082 ""
+#line 6072 ""
if (comgrace_1.slashg[*ig - 1]) {
/* Writing concatenation */
-#line 6083 ""
+#line 6073 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6083 ""
+#line 6073 ""
i__2[1] = 3, a__1[1] = "grc";
-#line 6083 ""
+#line 6073 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6084 ""
+#line 6074 ""
lnote = 4;
-#line 6085 ""
+#line 6075 ""
} else if (mg == 0) {
/* Writing concatenation */
-#line 6086 ""
+#line 6076 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6086 ""
+#line 6076 ""
i__2[1] = 2, a__1[1] = "zq";
-#line 6086 ""
+#line 6076 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6087 ""
+#line 6077 ""
lnote = 3;
-#line 6088 ""
+#line 6078 ""
} else {
/* Writing concatenation */
-#line 6089 ""
+#line 6079 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6089 ""
+#line 6079 ""
i__2[1] = 2, a__1[1] = "zc";
-#line 6089 ""
+#line 6079 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6090 ""
+#line 6080 ""
i__1 = mg;
-#line 6090 ""
+#line 6080 ""
for (i__ = 2; i__ <= i__1; ++i__) {
/* Writing concatenation */
-#line 6091 ""
+#line 6081 ""
i__2[0] = i__ + 1, a__1[0] = notexq;
-#line 6091 ""
+#line 6081 ""
i__2[1] = 1, a__1[1] = "c";
-#line 6091 ""
+#line 6081 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6092 ""
+#line 6082 ""
/* L61: */
-#line 6092 ""
+#line 6082 ""
}
-#line 6093 ""
+#line 6083 ""
lnote = mg + 2;
-#line 6094 ""
+#line 6084 ""
}
-#line 6095 ""
+#line 6085 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6096 ""
+#line 6086 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 6096 ""
+#line 6086 ""
i__2[1] = 1, a__1[1] = "u";
-#line 6096 ""
+#line 6086 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6097 ""
+#line 6087 ""
} else {
/* Writing concatenation */
-#line 6098 ""
+#line 6088 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 6098 ""
+#line 6088 ""
i__2[1] = 1, a__1[1] = "l";
-#line 6098 ""
+#line 6088 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6099 ""
+#line 6089 ""
}
-#line 6100 ""
+#line 6090 ""
i__1 = lnote + 1;
-#line 6100 ""
+#line 6090 ""
addstr_(notexq, &i__1, soutq, lsout, (ftnlen)79, (ftnlen)80);
-#line 6101 ""
+#line 6091 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
-#line 6103 ""
+#line 6093 ""
if (isgaft && comgrace_1.naccg[ngs - 1] == 0) {
-#line 6104 ""
+#line 6094 ""
lnotenga = lnoten;
-#line 6105 ""
+#line 6095 ""
s_copy(noteqga, noteq, (ftnlen)8, (ftnlen)8);
-#line 6106 ""
+#line 6096 ""
}
-#line 6108 ""
+#line 6098 ""
if (lnoten == 1) {
-#line 6108 ""
+#line 6098 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 6108 ""
+#line 6098 ""
}
-#line 6109 ""
+#line 6099 ""
addstr_(noteq, &lnoten, soutq, lsout, (ftnlen)8, (ftnlen)80);
-#line 6110 ""
+#line 6100 ""
if (comgrace_1.slashg[*ig - 1]) {
/* Writing concatenation */
-#line 6110 ""
+#line 6100 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6110 ""
+#line 6100 ""
i__4[1] = 5, a__3[1] = "off{-";
-#line 6110 ""
+#line 6100 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6110 ""
+#line 6100 ""
i__4[3] = 9, a__3[3] = "noteskip}";
-#line 6110 ""
+#line 6100 ""
s_cat(ch__10, a__3, i__4, &c__4, (ftnlen)16);
-#line 6110 ""
+#line 6100 ""
addstr_(ch__10, &c__16, soutq, lsout, (ftnlen)16, (ftnlen)80);
-#line 6110 ""
+#line 6100 ""
}
/* Above code needed since slashg causes spacing */
-#line 6115 ""
+#line 6105 ""
if (comgrace_1.slurg[*ig - 1] && (iswaft || isgaft)) {
/* Terminate slur on single after-grace */
-#line 6119 ""
+#line 6109 ""
comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
-#line 6120 ""
+#line 6110 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
-#line 6121 ""
+#line 6111 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6121 ""
+#line 6111 ""
i__2[1] = 5, a__1[1] = "tslur";
-#line 6121 ""
+#line 6111 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
-#line 6121 ""
+#line 6111 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80);
/* Print 24-ndxslur */
/* if (11-ndxslur .lt. 10) then */
-#line 6126 ""
+#line 6116 ""
if (23 - comslur_1.ndxslur < 10) {
/* call addstr(chax(59-ndxslur)//noteq(1:lnoten), */
/* Writing concatenation */
-#line 6128 ""
+#line 6118 ""
i__1 = 71 - comslur_1.ndxslur;
-#line 6128 ""
+#line 6118 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6128 ""
+#line 6118 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 6128 ""
+#line 6118 ""
i__2[1] = lnoten, a__1[1] = noteq;
-#line 6128 ""
+#line 6118 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
-#line 6128 ""
+#line 6118 ""
i__5 = lnoten + 1;
-#line 6128 ""
+#line 6118 ""
addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
-#line 6130 ""
+#line 6120 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 6131 ""
+#line 6121 ""
i__4[0] = 2, a__3[0] = "{2";
-#line 6131 ""
+#line 6121 ""
i__1 = 61 - comslur_1.ndxslur;
-#line 6131 ""
+#line 6121 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6131 ""
+#line 6121 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6131 ""
+#line 6121 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6131 ""
+#line 6121 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6131 ""
+#line 6121 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6131 ""
+#line 6121 ""
i__5 = lnoten + 4;
-#line 6131 ""
+#line 6121 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
-#line 6133 ""
+#line 6123 ""
} else {
/* call addstr('{1'//chax(49-ndxslur)//'}'//noteq(1:lnoten), */
/* Writing concatenation */
-#line 6135 ""
+#line 6125 ""
i__4[0] = 2, a__3[0] = "{1";
-#line 6135 ""
+#line 6125 ""
i__1 = 51 - comslur_1.ndxslur;
-#line 6135 ""
+#line 6125 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6135 ""
+#line 6125 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6135 ""
+#line 6125 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6135 ""
+#line 6125 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6135 ""
+#line 6125 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6135 ""
+#line 6125 ""
i__5 = lnoten + 4;
-#line 6135 ""
+#line 6125 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
-#line 6137 ""
+#line 6127 ""
}
-#line 6138 ""
+#line 6128 ""
comgrace_1.slurg[*ig - 1] = FALSE_;
-#line 6139 ""
+#line 6129 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
-#line 6140 ""
+#line 6130 ""
}
-#line 6141 ""
+#line 6131 ""
addstr_("}", &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
/* +++ Try to fix loss of octave with single gaft */
-#line 6145 ""
+#line 6135 ""
if (isgaft) {
-#line 6146 ""
+#line 6136 ""
itrans = 0;
-#line 6147 ""
+#line 6137 ""
i__1 = lnotenga;
-#line 6147 ""
+#line 6137 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 6148 ""
+#line 6138 ""
chax_(ch__1, (ftnlen)1, &c__39);
-#line 6148 ""
+#line 6138 ""
if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned char *)&
ch__1[0]) {
-#line 6149 ""
+#line 6139 ""
itrans += 7;
-#line 6150 ""
+#line 6140 ""
} else /* if(complicated condition) */ {
-#line 6150 ""
+#line 6140 ""
chax_(ch__1, (ftnlen)1, &c__96);
-#line 6150 ""
+#line 6140 ""
if (*(unsigned char *)&noteqga[i__ - 1] == *(unsigned
char *)&ch__1[0]) {
-#line 6151 ""
+#line 6141 ""
itrans += -7;
-#line 6152 ""
+#line 6142 ""
}
-#line 6152 ""
+#line 6142 ""
}
-#line 6153 ""
+#line 6143 ""
/* L1: */
-#line 6153 ""
+#line 6143 ""
}
-#line 6154 ""
+#line 6144 ""
if (itrans == -14) {
/* Writing concatenation */
-#line 6155 ""
+#line 6145 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6155 ""
+#line 6145 ""
i__4[1] = 7, a__3[1] = "advance";
-#line 6155 ""
+#line 6145 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6155 ""
+#line 6145 ""
i__4[3] = 12, a__3[3] = "transpose-14";
-#line 6155 ""
+#line 6145 ""
s_cat(ch__13, a__3, i__4, &c__4, (ftnlen)21);
-#line 6155 ""
+#line 6145 ""
addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
-#line 6157 ""
+#line 6147 ""
} else if (itrans == -7) {
/* Writing concatenation */
-#line 6158 ""
+#line 6148 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6158 ""
+#line 6148 ""
i__4[1] = 7, a__3[1] = "advance";
-#line 6158 ""
+#line 6148 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6158 ""
+#line 6148 ""
i__4[3] = 11, a__3[3] = "transpose-7";
-#line 6158 ""
+#line 6148 ""
s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
-#line 6158 ""
+#line 6148 ""
addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
-#line 6160 ""
+#line 6150 ""
} else if (itrans == 7) {
/* Writing concatenation */
-#line 6161 ""
+#line 6151 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6161 ""
+#line 6151 ""
i__4[1] = 7, a__3[1] = "advance";
-#line 6161 ""
+#line 6151 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6161 ""
+#line 6151 ""
i__4[3] = 10, a__3[3] = "transpose7";
-#line 6161 ""
+#line 6151 ""
s_cat(ch__15, a__3, i__4, &c__4, (ftnlen)19);
-#line 6161 ""
+#line 6151 ""
addstr_(ch__15, &c__19, soutq, lsout, (ftnlen)19, (ftnlen)80);
-#line 6163 ""
+#line 6153 ""
} else if (itrans == 14) {
/* Writing concatenation */
-#line 6164 ""
+#line 6154 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6164 ""
+#line 6154 ""
i__4[1] = 7, a__3[1] = "advance";
-#line 6164 ""
+#line 6154 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6164 ""
+#line 6154 ""
i__4[3] = 11, a__3[3] = "transpose14";
-#line 6164 ""
+#line 6154 ""
s_cat(ch__14, a__3, i__4, &c__4, (ftnlen)20);
-#line 6164 ""
+#line 6154 ""
addstr_(ch__14, &c__20, soutq, lsout, (ftnlen)20, (ftnlen)80);
-#line 6166 ""
+#line 6156 ""
}
-#line 6167 ""
+#line 6157 ""
}
-#line 6168 ""
+#line 6158 ""
} else {
/* Multiple grace. Put in literally. Compute beam stuff */
-#line 6172 ""
+#line 6162 ""
sumx = 0.f;
-#line 6173 ""
+#line 6163 ""
sumy = 0.f;
-#line 6174 ""
+#line 6164 ""
sumxy = 0.f;
-#line 6175 ""
+#line 6165 ""
sumxx = 0.f;
-#line 6176 ""
+#line 6166 ""
sumyy = 0.f;
-#line 6177 ""
+#line 6167 ""
x = 0.f;
-#line 6178 ""
+#line 6168 ""
i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
-#line 6178 ""
+#line 6168 ""
for (ing = ngs; ing <= i__1; ++ing) {
-#line 6179 ""
+#line 6169 ""
if (ing > ngs && comgrace_1.naccg[ing - 1] > 0) {
-#line 6179 ""
+#line 6169 ""
x += spfacs_1.acgfac;
-#line 6179 ""
+#line 6169 ""
}
-#line 6180 ""
+#line 6170 ""
y = (real) comgrace_1.nolevg[ing - 1];
-#line 6181 ""
+#line 6171 ""
sumx += x;
-#line 6182 ""
+#line 6172 ""
sumy += y;
-#line 6183 ""
+#line 6173 ""
sumxy += x * y;
-#line 6184 ""
+#line 6174 ""
sumxx += x * x;
-#line 6185 ""
+#line 6175 ""
sumyy += y * y;
-#line 6186 ""
+#line 6176 ""
x += spfacs_1.emgfac;
-#line 6187 ""
+#line 6177 ""
/* L118: */
-#line 6187 ""
+#line 6177 ""
}
-#line 6188 ""
+#line 6178 ""
delta = comgrace_1.nng[*ig - 1] * sumxx - sumx * sumx;
-#line 6189 ""
+#line 6179 ""
em = (comgrace_1.nng[*ig - 1] * sumxy - sumx * sumy) / delta;
-#line 6190 ""
+#line 6180 ""
r__1 = em * .5f * spfacs_1.gslfac;
-#line 6190 ""
+#line 6180 ""
islope = i_nint(&r__1);
-#line 6191 ""
+#line 6181 ""
if (abs(islope) > 9) {
-#line 6191 ""
+#line 6181 ""
islope = i_sign(&c__9, &islope);
-#line 6191 ""
+#line 6181 ""
}
-#line 6192 ""
+#line 6182 ""
beta = (sumy - islope / spfacs_1.gslfac * sumx) / comgrace_1.nng[*ig
- 1];
-#line 6193 ""
+#line 6183 ""
nolev1 = i_nint(&beta);
/* Back up */
/* Writing concatenation */
-#line 6197 ""
+#line 6187 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6197 ""
+#line 6187 ""
i__4[1] = 7, a__3[1] = "settiny";
-#line 6197 ""
+#line 6187 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6197 ""
+#line 6187 ""
i__4[3] = 4, a__3[3] = "off{";
-#line 6197 ""
+#line 6187 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 6198 ""
+#line 6188 ""
if (normsp) {
-#line 6199 ""
+#line 6189 ""
s_wsfi(&io___460);
-#line 6199 ""
+#line 6189 ""
do_fio(&c__1, "-", (ftnlen)1);
-#line 6199 ""
+#line 6189 ""
do_fio(&c__1, (char *)&ptgr[*ig], (ftnlen)sizeof(real));
-#line 6199 ""
+#line 6189 ""
e_wsfi();
/* Writing concatenation */
-#line 6200 ""
+#line 6190 ""
i__2[0] = 18, a__1[0] = notexq;
-#line 6200 ""
+#line 6190 ""
i__2[1] = 3, a__1[1] = "pt}";
-#line 6200 ""
+#line 6190 ""
s_cat(ch__13, a__1, i__2, &c__2, (ftnlen)21);
-#line 6200 ""
+#line 6190 ""
addstr_(ch__13, &c__21, soutq, lsout, (ftnlen)21, (ftnlen)80);
-#line 6201 ""
+#line 6191 ""
finalshift = ptgr[*ig];
-#line 6202 ""
+#line 6192 ""
} else {
-#line 6203 ""
+#line 6193 ""
comgrace_1.aftshft = comask_1.wheadpt * 1.33f;
-#line 6204 ""
+#line 6194 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[*ig - 1] - 1] > 0) {
-#line 6204 ""
+#line 6194 ""
comgrace_1.aftshft += comask_1.wheadpt * .5f;
-#line 6204 ""
+#line 6194 ""
}
-#line 6205 ""
+#line 6195 ""
s_wsfi(&io___462);
-#line 6205 ""
+#line 6195 ""
do_fio(&c__1, (char *)&comgrace_1.aftshft, (ftnlen)sizeof(real));
-#line 6205 ""
+#line 6195 ""
e_wsfi();
/* Writing concatenation */
-#line 6206 ""
+#line 6196 ""
i__4[0] = 17, a__3[0] = notexq;
-#line 6206 ""
+#line 6196 ""
i__4[1] = 3, a__3[1] = "pt}";
-#line 6206 ""
+#line 6196 ""
i__4[2] = 1, a__3[2] = sq;
-#line 6206 ""
+#line 6196 ""
i__4[3] = 3, a__3[3] = "bsk";
-#line 6206 ""
+#line 6196 ""
s_cat(ch__16, a__3, i__4, &c__4, (ftnlen)24);
-#line 6206 ""
+#line 6196 ""
addstr_(ch__16, &c__24, soutq, lsout, (ftnlen)24, (ftnlen)80);
-#line 6207 ""
+#line 6197 ""
}
/* Start the beam */
/* Writing concatenation */
-#line 6211 ""
+#line 6201 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6211 ""
+#line 6201 ""
i__2[1] = 2, a__1[1] = "ib";
-#line 6211 ""
+#line 6201 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6212 ""
+#line 6202 ""
i__1 = mg;
-#line 6212 ""
+#line 6202 ""
for (ing = 2; ing <= i__1; ++ing) {
/* Writing concatenation */
-#line 6213 ""
+#line 6203 ""
i__2[0] = ing + 1, a__1[0] = notexq;
-#line 6213 ""
+#line 6203 ""
i__2[1] = 1, a__1[1] = "b";
-#line 6213 ""
+#line 6203 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6214 ""
+#line 6204 ""
/* L119: */
-#line 6214 ""
+#line 6204 ""
}
-#line 6215 ""
+#line 6205 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6216 ""
+#line 6206 ""
i__2[0] = mg + 2, a__1[0] = notexq;
-#line 6216 ""
+#line 6206 ""
i__2[1] = 1, a__1[1] = "u";
-#line 6216 ""
+#line 6206 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6217 ""
+#line 6207 ""
} else {
/* Writing concatenation */
-#line 6218 ""
+#line 6208 ""
i__2[0] = mg + 2, a__1[0] = notexq;
-#line 6218 ""
+#line 6208 ""
i__2[1] = 1, a__1[1] = "l";
-#line 6218 ""
+#line 6208 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6219 ""
+#line 6209 ""
}
/* Writing concatenation */
-#line 6220 ""
+#line 6210 ""
i__2[0] = mg + 3, a__1[0] = notexq;
-#line 6220 ""
+#line 6210 ""
i__2[1] = 1, a__1[1] = "0";
-#line 6220 ""
+#line 6210 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
/* Get starting note for beam */
-#line 6224 ""
+#line 6214 ""
notefq_(noteq, &lnoten, &nolev1, ncm, (ftnlen)8);
/* Writing concatenation */
-#line 6225 ""
+#line 6215 ""
i__2[0] = mg + 4, a__1[0] = notexq;
-#line 6225 ""
+#line 6215 ""
i__2[1] = lnoten, a__1[1] = noteq;
-#line 6225 ""
+#line 6215 ""
s_cat(ch__8, a__1, i__2, &c__2, (ftnlen)87);
-#line 6225 ""
+#line 6215 ""
i__1 = mg + 4 + lnoten;
-#line 6225 ""
+#line 6215 ""
addstr_(ch__8, &i__1, soutq, lsout, mg + 4 + lnoten, (ftnlen)80);
/* Put in the slope */
-#line 6230 ""
+#line 6220 ""
if (islope >= 0) {
-#line 6231 ""
+#line 6221 ""
i__1 = islope + 48;
-#line 6231 ""
+#line 6221 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6231 ""
+#line 6221 ""
addstr_(ch__1, &c__1, soutq, lsout, (ftnlen)1, (ftnlen)80);
-#line 6232 ""
+#line 6222 ""
} else {
/* Writing concatenation */
-#line 6233 ""
+#line 6223 ""
i__3[0] = 2, a__2[0] = "{-";
-#line 6233 ""
+#line 6223 ""
i__1 = 48 - islope;
-#line 6233 ""
+#line 6223 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6233 ""
+#line 6223 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 6233 ""
+#line 6223 ""
i__3[2] = 1, a__2[2] = "}";
-#line 6233 ""
+#line 6223 ""
s_cat(ch__7, a__2, i__3, &c__3, (ftnlen)4);
-#line 6233 ""
+#line 6223 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80);
-#line 6234 ""
+#line 6224 ""
}
/* Start a slur on multiple fore-grace */
-#line 6238 ""
+#line 6228 ""
if (comgrace_1.slurg[*ig - 1] && ! isgaft && ! iswaft) {
-#line 6239 ""
+#line 6229 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
-#line 6240 ""
+#line 6230 ""
if (comslur_1.fontslur) {
-#line 6241 ""
+#line 6231 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6242 ""
+#line 6232 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6242 ""
+#line 6232 ""
i__2[1] = 6, a__1[1] = "islurd";
-#line 6242 ""
+#line 6232 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
-#line 6242 ""
+#line 6232 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
-#line 6243 ""
+#line 6233 ""
} else {
/* Writing concatenation */
-#line 6244 ""
+#line 6234 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6244 ""
+#line 6234 ""
i__2[1] = 6, a__1[1] = "isluru";
-#line 6244 ""
+#line 6234 ""
s_cat(ch__6, a__1, i__2, &c__2, (ftnlen)7);
-#line 6244 ""
+#line 6234 ""
addstr_(ch__6, &c__7, soutq, lsout, (ftnlen)7, (ftnlen)80)
;
-#line 6245 ""
+#line 6235 ""
}
-#line 6246 ""
+#line 6236 ""
} else {
/* Need a tweak for postscript slur */
-#line 6250 ""
+#line 6240 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6251 ""
+#line 6241 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6251 ""
+#line 6241 ""
i__2[1] = 3, a__1[1] = "isd";
-#line 6251 ""
+#line 6241 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
-#line 6251 ""
+#line 6241 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
-#line 6252 ""
+#line 6242 ""
} else {
/* Writing concatenation */
-#line 6253 ""
+#line 6243 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6253 ""
+#line 6243 ""
i__2[1] = 3, a__1[1] = "isu";
-#line 6253 ""
+#line 6243 ""
s_cat(ch__7, a__1, i__2, &c__2, (ftnlen)4);
-#line 6253 ""
+#line 6243 ""
addstr_(ch__7, &c__4, soutq, lsout, (ftnlen)4, (ftnlen)80)
;
-#line 6254 ""
+#line 6244 ""
}
-#line 6255 ""
+#line 6245 ""
}
/* Print 23-ndxslur */
-#line 6259 ""
+#line 6249 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
-#line 6260 ""
+#line 6250 ""
i__1 = 71 - comslur_1.ndxslur;
-#line 6260 ""
+#line 6250 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6260 ""
+#line 6250 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 6260 ""
+#line 6250 ""
i__2[1] = lnoten, a__1[1] = noteq;
-#line 6260 ""
+#line 6250 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
-#line 6260 ""
+#line 6250 ""
i__5 = lnoten + 1;
-#line 6260 ""
+#line 6250 ""
addstr_(ch__11, &i__5, soutq, lsout, lnoten + 1, (ftnlen)80);
-#line 6262 ""
+#line 6252 ""
} else if (23 - comslur_1.ndxslur < 2) {
/* Writing concatenation */
-#line 6263 ""
+#line 6253 ""
i__4[0] = 2, a__3[0] = "{1";
-#line 6263 ""
+#line 6253 ""
i__1 = 61 - comslur_1.ndxslur;
-#line 6263 ""
+#line 6253 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6263 ""
+#line 6253 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6263 ""
+#line 6253 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6263 ""
+#line 6253 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6263 ""
+#line 6253 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6263 ""
+#line 6253 ""
i__5 = lnoten + 4;
-#line 6263 ""
+#line 6253 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
-#line 6265 ""
+#line 6255 ""
} else {
/* Writing concatenation */
-#line 6266 ""
+#line 6256 ""
i__4[0] = 2, a__3[0] = "{1";
-#line 6266 ""
+#line 6256 ""
i__1 = 51 - comslur_1.ndxslur;
-#line 6266 ""
+#line 6256 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 6266 ""
+#line 6256 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6266 ""
+#line 6256 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6266 ""
+#line 6256 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6266 ""
+#line 6256 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6266 ""
+#line 6256 ""
i__5 = lnoten + 4;
-#line 6266 ""
+#line 6256 ""
addstr_(ch__12, &i__5, soutq, lsout, lnoten + 4, (ftnlen)80);
-#line 6268 ""
+#line 6258 ""
}
/* Put in tweak for postscript slur */
-#line 6272 ""
+#line 6262 ""
if (! comslur_1.fontslur) {
-#line 6272 ""
+#line 6262 ""
addstr_("{-.3}", &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80);
-#line 6272 ""
+#line 6262 ""
}
-#line 6273 ""
+#line 6263 ""
}
/* Put in first note. Call notefq again in case octave changed */
-#line 6277 ""
+#line 6267 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)8);
-#line 6278 ""
+#line 6268 ""
if (comgrace_1.naccg[ngs - 1] == 0) {
/* Writing concatenation */
-#line 6279 ""
+#line 6269 ""
i__3[0] = 1, a__2[0] = sq;
-#line 6279 ""
+#line 6269 ""
i__3[1] = 4, a__2[1] = "zqb0";
-#line 6279 ""
+#line 6269 ""
i__3[2] = lnoten, a__2[2] = noteq;
-#line 6279 ""
+#line 6269 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 6280 ""
+#line 6270 ""
lnote = lnoten + 5;
-#line 6281 ""
+#line 6271 ""
} else {
-#line 6282 ""
+#line 6272 ""
if (lnoten == 1) {
-#line 6282 ""
+#line 6272 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 6282 ""
+#line 6272 ""
}
-#line 6283 ""
+#line 6273 ""
accsym_(&comgrace_1.naccg[ngs - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
-#line 6284 ""
+#line 6274 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6284 ""
+#line 6274 ""
i__4[1] = 3, a__3[1] = "big";
-#line 6284 ""
+#line 6274 ""
i__4[2] = lacc, a__3[2] = acsymq;
-#line 6284 ""
+#line 6274 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6284 ""
+#line 6274 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 6285 ""
+#line 6275 ""
lnote = lacc + 4 + lnoten;
-#line 6286 ""
+#line 6276 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ngs - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
-#line 6287 ""
+#line 6277 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 6287 ""
+#line 6277 ""
i__4[1] = 1, a__3[1] = sq;
-#line 6287 ""
+#line 6277 ""
i__4[2] = 4, a__3[2] = "zqb0";
-#line 6287 ""
+#line 6277 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6287 ""
+#line 6277 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 6288 ""
+#line 6278 ""
lnote = lnote + 5 + lnoten;
-#line 6289 ""
+#line 6279 ""
}
-#line 6290 ""
+#line 6280 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
-#line 6291 ""
+#line 6281 ""
i__1 = ngs + comgrace_1.nng[*ig - 1] - 1;
-#line 6291 ""
+#line 6281 ""
for (ing = ngs + 1; ing <= i__1; ++ing) {
/* Skip */
-#line 6295 ""
+#line 6285 ""
ptoff = wheadpt1 * spfacs_1.emgfac;
-#line 6296 ""
+#line 6286 ""
if (comgrace_1.naccg[ing - 1] > 0) {
-#line 6296 ""
+#line 6286 ""
ptoff += wheadpt1 * spfacs_1.acgfac;
-#line 6296 ""
+#line 6286 ""
}
-#line 6297 ""
+#line 6287 ""
if (isgaft && ! iswaft) {
-#line 6297 ""
+#line 6287 ""
comgrace_1.aftshft += ptoff;
-#line 6297 ""
+#line 6287 ""
}
/* Writing concatenation */
-#line 6298 ""
+#line 6288 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6298 ""
+#line 6288 ""
i__2[1] = 4, a__1[1] = "off{";
-#line 6298 ""
+#line 6288 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6299 ""
+#line 6289 ""
s_wsfi(&io___464);
-#line 6299 ""
+#line 6289 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
-#line 6299 ""
+#line 6289 ""
e_wsfi();
-#line 6300 ""
+#line 6290 ""
if (normsp) {
-#line 6300 ""
+#line 6290 ""
finalshift -= ptoff;
-#line 6300 ""
+#line 6290 ""
}
/* Writing concatenation */
-#line 6301 ""
+#line 6291 ""
i__2[0] = 8, a__1[0] = notexq;
-#line 6301 ""
+#line 6291 ""
i__2[1] = 3, a__1[1] = "pt}";
-#line 6301 ""
+#line 6291 ""
s_cat(ch__5, a__1, i__2, &c__2, (ftnlen)11);
-#line 6301 ""
+#line 6291 ""
addstr_(ch__5, &c__11, soutq, lsout, (ftnlen)11, (ftnlen)80);
-#line 6302 ""
+#line 6292 ""
if (ing == ngs + comgrace_1.nng[*ig - 1] - 1) {
/* Terminate beam if needed */
-#line 6306 ""
+#line 6296 ""
if (comgrace_1.upg[*ig - 1]) {
/* Writing concatenation */
-#line 6307 ""
+#line 6297 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6307 ""
+#line 6297 ""
i__2[1] = 4, a__1[1] = "tbu0";
-#line 6307 ""
+#line 6297 ""
s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
-#line 6307 ""
+#line 6297 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
;
-#line 6308 ""
+#line 6298 ""
} else {
/* Writing concatenation */
-#line 6309 ""
+#line 6299 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6309 ""
+#line 6299 ""
i__2[1] = 4, a__1[1] = "tbl0";
-#line 6309 ""
+#line 6299 ""
s_cat(ch__4, a__1, i__2, &c__2, (ftnlen)5);
-#line 6309 ""
+#line 6299 ""
addstr_(ch__4, &c__5, soutq, lsout, (ftnlen)5, (ftnlen)80)
;
-#line 6310 ""
+#line 6300 ""
}
/* Terminate after slur if needed */
-#line 6314 ""
+#line 6304 ""
if ((isgaft || iswaft) && comgrace_1.slurg[*ig - 1]) {
/* if (iswaft) ndxslur = igetbits(ipl,4,23) */
-#line 6316 ""
+#line 6306 ""
if (iswaft) {
-#line 6316 ""
+#line 6306 ""
comslur_1.ndxslur = igetbits_(ipl, &c__5, &c__23);
-#line 6316 ""
+#line 6306 ""
}
-#line 6317 ""
+#line 6307 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm,
(ftnlen)8);
/* Writing concatenation */
-#line 6318 ""
+#line 6308 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6318 ""
+#line 6308 ""
i__2[1] = 5, a__1[1] = "tslur";
-#line 6318 ""
+#line 6308 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)6);
-#line 6318 ""
+#line 6308 ""
addstr_(ch__2, &c__6, soutq, lsout, (ftnlen)6, (ftnlen)80)
;
/* Print 11-ndxslur */
/* c Print 23-ndxslur */
-#line 6323 ""
+#line 6313 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
-#line 6324 ""
+#line 6314 ""
i__5 = 71 - comslur_1.ndxslur;
-#line 6324 ""
+#line 6314 ""
chax_(ch__1, (ftnlen)1, &i__5);
-#line 6324 ""
+#line 6314 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 6324 ""
+#line 6314 ""
i__2[1] = lnoten, a__1[1] = noteq;
-#line 6324 ""
+#line 6314 ""
s_cat(ch__11, a__1, i__2, &c__2, (ftnlen)9);
-#line 6324 ""
+#line 6314 ""
i__6 = lnoten + 1;
-#line 6324 ""
+#line 6314 ""
addstr_(ch__11, &i__6, soutq, lsout, lnoten + 1, (
ftnlen)80);
-#line 6326 ""
+#line 6316 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 6327 ""
+#line 6317 ""
i__4[0] = 2, a__3[0] = "{2";
-#line 6327 ""
+#line 6317 ""
i__5 = 61 - comslur_1.ndxslur;
-#line 6327 ""
+#line 6317 ""
chax_(ch__1, (ftnlen)1, &i__5);
-#line 6327 ""
+#line 6317 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6327 ""
+#line 6317 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6327 ""
+#line 6317 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6327 ""
+#line 6317 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6327 ""
+#line 6317 ""
i__6 = lnoten + 4;
-#line 6327 ""
+#line 6317 ""
addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
ftnlen)80);
-#line 6329 ""
+#line 6319 ""
} else {
/* Writing concatenation */
-#line 6330 ""
+#line 6320 ""
i__4[0] = 2, a__3[0] = "{1";
-#line 6330 ""
+#line 6320 ""
i__5 = 51 - comslur_1.ndxslur;
-#line 6330 ""
+#line 6320 ""
chax_(ch__1, (ftnlen)1, &i__5);
-#line 6330 ""
+#line 6320 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 6330 ""
+#line 6320 ""
i__4[2] = 1, a__3[2] = "}";
-#line 6330 ""
+#line 6320 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6330 ""
+#line 6320 ""
s_cat(ch__12, a__3, i__4, &c__4, (ftnlen)12);
-#line 6330 ""
+#line 6320 ""
i__6 = lnoten + 4;
-#line 6330 ""
+#line 6320 ""
addstr_(ch__12, &i__6, soutq, lsout, lnoten + 4, (
ftnlen)80);
-#line 6332 ""
+#line 6322 ""
}
/* Stop slur terminator after exit from this subroutine */
-#line 6336 ""
+#line 6326 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
-#line 6337 ""
+#line 6327 ""
comgrace_1.slurg[*ig - 1] = FALSE_;
-#line 6338 ""
+#line 6328 ""
}
-#line 6339 ""
+#line 6329 ""
}
/* Accidental if needed */
-#line 6343 ""
+#line 6333 ""
if (comgrace_1.naccg[ing - 1] > 0) {
-#line 6344 ""
+#line 6334 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (
ftnlen)8);
-#line 6345 ""
+#line 6335 ""
if (lnoten == 1) {
-#line 6345 ""
+#line 6335 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 6345 ""
+#line 6335 ""
}
-#line 6346 ""
+#line 6336 ""
accsym_(&comgrace_1.naccg[ing - 1], acsymq, &lacc, (ftnlen)3);
/* Writing concatenation */
-#line 6347 ""
+#line 6337 ""
i__4[0] = 1, a__3[0] = sq;
-#line 6347 ""
+#line 6337 ""
i__4[1] = 3, a__3[1] = "big";
-#line 6347 ""
+#line 6337 ""
i__4[2] = lacc, a__3[2] = acsymq;
-#line 6347 ""
+#line 6337 ""
i__4[3] = lnoten, a__3[3] = noteq;
-#line 6347 ""
+#line 6337 ""
s_cat(ch__9, a__3, i__4, &c__4, (ftnlen)15);
-#line 6347 ""
+#line 6337 ""
i__5 = lacc + 4 + lnoten;
-#line 6347 ""
+#line 6337 ""
addstr_(ch__9, &i__5, soutq, lsout, lacc + 4 + lnoten, (
ftnlen)80);
-#line 6349 ""
+#line 6339 ""
}
/* Put in the (beamed) grace note */
-#line 6353 ""
+#line 6343 ""
notefq_(noteq, &lnoten, &comgrace_1.nolevg[ing - 1], ncm, (ftnlen)
8);
/* Writing concatenation */
-#line 6354 ""
+#line 6344 ""
i__3[0] = 1, a__2[0] = sq;
-#line 6354 ""
+#line 6344 ""
i__3[1] = 4, a__2[1] = "zqb0";
-#line 6354 ""
+#line 6344 ""
i__3[2] = lnoten, a__2[2] = noteq;
-#line 6354 ""
+#line 6344 ""
s_cat(ch__17, a__2, i__3, &c__3, (ftnlen)13);
-#line 6354 ""
+#line 6344 ""
i__5 = lnoten + 5;
-#line 6354 ""
+#line 6344 ""
addstr_(ch__17, &i__5, soutq, lsout, lnoten + 5, (ftnlen)80);
-#line 6356 ""
+#line 6346 ""
/* L127: */
-#line 6356 ""
+#line 6346 ""
}
/* Terminate the grace */
@@ -15549,147 +15547,147 @@ L121:
/* notexq = '}'//sq//'off{' */
/* lnote = 6 */
/* Writing concatenation */
-#line 6364 ""
+#line 6354 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6364 ""
+#line 6354 ""
i__2[1] = 4, a__1[1] = "off{";
-#line 6364 ""
+#line 6354 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6365 ""
+#line 6355 ""
lnote = 5;
-#line 6366 ""
+#line 6356 ""
ptoff = comask_1.wheadpt * spfacs_1.emgfac;
-#line 6367 ""
+#line 6357 ""
if ((*nacc & 3) > 0 && ! bit_test(*nacc,17)) {
-#line 6367 ""
+#line 6357 ""
ptoff += comask_1.wheadpt * spfacs_1.accfac;
-#line 6367 ""
+#line 6357 ""
}
-#line 6369 ""
+#line 6359 ""
if (isgaft && ! iswaft) {
/* Writing concatenation */
-#line 6370 ""
+#line 6360 ""
i__2[0] = 5, a__1[0] = notexq;
-#line 6370 ""
+#line 6360 ""
i__2[1] = 1, a__1[1] = "-";
-#line 6370 ""
+#line 6360 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 6371 ""
+#line 6361 ""
lnote = 6;
-#line 6372 ""
+#line 6362 ""
ptoff = comgrace_1.aftshft;
-#line 6373 ""
+#line 6363 ""
}
-#line 6374 ""
+#line 6364 ""
if (normsp) {
-#line 6374 ""
+#line 6364 ""
ptoff = finalshift;
-#line 6374 ""
+#line 6364 ""
}
-#line 6375 ""
+#line 6365 ""
if (ptoff < 9.95f) {
-#line 6376 ""
+#line 6366 ""
i__1 = lnote;
-#line 6376 ""
+#line 6366 ""
ici__1.icierr = 0;
-#line 6376 ""
+#line 6366 ""
ici__1.icirnum = 1;
-#line 6376 ""
+#line 6366 ""
ici__1.icirlen = lnote + 3 - i__1;
-#line 6376 ""
+#line 6366 ""
ici__1.iciunit = notexq + i__1;
-#line 6376 ""
+#line 6366 ""
ici__1.icifmt = "(f3.1)";
-#line 6376 ""
+#line 6366 ""
s_wsfi(&ici__1);
-#line 6376 ""
+#line 6366 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
-#line 6376 ""
+#line 6366 ""
e_wsfi();
-#line 6377 ""
+#line 6367 ""
lnote += 3;
-#line 6378 ""
+#line 6368 ""
} else if (ptoff < 99.95f) {
-#line 6379 ""
+#line 6369 ""
i__1 = lnote;
-#line 6379 ""
+#line 6369 ""
ici__1.icierr = 0;
-#line 6379 ""
+#line 6369 ""
ici__1.icirnum = 1;
-#line 6379 ""
+#line 6369 ""
ici__1.icirlen = lnote + 4 - i__1;
-#line 6379 ""
+#line 6369 ""
ici__1.iciunit = notexq + i__1;
-#line 6379 ""
+#line 6369 ""
ici__1.icifmt = "(f4.1)";
-#line 6379 ""
+#line 6369 ""
s_wsfi(&ici__1);
-#line 6379 ""
+#line 6369 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
-#line 6379 ""
+#line 6369 ""
e_wsfi();
-#line 6380 ""
+#line 6370 ""
lnote += 4;
-#line 6381 ""
+#line 6371 ""
} else {
-#line 6382 ""
+#line 6372 ""
i__1 = lnote;
-#line 6382 ""
+#line 6372 ""
ici__1.icierr = 0;
-#line 6382 ""
+#line 6372 ""
ici__1.icirnum = 1;
-#line 6382 ""
+#line 6372 ""
ici__1.icirlen = lnote + 5 - i__1;
-#line 6382 ""
+#line 6372 ""
ici__1.iciunit = notexq + i__1;
-#line 6382 ""
+#line 6372 ""
ici__1.icifmt = "(f5.1)";
-#line 6382 ""
+#line 6372 ""
s_wsfi(&ici__1);
-#line 6382 ""
+#line 6372 ""
do_fio(&c__1, (char *)&ptoff, (ftnlen)sizeof(real));
-#line 6382 ""
+#line 6372 ""
e_wsfi();
-#line 6383 ""
+#line 6373 ""
lnote += 5;
-#line 6384 ""
+#line 6374 ""
}
/* Writing concatenation */
-#line 6385 ""
+#line 6375 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 6385 ""
+#line 6375 ""
i__2[1] = 3, a__1[1] = "pt}";
-#line 6385 ""
+#line 6375 ""
s_cat(ch__18, a__1, i__2, &c__2, (ftnlen)82);
-#line 6385 ""
+#line 6375 ""
i__1 = lnote + 3;
-#line 6385 ""
+#line 6375 ""
addstr_(ch__18, &i__1, soutq, lsout, lnote + 3, (ftnlen)80);
-#line 6386 ""
+#line 6376 ""
if (isgaft && ! iswaft) {
/* Writing concatenation */
-#line 6386 ""
+#line 6376 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6386 ""
+#line 6376 ""
i__2[1] = 2, a__1[1] = "sk";
-#line 6386 ""
+#line 6376 ""
s_cat(ch__19, a__1, i__2, &c__2, (ftnlen)3);
-#line 6386 ""
+#line 6376 ""
addstr_(ch__19, &c__3, soutq, lsout, (ftnlen)3, (ftnlen)80);
-#line 6386 ""
+#line 6376 ""
}
/* Writing concatenation */
-#line 6387 ""
+#line 6377 ""
i__2[0] = 1, a__1[0] = sq;
-#line 6387 ""
+#line 6377 ""
i__2[1] = 9, a__1[1] = "resetsize";
-#line 6387 ""
+#line 6377 ""
s_cat(ch__20, a__1, i__2, &c__2, (ftnlen)10);
-#line 6387 ""
+#line 6377 ""
addstr_(ch__20, &c__10, soutq, lsout, (ftnlen)10, (ftnlen)80);
-#line 6388 ""
+#line 6378 ""
}
-#line 6389 ""
+#line 6379 ""
return 0;
} /* dograce_ */
@@ -15811,67 +15809,67 @@ L121:
/* If highest note has upslur, save slur height in islhgt in case */
/* ornament must be moved. */
-#line 6486 ""
+#line 6476 ""
/* Parameter adjustments */
-#line 6486 ""
+#line 6476 ""
--isdat4;
-#line 6486 ""
+#line 6476 ""
--isdat3;
-#line 6486 ""
+#line 6476 ""
--isdat2;
-#line 6486 ""
+#line 6476 ""
--isdat1;
-#line 6486 ""
+#line 6476 ""
-#line 6486 ""
+#line 6476 ""
/* Function Body */
-#line 6486 ""
+#line 6476 ""
*islhgt = 0;
-#line 6487 ""
+#line 6477 ""
if (*beamon) {
-#line 6488 ""
+#line 6478 ""
stemup = *(unsigned char *)ulq == 'u';
-#line 6489 ""
+#line 6479 ""
} else if (commvl_1.nvmx[*iv - 1] == 2) {
-#line 6490 ""
+#line 6480 ""
if (! bit_test(*islur,30)) {
/* Single note, 2 lines of music, stem direction not forced */
-#line 6494 ""
+#line 6484 ""
stemup = commvl_1.ivx > *nv;
-#line 6495 ""
+#line 6485 ""
} else {
-#line 6496 ""
+#line 6486 ""
stemup = bit_test(*islur,17);
-#line 6497 ""
+#line 6487 ""
}
-#line 6498 ""
+#line 6488 ""
} else {
-#line 6499 ""
+#line 6489 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
commvl_1.ivx, nv);
-#line 6499 ""
+#line 6489 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
-#line 6500 ""
+#line 6490 ""
}
-#line 6501 ""
+#line 6491 ""
iscrd = bit_test(*ipl,10);
-#line 6502 ""
+#line 6492 ""
if (commidi_1.ismidi) {
-#line 6503 ""
+#line 6493 ""
settie = FALSE_;
-#line 6504 ""
+#line 6494 ""
comslm_1.dbltie = FALSE_;
-#line 6505 ""
+#line 6495 ""
}
-#line 6506 ""
+#line 6496 ""
i__1 = *nsdat;
-#line 6506 ""
+#line 6496 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
-#line 6507 ""
+#line 6497 ""
isdata = isdat1[isdat];
-#line 6508 ""
+#line 6498 ""
if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(&
isdata, &c__8, &c__3) && (*kv == igetbits_(&isdata, &c__1, &
c__12) + 1 || bit_test(isdata,1))) {
@@ -15879,217 +15877,217 @@ L121:
/* Since iv and kv match, ivx will be correct */
-#line 6516 ""
+#line 6506 ""
idcode = igetbits_(&isdata, &c__7, &c__19);
-#line 6517 ""
+#line 6507 ""
ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
-#line 6518 ""
+#line 6508 ""
ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
-#line 6519 ""
+#line 6509 ""
iupdn = 0;
-#line 6520 ""
+#line 6510 ""
*(unsigned char *)slurudq = 'd';
-#line 6521 ""
+#line 6511 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
-#line 6522 ""
+#line 6512 ""
pstie = bit_test(isdat2[isdat],3) || idcode == 1;
-#line 6523 ""
+#line 6513 ""
if (bit_test(isdata,11)) {
/* Turnon */
/* Get slur direction */
-#line 6528 ""
+#line 6518 ""
if (bit_test(isdata,26)) {
/* Force slur direction */
-#line 6532 ""
+#line 6522 ""
if (bit_test(isdata,27)) {
-#line 6532 ""
+#line 6522 ""
*(unsigned char *)slurudq = 'u';
-#line 6532 ""
+#line 6522 ""
}
-#line 6533 ""
+#line 6523 ""
} else if (commvl_1.nvmx[*iv - 1] == 1) {
/* Only one voice per line */
-#line 6537 ""
+#line 6527 ""
if (! (*beamon)) {
/* Separate note. */
-#line 6541 ""
+#line 6531 ""
udfq_(ch__1, (ftnlen)1, nolev, ncm);
-#line 6541 ""
+#line 6531 ""
*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
0];
-#line 6542 ""
+#line 6532 ""
} else {
/* In a beam */
-#line 6546 ""
+#line 6536 ""
if (*(unsigned char *)ulq != 'u') {
-#line 6546 ""
+#line 6536 ""
*(unsigned char *)slurudq = 'u';
-#line 6546 ""
+#line 6536 ""
}
-#line 6547 ""
+#line 6537 ""
}
-#line 6548 ""
+#line 6538 ""
if (iscrd) {
-#line 6549 ""
+#line 6539 ""
if (nolevs > *ncm) {
-#line 6550 ""
+#line 6540 ""
*(unsigned char *)slurudq = 'u';
-#line 6551 ""
+#line 6541 ""
} else {
-#line 6552 ""
+#line 6542 ""
*(unsigned char *)slurudq = 'd';
-#line 6553 ""
+#line 6543 ""
}
-#line 6554 ""
+#line 6544 ""
}
-#line 6555 ""
+#line 6545 ""
} else {
/* Two voices per line. Get default */
-#line 6559 ""
+#line 6549 ""
if (commvl_1.ivx > *nv) {
-#line 6559 ""
+#line 6549 ""
*(unsigned char *)slurudq = 'u';
-#line 6559 ""
+#line 6549 ""
}
/* Upper voice of the two, so up slur */
-#line 6563 ""
+#line 6553 ""
}
-#line 6564 ""
+#line 6554 ""
if (bit_test(isdata,2)) {
/* ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. */
-#line 6568 ""
+#line 6558 ""
if (stemup) {
-#line 6569 ""
+#line 6559 ""
*(unsigned char *)slurudq = 'u';
-#line 6570 ""
+#line 6560 ""
ivoff += 4;
-#line 6571 ""
+#line 6561 ""
} else {
-#line 6572 ""
+#line 6562 ""
*(unsigned char *)slurudq = 'd';
-#line 6573 ""
+#line 6563 ""
ivoff += -4;
-#line 6574 ""
+#line 6564 ""
}
-#line 6575 ""
+#line 6565 ""
}
/* Set level for slur starting on rest */
-#line 6579 ""
+#line 6569 ""
if (nolevs == 0 || nolevs > 60) {
-#line 6580 ""
+#line 6570 ""
if (*(unsigned char *)slurudq == 'u') {
-#line 6581 ""
+#line 6571 ""
nolevs = *ncm + 2;
-#line 6582 ""
+#line 6572 ""
} else {
-#line 6583 ""
+#line 6573 ""
nolevs = *ncm - 2;
-#line 6584 ""
+#line 6574 ""
}
-#line 6585 ""
+#line 6575 ""
}
/* Save up/down-ness for use at termination */
-#line 6589 ""
+#line 6579 ""
if (*(unsigned char *)slurudq == 'u') {
-#line 6589 ""
+#line 6579 ""
isdata = bit_set(isdata,27);
-#line 6589 ""
+#line 6579 ""
}
/* End of section for setting slur direction, still in "Turnon" if-block. */
-#line 6593 ""
+#line 6583 ""
if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
/* Raise or lower slur by one unit provided . or _ is on same side as slur */
-#line 6597 ""
+#line 6587 ""
ivoffinc = 0;
-#line 6598 ""
+#line 6588 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
/* Must move the slur for _ or . */
-#line 6603 ""
+#line 6593 ""
if (stemup) {
-#line 6604 ""
+#line 6594 ""
ivoffinc = -1;
-#line 6605 ""
+#line 6595 ""
} else {
-#line 6606 ""
+#line 6596 ""
ivoffinc = 1;
-#line 6607 ""
+#line 6597 ""
}
-#line 6608 ""
+#line 6598 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
-#line 6608 ""
+#line 6598 ""
ivoffinc <<= 1;
-#line 6608 ""
+#line 6598 ""
}
-#line 6611 ""
+#line 6601 ""
ivoff += ivoffinc;
-#line 6612 ""
+#line 6602 ""
}
-#line 6613 ""
+#line 6603 ""
}
-#line 6614 ""
+#line 6604 ""
if (comslur_1.listslur == 16777215) {
-#line 6615 ""
+#line 6605 ""
s_wsle(&io___478);
-#line 6615 ""
+#line 6605 ""
e_wsle();
-#line 6616 ""
+#line 6606 ""
s_wsle(&io___479);
-#line 6616 ""
+#line 6606 ""
do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur,"\
" one too many!", (ftnlen)48);
-#line 6616 ""
+#line 6606 ""
e_wsle();
-#line 6617 ""
+#line 6607 ""
s_wsfe(&io___480);
-#line 6617 ""
+#line 6607 ""
do_fio(&c__1, "You defined the twentyfifth slur, one too"\
" many!", (ftnlen)47);
-#line 6617 ""
+#line 6607 ""
e_wsfe();
-#line 6619 ""
+#line 6609 ""
stop1_();
-#line 6620 ""
+#line 6610 ""
}
/* Get index of next slur not in use, starting from 12 down */
-#line 6624 ""
+#line 6614 ""
i__2 = 16777215 - comslur_1.listslur;
-#line 6624 ""
+#line 6614 ""
comslur_1.ndxslur = log2_(&i__2);
/* Record slur index */
-#line 6628 ""
+#line 6618 ""
comslur_1.listslur = bit_set(comslur_1.listslur,
comslur_1.ndxslur);
@@ -16097,206 +16095,206 @@ L121:
/* call setbits(isdata,4,28,ndxslur) */
/* 080531 Allow >16 slurs */
-#line 6634 ""
+#line 6624 ""
i__2 = comslur_1.ndxslur % 16;
-#line 6634 ""
+#line 6624 ""
setbits_(&isdata, &c__4, &c__28, &i__2);
-#line 6635 ""
+#line 6625 ""
i__2 = comslur_1.ndxslur / 16;
-#line 6635 ""
+#line 6625 ""
setbits_(&isdata, &c__1, &c__18, &i__2);
/* Shift for stem? */
-#line 6639 ""
+#line 6629 ""
if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
{
-#line 6640 ""
+#line 6630 ""
if (! pstie) {
-#line 6641 ""
+#line 6631 ""
ihoff += 8;
-#line 6642 ""
+#line 6632 ""
} else {
-#line 6643 ""
+#line 6633 ""
ihoff += 2;
-#line 6644 ""
+#line 6634 ""
}
-#line 6645 ""
+#line 6635 ""
}
-#line 6646 ""
+#line 6636 ""
if (iscrd) {
/* Additional horiz shifts for h-shifted noteheads? */
-#line 6650 ""
+#line 6640 ""
if (bit_test(isdat2[isdat],1)) {
/* Slur start on left-shifted chord notehead. ASSUME downstem. */
-#line 6654 ""
+#line 6644 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
-#line 6655 ""
+#line 6645 ""
ihoff += -2;
-#line 6656 ""
+#line 6646 ""
} else {
-#line 6657 ""
+#line 6647 ""
ihoff += -10;
-#line 6658 ""
+#line 6648 ""
}
-#line 6659 ""
+#line 6649 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
-#line 6663 ""
+#line 6653 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
-#line 6664 ""
+#line 6654 ""
ihoff += 2;
-#line 6665 ""
+#line 6655 ""
} else {
-#line 6666 ""
+#line 6656 ""
ihoff += 10;
-#line 6667 ""
+#line 6657 ""
}
-#line 6668 ""
+#line 6658 ""
}
-#line 6669 ""
+#line 6659 ""
}
-#line 6670 ""
+#line 6660 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6670 ""
+#line 6660 ""
s_copy(notexq, ch__1, (ftnlen)79, (ftnlen)1);
-#line 6671 ""
+#line 6661 ""
lnote = 1;
/* Check for local adjustment default changes */
-#line 6675 ""
+#line 6665 ""
if (bit_test(isdat2[isdat],26)) {
/* Writing concatenation */
-#line 6676 ""
+#line 6666 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6676 ""
+#line 6666 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6676 ""
+#line 6666 ""
i__3[1] = 10, a__1[1] = "sluradjust";
-#line 6676 ""
+#line 6666 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 6676 ""
+#line 6666 ""
i__3[2] = 1, a__1[2] = ch__2;
-#line 6676 ""
+#line 6666 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6677 ""
+#line 6667 ""
lnote = 12;
-#line 6678 ""
+#line 6668 ""
} else if (bit_test(isdat2[isdat],27)) {
/* Writing concatenation */
-#line 6679 ""
+#line 6669 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6679 ""
+#line 6669 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6679 ""
+#line 6669 ""
i__3[1] = 12, a__1[1] = "nosluradjust";
-#line 6679 ""
+#line 6669 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 6679 ""
+#line 6669 ""
i__3[2] = 1, a__1[2] = ch__2;
-#line 6679 ""
+#line 6669 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6680 ""
+#line 6670 ""
lnote = 14;
-#line 6681 ""
+#line 6671 ""
} else if (bit_test(isdat2[isdat],28)) {
/* Writing concatenation */
-#line 6682 ""
+#line 6672 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6682 ""
+#line 6672 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6682 ""
+#line 6672 ""
i__3[1] = 9, a__1[1] = "tieadjust";
-#line 6682 ""
+#line 6672 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 6682 ""
+#line 6672 ""
i__3[2] = 1, a__1[2] = ch__2;
-#line 6682 ""
+#line 6672 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6683 ""
+#line 6673 ""
lnote = 11;
-#line 6684 ""
+#line 6674 ""
} else if (bit_test(isdat2[isdat],29)) {
/* Writing concatenation */
-#line 6685 ""
+#line 6675 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6685 ""
+#line 6675 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6685 ""
+#line 6675 ""
i__3[1] = 11, a__1[1] = "notieadjust";
-#line 6685 ""
+#line 6675 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 6685 ""
+#line 6675 ""
i__3[2] = 1, a__1[2] = ch__2;
-#line 6685 ""
+#line 6675 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6686 ""
+#line 6676 ""
lnote = 13;
-#line 6687 ""
+#line 6677 ""
}
-#line 6688 ""
+#line 6678 ""
if (ihoff == 0) {
/* Write stuff for non-shifted start */
/* Writing concatenation */
-#line 6692 ""
+#line 6682 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 6692 ""
+#line 6682 ""
i__3[1] = 5, a__1[1] = "islur";
-#line 6692 ""
+#line 6682 ""
i__3[2] = 1, a__1[2] = slurudq;
-#line 6692 ""
+#line 6682 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6693 ""
+#line 6683 ""
lnote += 6;
-#line 6694 ""
+#line 6684 ""
} else {
/* Writing concatenation */
-#line 6695 ""
+#line 6685 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 6695 ""
+#line 6685 ""
i__3[1] = 2, a__1[1] = "is";
-#line 6695 ""
+#line 6685 ""
i__3[2] = 1, a__1[2] = slurudq;
-#line 6695 ""
+#line 6685 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6696 ""
+#line 6686 ""
lnote += 3;
-#line 6697 ""
+#line 6687 ""
}
/* Prepend postscript tie switch */
-#line 6701 ""
+#line 6691 ""
if (pstie) {
/* Writing concatenation */
-#line 6702 ""
+#line 6692 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6702 ""
+#line 6692 ""
i__4[0] = 1, a__2[0] = ch__1;
-#line 6702 ""
+#line 6692 ""
i__4[1] = 8, a__2[1] = "tieforis";
-#line 6702 ""
+#line 6692 ""
i__4[2] = 1, a__2[2] = slurudq;
-#line 6702 ""
+#line 6692 ""
i__4[3] = lnote, a__2[3] = notexq;
-#line 6702 ""
+#line 6692 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 6703 ""
+#line 6693 ""
lnote += 10;
-#line 6704 ""
+#line 6694 ""
}
-#line 6705 ""
+#line 6695 ""
if (bit_test(isdat2[isdat],4)) {
/* Dotted slur */
@@ -16304,288 +16302,288 @@ L121:
/* noteq = notexq */
/* notexq = chax(92)//'dotted'//noteq */
/* Writing concatenation */
-#line 6711 ""
+#line 6701 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6711 ""
+#line 6701 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6711 ""
+#line 6701 ""
i__3[1] = 6, a__1[1] = "dotted";
-#line 6711 ""
+#line 6701 ""
i__3[2] = lnote, a__1[2] = notexq;
-#line 6711 ""
+#line 6701 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6712 ""
+#line 6702 ""
lnote += 7;
-#line 6713 ""
+#line 6703 ""
}
/* Add slur index to string */
/* Print 23-ndxslur */
-#line 6718 ""
+#line 6708 ""
if (23 - comslur_1.ndxslur < 10) {
/* 5/25/08 Allow 24 slurs */
/* Writing concatenation */
-#line 6722 ""
+#line 6712 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6722 ""
+#line 6712 ""
i__2 = 71 - comslur_1.ndxslur;
-#line 6722 ""
+#line 6712 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6722 ""
+#line 6712 ""
i__5[1] = 1, a__3[1] = ch__1;
-#line 6722 ""
+#line 6712 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6723 ""
+#line 6713 ""
++lnote;
-#line 6724 ""
+#line 6714 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 6725 ""
+#line 6715 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 6725 ""
+#line 6715 ""
i__4[1] = 2, a__2[1] = "{1";
-#line 6725 ""
+#line 6715 ""
i__2 = 61 - comslur_1.ndxslur;
-#line 6725 ""
+#line 6715 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6725 ""
+#line 6715 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 6725 ""
+#line 6715 ""
i__4[3] = 1, a__2[3] = "}";
-#line 6725 ""
+#line 6715 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 6726 ""
+#line 6716 ""
lnote += 4;
-#line 6727 ""
+#line 6717 ""
} else {
/* Writing concatenation */
-#line 6728 ""
+#line 6718 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 6728 ""
+#line 6718 ""
i__4[1] = 2, a__2[1] = "{2";
-#line 6728 ""
+#line 6718 ""
i__2 = 51 - comslur_1.ndxslur;
-#line 6728 ""
+#line 6718 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6728 ""
+#line 6718 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 6728 ""
+#line 6718 ""
i__4[3] = 1, a__2[3] = "}";
-#line 6728 ""
+#line 6718 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 6729 ""
+#line 6719 ""
lnote += 4;
-#line 6730 ""
+#line 6720 ""
}
/* Add note name to string */
-#line 6734 ""
+#line 6724 ""
*islhgt = nolevs + iupdn + ivoff;
-#line 6735 ""
+#line 6725 ""
notefq_(noteq, &lnoten, islhgt, ncm, (ftnlen)8);
/* Writing concatenation */
-#line 6736 ""
+#line 6726 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6736 ""
+#line 6726 ""
i__5[1] = lnoten, a__3[1] = noteq;
-#line 6736 ""
+#line 6726 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6737 ""
+#line 6727 ""
lnote += lnoten;
/* Store height and staff mid level for use with LineBreakTies */
-#line 6741 ""
+#line 6731 ""
setbits_(&isdat3[isdat], &c__8, &c__14, islhgt);
-#line 6742 ""
+#line 6732 ""
setbits_(&isdat3[isdat], &c__8, &c__22, ncm);
/* Save height (for ornament and barnobox interference) if topmost slur is up */
-#line 6746 ""
+#line 6736 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
-#line 6748 ""
+#line 6738 ""
*islhgt = nolevs + iupdn + ivoff;
/* Save height & idcode if top voice and slur start */
-#line 6752 ""
+#line 6742 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
-#line 6753 ""
+#line 6743 ""
comsln_1.is1n1 = *islhgt;
-#line 6754 ""
+#line 6744 ""
comsln_1.is2n1 = idcode;
-#line 6755 ""
+#line 6745 ""
}
-#line 6756 ""
+#line 6746 ""
}
-#line 6757 ""
+#line 6747 ""
if ((real) ihoff != 0.f) {
-#line 6758 ""
+#line 6748 ""
shift = ihoff * .1f;
/* Writing concatenation */
-#line 6759 ""
+#line 6749 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6759 ""
+#line 6749 ""
i__5[1] = 1, a__3[1] = "{";
-#line 6759 ""
+#line 6749 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6760 ""
+#line 6750 ""
++lnote;
-#line 6761 ""
+#line 6751 ""
lform = lfmt1_(&shift);
-#line 6762 ""
+#line 6752 ""
i__2 = lnote;
-#line 6762 ""
+#line 6752 ""
ici__1.icierr = 0;
-#line 6762 ""
+#line 6752 ""
ici__1.icirnum = 1;
-#line 6762 ""
+#line 6752 ""
ici__1.icirlen = lnote + lform - i__2;
-#line 6762 ""
+#line 6752 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 6762 ""
+#line 6752 ""
i__3[0] = 2, a__1[0] = "(f";
-#line 6762 ""
+#line 6752 ""
i__6 = lform + 48;
-#line 6762 ""
+#line 6752 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 6762 ""
+#line 6752 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 6762 ""
+#line 6752 ""
i__3[2] = 3, a__1[2] = ".1)";
-#line 6762 ""
+#line 6752 ""
ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
6), ch__3);
-#line 6762 ""
+#line 6752 ""
s_wsfi(&ici__1);
-#line 6762 ""
+#line 6752 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
-#line 6762 ""
+#line 6752 ""
e_wsfi();
-#line 6764 ""
+#line 6754 ""
lnote += lform;
/* Writing concatenation */
-#line 6765 ""
+#line 6755 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6765 ""
+#line 6755 ""
i__5[1] = 1, a__3[1] = "}";
-#line 6765 ""
+#line 6755 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6766 ""
+#line 6756 ""
++lnote;
-#line 6767 ""
+#line 6757 ""
}
-#line 6768 ""
+#line 6758 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Zero out ip1 to avoid problems if slur goes to next input blk. */
-#line 6772 ""
+#line 6762 ""
setbits_(&isdata, &c__8, &c__3, &c__0);
/* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */
-#line 6776 ""
+#line 6766 ""
if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
/* levson(midchan(iv,kv)) = nolevs */
/* 130316 */
-#line 6779 ""
+#line 6769 ""
comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1];
-#line 6780 ""
+#line 6770 ""
if (settie) {
-#line 6780 ""
+#line 6770 ""
comslm_1.dbltie = TRUE_;
-#line 6780 ""
+#line 6770 ""
}
/* Only way settie=T is if we just set a tie ending. So there's also a slur */
/* start here, so set a flag telling addmidi not to zero out levson */
-#line 6785 ""
+#line 6775 ""
}
-#line 6786 ""
+#line 6776 ""
} else {
/* Slur is ending. Back thru list to find starting slur */
-#line 6790 ""
+#line 6780 ""
for (j = isdat - 1; j >= 1; --j) {
-#line 6791 ""
+#line 6781 ""
if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && (*kv ==
igetbits_(&isdat1[j], &c__1, &c__12) + 1 ||
bit_test(isdat1[j],1))) {
/* * kv.eq.igetbits(isdat1(j),1,12)+1) then */
-#line 6795 ""
+#line 6785 ""
if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
-#line 6796 ""
+#line 6786 ""
comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
c__28) + (igetbits_(&isdat1[j], &c__1, &
c__18) << 4);
/* 080531 Allow >16 slurs */
-#line 6801 ""
+#line 6791 ""
if (bit_test(isdat1[j],27)) {
-#line 6801 ""
+#line 6791 ""
*(unsigned char *)slurudq = 'u';
-#line 6801 ""
+#line 6791 ""
}
-#line 6802 ""
+#line 6792 ""
goto L4;
-#line 6803 ""
+#line 6793 ""
}
-#line 6804 ""
+#line 6794 ""
}
-#line 6805 ""
+#line 6795 ""
/* L3: */
-#line 6805 ""
+#line 6795 ""
}
-#line 6806 ""
+#line 6796 ""
s_wsle(&io___488);
-#line 6806 ""
+#line 6796 ""
do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
-#line 6806 ""
+#line 6796 ""
e_wsle();
-#line 6807 ""
+#line 6797 ""
stop1_();
-#line 6808 ""
+#line 6798 ""
L4:
/* Bugfix 070901 for slur ending on rest in 2-voice staff */
-#line 6812 ""
+#line 6802 ""
if (nolevs <= 2 || nolevs > 60) {
/* Ending is on a rest, reset nolevs to default starting height */
-#line 6816 ""
+#line 6806 ""
nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
-#line 6817 ""
+#line 6807 ""
}
-#line 6818 ""
+#line 6808 ""
if (bit_test(isdat3[isdat],0) || bit_test(isdat3[j],0)) {
/* Deal with \curve or \midslur. isdat is ending, j is start. */
-#line 6822 ""
+#line 6812 ""
if (bit_test(isdat3[isdat],0)) {
-#line 6823 ""
+#line 6813 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
-#line 6824 ""
+#line 6814 ""
} else {
-#line 6825 ""
+#line 6815 ""
imid = igetbits_(&isdat3[j], &c__6, &c__2) - 32;
-#line 6826 ""
+#line 6816 ""
}
/* Postscript slurs, and \midslur adjustment is needed. Invoke macro */
@@ -16598,458 +16596,458 @@ L4:
/* 6+ HH */
/* Writing concatenation */
-#line 6837 ""
+#line 6827 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6837 ""
+#line 6827 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6837 ""
+#line 6827 ""
i__3[1] = 7, a__1[1] = "psforts";
/* Computing MIN */
-#line 6837 ""
+#line 6827 ""
i__6 = abs(imid);
-#line 6837 ""
+#line 6827 ""
i__2 = min(i__6,6) + 48;
-#line 6837 ""
+#line 6827 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 6837 ""
+#line 6827 ""
i__3[2] = 1, a__1[2] = ch__2;
-#line 6837 ""
+#line 6827 ""
s_cat(ch__4, a__1, i__3, &c__3, (ftnlen)9);
-#line 6837 ""
+#line 6827 ""
addstr_(ch__4, &c__9, soutq, lsout, (ftnlen)9, (ftnlen)80)
;
-#line 6839 ""
+#line 6829 ""
}
-#line 6840 ""
+#line 6830 ""
if (bit_test(isdata,2)) {
/* ADjust for stem slur. */
-#line 6844 ""
+#line 6834 ""
if (stemup) {
-#line 6845 ""
+#line 6835 ""
*(unsigned char *)slurudq = 'u';
-#line 6846 ""
+#line 6836 ""
ivoff += 4;
-#line 6847 ""
+#line 6837 ""
} else {
-#line 6848 ""
+#line 6838 ""
*(unsigned char *)slurudq = 'd';
-#line 6849 ""
+#line 6839 ""
ivoff += -4;
-#line 6850 ""
+#line 6840 ""
}
-#line 6851 ""
+#line 6841 ""
}
/* Shift slur ending for stem on any note? */
-#line 6855 ""
+#line 6845 ""
if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
63.f) {
-#line 6856 ""
+#line 6846 ""
if (! pstie) {
-#line 6857 ""
+#line 6847 ""
ihoff += -8;
-#line 6858 ""
+#line 6848 ""
} else {
-#line 6859 ""
+#line 6849 ""
ihoff += -3;
-#line 6860 ""
+#line 6850 ""
}
-#line 6861 ""
+#line 6851 ""
}
-#line 6862 ""
+#line 6852 ""
if (iscrd) {
/* Shift termination for shifted notehead? */
-#line 6866 ""
+#line 6856 ""
if (bit_test(isdat2[isdat],1)) {
/* Left-shifted chord notehead. ASSUME downstem. */
-#line 6870 ""
+#line 6860 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
-#line 6871 ""
+#line 6861 ""
ihoff += -2;
-#line 6872 ""
+#line 6862 ""
} else {
-#line 6873 ""
+#line 6863 ""
ihoff += -10;
-#line 6874 ""
+#line 6864 ""
}
-#line 6875 ""
+#line 6865 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
-#line 6879 ""
+#line 6869 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
-#line 6880 ""
+#line 6870 ""
ihoff += 2;
-#line 6881 ""
+#line 6871 ""
} else {
-#line 6882 ""
+#line 6872 ""
ihoff += 10;
-#line 6883 ""
+#line 6873 ""
}
-#line 6884 ""
+#line 6874 ""
}
-#line 6885 ""
+#line 6875 ""
}
-#line 6886 ""
+#line 6876 ""
if (ihoff == 0) {
/* Writing concatenation */
-#line 6887 ""
+#line 6877 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6887 ""
+#line 6877 ""
i__5[0] = 1, a__3[0] = ch__1;
-#line 6887 ""
+#line 6877 ""
i__5[1] = 5, a__3[1] = "tslur";
-#line 6887 ""
+#line 6877 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6888 ""
+#line 6878 ""
lnote = 6;
-#line 6889 ""
+#line 6879 ""
} else {
/* Shift needed */
/* Writing concatenation */
-#line 6893 ""
+#line 6883 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6893 ""
+#line 6883 ""
i__5[0] = 1, a__3[0] = ch__1;
-#line 6893 ""
+#line 6883 ""
i__5[1] = 2, a__3[1] = "ts";
-#line 6893 ""
+#line 6883 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6894 ""
+#line 6884 ""
lnote = 3;
-#line 6895 ""
+#line 6885 ""
}
/* Switch to postscript tie */
-#line 6899 ""
+#line 6889 ""
if (pstie) {
/* Writing concatenation */
-#line 6900 ""
+#line 6890 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 6900 ""
+#line 6890 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 6900 ""
+#line 6890 ""
i__3[1] = 8, a__1[1] = "tieforts";
-#line 6900 ""
+#line 6890 ""
i__3[2] = lnote, a__1[2] = notexq;
-#line 6900 ""
+#line 6890 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 6901 ""
+#line 6891 ""
lnote += 9;
-#line 6902 ""
+#line 6892 ""
}
/* Print 13-ndxslur */
/* 5/25/08 Allow 14 slurs */
-#line 6907 ""
+#line 6897 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
-#line 6908 ""
+#line 6898 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6908 ""
+#line 6898 ""
i__2 = 71 - comslur_1.ndxslur;
-#line 6908 ""
+#line 6898 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6908 ""
+#line 6898 ""
i__5[1] = 1, a__3[1] = ch__1;
-#line 6908 ""
+#line 6898 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6909 ""
+#line 6899 ""
++lnote;
-#line 6910 ""
+#line 6900 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 6911 ""
+#line 6901 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 6911 ""
+#line 6901 ""
i__4[1] = 2, a__2[1] = "{1";
-#line 6911 ""
+#line 6901 ""
i__2 = 61 - comslur_1.ndxslur;
-#line 6911 ""
+#line 6901 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6911 ""
+#line 6901 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 6911 ""
+#line 6901 ""
i__4[3] = 1, a__2[3] = "}";
-#line 6911 ""
+#line 6901 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 6912 ""
+#line 6902 ""
lnote += 4;
-#line 6913 ""
+#line 6903 ""
} else {
/* Writing concatenation */
-#line 6914 ""
+#line 6904 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 6914 ""
+#line 6904 ""
i__4[1] = 2, a__2[1] = "{2";
-#line 6914 ""
+#line 6904 ""
i__2 = 51 - comslur_1.ndxslur;
-#line 6914 ""
+#line 6904 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 6914 ""
+#line 6904 ""
i__4[2] = 1, a__2[2] = ch__1;
-#line 6914 ""
+#line 6904 ""
i__4[3] = 1, a__2[3] = "}";
-#line 6914 ""
+#line 6904 ""
s_cat(notexq, a__2, i__4, &c__4, (ftnlen)79);
-#line 6915 ""
+#line 6905 ""
lnote += 4;
-#line 6916 ""
+#line 6906 ""
}
-#line 6917 ""
+#line 6907 ""
if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
/* Raise or lower slur by one unit provided . or _ is on same side as slur */
-#line 6921 ""
+#line 6911 ""
ivoffinc = 0;
-#line 6922 ""
+#line 6912 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
-#line 6924 ""
+#line 6914 ""
if (stemup) {
-#line 6925 ""
+#line 6915 ""
ivoffinc = -1;
-#line 6926 ""
+#line 6916 ""
} else {
-#line 6927 ""
+#line 6917 ""
ivoffinc = 1;
-#line 6928 ""
+#line 6918 ""
}
-#line 6929 ""
+#line 6919 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
-#line 6929 ""
+#line 6919 ""
ivoffinc <<= 1;
-#line 6929 ""
+#line 6919 ""
}
-#line 6932 ""
+#line 6922 ""
}
-#line 6933 ""
+#line 6923 ""
ivoff += ivoffinc;
-#line 6934 ""
+#line 6924 ""
}
-#line 6935 ""
+#line 6925 ""
i__2 = nolevs + iupdn + ivoff;
-#line 6935 ""
+#line 6925 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
-#line 6936 ""
+#line 6926 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
-#line 6938 ""
+#line 6928 ""
*islhgt = nolevs + iupdn + ivoff;
/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
-#line 6942 ""
+#line 6932 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && comsln_1.is1n1 > 0) {
-#line 6943 ""
+#line 6933 ""
if (idcode == comsln_1.is2n1) {
-#line 6943 ""
+#line 6933 ""
comsln_1.is1n1 = 0;
-#line 6943 ""
+#line 6933 ""
}
-#line 6944 ""
+#line 6934 ""
}
-#line 6945 ""
+#line 6935 ""
}
/* Writing concatenation */
-#line 6946 ""
+#line 6936 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6946 ""
+#line 6936 ""
i__5[1] = lnoten, a__3[1] = noteq;
-#line 6946 ""
+#line 6936 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6947 ""
+#line 6937 ""
lnote += lnoten;
-#line 6948 ""
+#line 6938 ""
if (ihoff != 0) {
-#line 6949 ""
+#line 6939 ""
shift = ihoff * .1f;
/* Writing concatenation */
-#line 6950 ""
+#line 6940 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6950 ""
+#line 6940 ""
i__5[1] = 1, a__3[1] = "{";
-#line 6950 ""
+#line 6940 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6951 ""
+#line 6941 ""
++lnote;
-#line 6952 ""
+#line 6942 ""
lform = lfmt1_(&shift);
-#line 6953 ""
+#line 6943 ""
i__2 = lnote;
-#line 6953 ""
+#line 6943 ""
ici__1.icierr = 0;
-#line 6953 ""
+#line 6943 ""
ici__1.icirnum = 1;
-#line 6953 ""
+#line 6943 ""
ici__1.icirlen = lnote + lform - i__2;
-#line 6953 ""
+#line 6943 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 6953 ""
+#line 6943 ""
i__3[0] = 2, a__1[0] = "(f";
-#line 6953 ""
+#line 6943 ""
i__6 = lform + 48;
-#line 6953 ""
+#line 6943 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 6953 ""
+#line 6943 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 6953 ""
+#line 6943 ""
i__3[2] = 3, a__1[2] = ".1)";
-#line 6953 ""
+#line 6943 ""
ici__1.icifmt = (s_cat(ch__3, a__1, i__3, &c__3, (ftnlen)
6), ch__3);
-#line 6953 ""
+#line 6943 ""
s_wsfi(&ici__1);
-#line 6953 ""
+#line 6943 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
-#line 6953 ""
+#line 6943 ""
e_wsfi();
-#line 6955 ""
+#line 6945 ""
lnote += lform;
/* Writing concatenation */
-#line 6956 ""
+#line 6946 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 6956 ""
+#line 6946 ""
i__5[1] = 1, a__3[1] = "}";
-#line 6956 ""
+#line 6946 ""
s_cat(notexq, a__3, i__5, &c__2, (ftnlen)79);
-#line 6957 ""
+#line 6947 ""
++lnote;
-#line 6958 ""
+#line 6948 ""
}
-#line 6959 ""
+#line 6949 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Clear the bit from list of slurs in use */
-#line 6963 ""
+#line 6953 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
/* Zero out the entire strings for start and stop */
-#line 6967 ""
+#line 6957 ""
isdata = 0;
-#line 6968 ""
+#line 6958 ""
isdat2[isdat] = 0;
-#line 6969 ""
+#line 6959 ""
isdat3[isdat] = 0;
-#line 6970 ""
+#line 6960 ""
isdat4[isdat] = 0;
-#line 6971 ""
+#line 6961 ""
isdat1[j] = 0;
-#line 6972 ""
+#line 6962 ""
isdat2[j] = 0;
-#line 6973 ""
+#line 6963 ""
isdat3[j] = 0;
-#line 6974 ""
+#line 6964 ""
isdat4[j] = 0;
/* Set midi info for slur ending */
-#line 6978 ""
+#line 6968 ""
if (commidi_1.ismidi && (idcode == 32 || idcode == 1)) {
-#line 6979 ""
+#line 6969 ""
icm = commidi_1.midchan[*iv + *kv * 24 - 25];
-#line 6980 ""
+#line 6970 ""
if (comslm_1.slmon[icm]) {
-#line 6981 ""
+#line 6971 ""
if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
*nacc) == 0) {
/* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */
-#line 6986 ""
+#line 6976 ""
comslm_1.levsoff[icm] = nolevs +
commvel_1.miditran[cominsttrans_1.instno[*
iv - 1] - 1];
-#line 6987 ""
+#line 6977 ""
settie = TRUE_;
-#line 6988 ""
+#line 6978 ""
} else {
-#line 6989 ""
+#line 6979 ""
comslm_1.levsoff[icm] = 0;
-#line 6990 ""
+#line 6980 ""
comslm_1.levson[icm] = 0;
-#line 6991 ""
+#line 6981 ""
comslm_1.slmon[icm] = FALSE_;
-#line 6992 ""
+#line 6982 ""
}
-#line 6993 ""
+#line 6983 ""
}
-#line 6994 ""
+#line 6984 ""
}
-#line 6995 ""
+#line 6985 ""
}
-#line 6996 ""
+#line 6986 ""
isdat1[isdat] = isdata;
-#line 6997 ""
+#line 6987 ""
}
-#line 6998 ""
+#line 6988 ""
/* L1: */
-#line 6998 ""
+#line 6988 ""
}
/* Clear and collapse the slur data list */
-#line 7002 ""
+#line 6992 ""
numdrop = 0;
-#line 7003 ""
+#line 6993 ""
i__1 = *nsdat;
-#line 7003 ""
+#line 6993 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
-#line 7004 ""
+#line 6994 ""
if (isdat1[isdat] == 0) {
-#line 7005 ""
+#line 6995 ""
++numdrop;
-#line 7006 ""
+#line 6996 ""
} else if (numdrop > 0) {
-#line 7007 ""
+#line 6997 ""
isdat1[isdat - numdrop] = isdat1[isdat];
-#line 7008 ""
+#line 6998 ""
isdat2[isdat - numdrop] = isdat2[isdat];
-#line 7009 ""
+#line 6999 ""
isdat3[isdat - numdrop] = isdat3[isdat];
-#line 7010 ""
+#line 7000 ""
isdat4[isdat - numdrop] = isdat4[isdat];
-#line 7011 ""
+#line 7001 ""
isdat1[isdat] = 0;
-#line 7012 ""
+#line 7002 ""
isdat2[isdat] = 0;
-#line 7013 ""
+#line 7003 ""
isdat3[isdat] = 0;
-#line 7014 ""
+#line 7004 ""
isdat4[isdat] = 0;
-#line 7015 ""
+#line 7005 ""
}
-#line 7016 ""
+#line 7006 ""
/* L2: */
-#line 7016 ""
+#line 7006 ""
}
-#line 7017 ""
+#line 7007 ""
*nsdat -= numdrop;
/* call report(nsdat,isdat1,isdat2) */
-#line 7019 ""
+#line 7009 ""
return 0;
} /* dopsslur_ */
@@ -17159,129 +17157,129 @@ L4:
/* If highest note has upslur, save slur height in islhgt in case */
/* ornament must be moved. */
-#line 7097 ""
+#line 7087 ""
/* Parameter adjustments */
-#line 7097 ""
+#line 7087 ""
--isdat3;
-#line 7097 ""
+#line 7087 ""
--isdat2;
-#line 7097 ""
+#line 7087 ""
--isdat1;
-#line 7097 ""
+#line 7087 ""
-#line 7097 ""
+#line 7087 ""
/* Function Body */
-#line 7097 ""
+#line 7087 ""
*islhgt = 0;
-#line 7098 ""
+#line 7088 ""
if (*beamon) {
-#line 7099 ""
+#line 7089 ""
stemup = *(unsigned char *)ulq == 'u';
-#line 7100 ""
+#line 7090 ""
} else if (commvl_1.nvmx[*iv - 1] == 2) {
-#line 7101 ""
+#line 7091 ""
if (! bit_test(*islur,30)) {
/* Single note, 2 lines of music, stem direction not forced */
-#line 7105 ""
+#line 7095 ""
stemup = commvl_1.ivx > *nv;
-#line 7106 ""
+#line 7096 ""
} else {
-#line 7107 ""
+#line 7097 ""
stemup = bit_test(*islur,17);
-#line 7108 ""
+#line 7098 ""
}
-#line 7109 ""
+#line 7099 ""
} else {
-#line 7110 ""
+#line 7100 ""
udqq_(ch__1, (ftnlen)1, nolev, ncm, islur, &commvl_1.nvmx[*iv - 1], &
commvl_1.ivx, nv);
-#line 7110 ""
+#line 7100 ""
stemup = *(unsigned char *)&ch__1[0] == 'u';
-#line 7111 ""
+#line 7101 ""
}
-#line 7112 ""
+#line 7102 ""
iscrd = bit_test(*ipl,10);
-#line 7113 ""
+#line 7103 ""
if (bit_test(*islur,1)) {
/* 't'-slur (idcode=1) somewhere on this note. Find it, check height against */
/* 's'-slur (idcode=32) */
-#line 7118 ""
+#line 7108 ""
sfound = FALSE_;
-#line 7119 ""
+#line 7109 ""
tfound = FALSE_;
-#line 7120 ""
+#line 7110 ""
tmove = FALSE_;
-#line 7121 ""
+#line 7111 ""
i__1 = *nsdat;
-#line 7121 ""
+#line 7111 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
-#line 7122 ""
+#line 7112 ""
if (*iv == igetbits_(&isdat1[isdat], &c__5, &c__13) && *ip ==
igetbits_(&isdat1[isdat], &c__8, &c__3) && *kv ==
igetbits_(&isdat1[isdat], &c__1, &c__12) + 1) {
-#line 7125 ""
+#line 7115 ""
if (! tfound) {
-#line 7126 ""
+#line 7116 ""
tfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 1;
-#line 7127 ""
+#line 7117 ""
if (tfound) {
-#line 7128 ""
+#line 7118 ""
nolevt = igetbits_(&isdat2[isdat], &c__7, &c__19);
-#line 7129 ""
+#line 7119 ""
isdatt = isdat;
-#line 7130 ""
+#line 7120 ""
if (sfound) {
-#line 7130 ""
+#line 7120 ""
goto L6;
-#line 7130 ""
+#line 7120 ""
}
-#line 7131 ""
+#line 7121 ""
}
-#line 7132 ""
+#line 7122 ""
}
-#line 7133 ""
+#line 7123 ""
if (! sfound) {
-#line 7134 ""
+#line 7124 ""
sfound = igetbits_(&isdat1[isdat], &c__7, &c__19) == 32;
-#line 7135 ""
+#line 7125 ""
if (sfound) {
-#line 7136 ""
+#line 7126 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
-#line 7137 ""
+#line 7127 ""
isdats = isdat;
-#line 7138 ""
+#line 7128 ""
if (tfound) {
-#line 7138 ""
+#line 7128 ""
goto L6;
-#line 7138 ""
+#line 7128 ""
}
-#line 7139 ""
+#line 7129 ""
}
-#line 7140 ""
+#line 7130 ""
}
-#line 7141 ""
+#line 7131 ""
}
-#line 7142 ""
+#line 7132 ""
/* L5: */
-#line 7142 ""
+#line 7132 ""
}
/* Will come thru here if there is a t with no s, so comment out the following */
/* print*,'Did not find s+t-slurs in doslur' */
-#line 7147 ""
+#line 7137 ""
L6:
-#line 7148 ""
+#line 7138 ""
if (sfound && tfound) {
-#line 7148 ""
+#line 7138 ""
tmove = nolevs == nolevt && (bit_test(isdat1[isdats],11) &&
bit_test(isdat1[isdatt],11) || ! bit_test(isdat1[isdats],
11) && ! bit_test(isdat1[isdatt],11));
-#line 7148 ""
+#line 7138 ""
}
/* Check if 2 starts or two stops */
@@ -17289,229 +17287,229 @@ L6:
/* This is a flag for later changing slur level, after we know slur dir'n. */
-#line 7159 ""
+#line 7149 ""
}
-#line 7160 ""
+#line 7150 ""
if (commidi_1.ismidi) {
-#line 7161 ""
+#line 7151 ""
settie = FALSE_;
-#line 7162 ""
+#line 7152 ""
comslm_1.dbltie = FALSE_;
-#line 7163 ""
+#line 7153 ""
}
-#line 7164 ""
+#line 7154 ""
i__1 = *nsdat;
-#line 7164 ""
+#line 7154 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
-#line 7165 ""
+#line 7155 ""
isdata = isdat1[isdat];
-#line 7166 ""
+#line 7156 ""
if (*iv == igetbits_(&isdata, &c__5, &c__13) && *ip == igetbits_(&
isdata, &c__8, &c__3) && *kv == igetbits_(&isdata, &c__1, &
c__12) + 1) {
/* Since iv and kv match, ivx will be correct */
-#line 7172 ""
+#line 7162 ""
idcode = igetbits_(&isdata, &c__7, &c__19);
-#line 7173 ""
+#line 7163 ""
ivoff = igetbits_(&isdat2[isdat], &c__6, &c__6) - 32;
-#line 7174 ""
+#line 7164 ""
ihoff = igetbits_(&isdat2[isdat], &c__7, &c__12) - 64;
-#line 7175 ""
+#line 7165 ""
iupdn = 0;
-#line 7176 ""
+#line 7166 ""
*(unsigned char *)slurudq = 'd';
-#line 7177 ""
+#line 7167 ""
nolevs = igetbits_(&isdat2[isdat], &c__7, &c__19);
-#line 7178 ""
+#line 7168 ""
if (bit_test(isdata,11)) {
/* Turnon, */
-#line 7182 ""
+#line 7172 ""
if (nolevs == 0 || nolevs > 60) {
/* Note was a rest, cannot start slur on rest. */
-#line 7186 ""
+#line 7176 ""
s_wsle(&io___509);
-#line 7186 ""
+#line 7176 ""
e_wsle();
-#line 7187 ""
+#line 7177 ""
printl_("Cannot start slur on a rest", (ftnlen)27);
-#line 7188 ""
+#line 7178 ""
stop1_();
-#line 7189 ""
+#line 7179 ""
}
/* Get slur direction */
-#line 7193 ""
+#line 7183 ""
if (bit_test(isdata,26)) {
/* Force slur direction */
-#line 7197 ""
+#line 7187 ""
if (bit_test(isdata,27)) {
-#line 7197 ""
+#line 7187 ""
*(unsigned char *)slurudq = 'u';
-#line 7197 ""
+#line 7187 ""
}
-#line 7198 ""
+#line 7188 ""
} else if (commvl_1.nvmx[*iv - 1] == 1) {
/* Only one voice per line */
-#line 7202 ""
+#line 7192 ""
if (! (*beamon)) {
/* Separate note. */
-#line 7206 ""
+#line 7196 ""
udfq_(ch__1, (ftnlen)1, nolev, ncm);
-#line 7206 ""
+#line 7196 ""
*(unsigned char *)slurudq = *(unsigned char *)&ch__1[
0];
-#line 7207 ""
+#line 7197 ""
} else {
/* In a beam */
-#line 7211 ""
+#line 7201 ""
if (*(unsigned char *)ulq != 'u') {
-#line 7211 ""
+#line 7201 ""
*(unsigned char *)slurudq = 'u';
-#line 7211 ""
+#line 7201 ""
}
-#line 7212 ""
+#line 7202 ""
}
-#line 7213 ""
+#line 7203 ""
if (iscrd) {
-#line 7214 ""
+#line 7204 ""
if (nolevs > *ncm) {
-#line 7215 ""
+#line 7205 ""
*(unsigned char *)slurudq = 'u';
-#line 7216 ""
+#line 7206 ""
} else {
-#line 7217 ""
+#line 7207 ""
*(unsigned char *)slurudq = 'd';
-#line 7218 ""
+#line 7208 ""
}
-#line 7219 ""
+#line 7209 ""
}
-#line 7220 ""
+#line 7210 ""
} else {
/* Two voices per line. Get default */
-#line 7224 ""
+#line 7214 ""
if (commvl_1.ivx > *nv) {
-#line 7224 ""
+#line 7214 ""
*(unsigned char *)slurudq = 'u';
-#line 7224 ""
+#line 7214 ""
}
/* Upper voice of the two, so up slur */
-#line 7228 ""
+#line 7218 ""
}
/* Save up/down-ness for use at termination */
-#line 7232 ""
+#line 7222 ""
if (*(unsigned char *)slurudq == 'u') {
-#line 7232 ""
+#line 7222 ""
isdata = bit_set(isdata,27);
-#line 7232 ""
+#line 7222 ""
}
/* End of section for setting slur direction, still in "Turnon" if-block. */
-#line 7236 ""
+#line 7226 ""
if (idcode == 1 && tmove) {
-#line 7237 ""
+#line 7227 ""
iupdn = 1;
-#line 7238 ""
+#line 7228 ""
if (*(unsigned char *)slurudq == 'd') {
-#line 7238 ""
+#line 7228 ""
iupdn = -1;
-#line 7238 ""
+#line 7228 ""
}
-#line 7239 ""
+#line 7229 ""
}
-#line 7240 ""
+#line 7230 ""
if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
/* Raise or lower slur by one unit provided . or _ is on same side as slur */
-#line 7244 ""
+#line 7234 ""
ivoffinc = 0;
-#line 7245 ""
+#line 7235 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
/* Must move the slur for _ or . */
-#line 7250 ""
+#line 7240 ""
if (stemup) {
-#line 7251 ""
+#line 7241 ""
ivoffinc = -1;
-#line 7252 ""
+#line 7242 ""
} else {
-#line 7253 ""
+#line 7243 ""
ivoffinc = 1;
-#line 7254 ""
+#line 7244 ""
}
-#line 7255 ""
+#line 7245 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
-#line 7255 ""
+#line 7245 ""
ivoffinc <<= 1;
-#line 7255 ""
+#line 7245 ""
}
-#line 7258 ""
+#line 7248 ""
ivoff += ivoffinc;
-#line 7259 ""
+#line 7249 ""
}
-#line 7260 ""
+#line 7250 ""
}
-#line 7261 ""
+#line 7251 ""
if (comslur_1.listslur == 16777215) {
-#line 7262 ""
+#line 7252 ""
s_wsle(&io___511);
-#line 7262 ""
+#line 7252 ""
e_wsle();
-#line 7263 ""
+#line 7253 ""
s_wsle(&io___512);
-#line 7263 ""
+#line 7253 ""
do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur"\
", one too many!", (ftnlen)49);
-#line 7263 ""
+#line 7253 ""
e_wsle();
-#line 7264 ""
+#line 7254 ""
s_wsfe(&io___513);
-#line 7264 ""
+#line 7254 ""
do_fio(&c__1, "You2 defined the twenty-fifth slur, one t"\
"oo many!", (ftnlen)49);
-#line 7264 ""
+#line 7254 ""
e_wsfe();
-#line 7266 ""
+#line 7256 ""
stop1_();
-#line 7267 ""
+#line 7257 ""
}
/* Get index of next slur not in use, starting from ? down */
-#line 7271 ""
+#line 7261 ""
i__2 = 16777215 - comslur_1.listslur;
-#line 7271 ""
+#line 7261 ""
comslur_1.ndxslur = log2_(&i__2);
/* Record slur index */
-#line 7275 ""
+#line 7265 ""
comslur_1.listslur = bit_set(comslur_1.listslur,
comslur_1.ndxslur);
@@ -17519,149 +17517,149 @@ L6:
/* call setbits(isdata,4,28,ndxslur) */
/* 080531 Allow >16 slurs */
-#line 7281 ""
+#line 7271 ""
i__2 = comslur_1.ndxslur % 16;
-#line 7281 ""
+#line 7271 ""
setbits_(&isdata, &c__4, &c__28, &i__2);
-#line 7282 ""
+#line 7272 ""
i__2 = comslur_1.ndxslur / 16;
-#line 7282 ""
+#line 7272 ""
setbits_(&isdata, &c__1, &c__18, &i__2);
/* Shift for stem? */
-#line 7286 ""
+#line 7276 ""
if (stemup && *(unsigned char *)slurudq == 'u' && *tno < 63.f)
{
-#line 7286 ""
+#line 7276 ""
ihoff += 8;
-#line 7286 ""
+#line 7276 ""
}
-#line 7288 ""
+#line 7278 ""
if (bit_test(isdat2[isdat],3)) {
/* Tie spacing, (slur start) */
-#line 7292 ""
+#line 7282 ""
if (*(unsigned char *)slurudq == 'd') {
-#line 7293 ""
+#line 7283 ""
++ivoff;
-#line 7294 ""
+#line 7284 ""
ihoff += 8;
-#line 7295 ""
+#line 7285 ""
} else if (*(unsigned char *)slurudq == 'u') {
-#line 7296 ""
+#line 7286 ""
--ivoff;
-#line 7297 ""
+#line 7287 ""
if (! (stemup && *tno < 63.f)) {
-#line 7297 ""
+#line 7287 ""
ihoff += 8;
-#line 7297 ""
+#line 7287 ""
}
/* (already shifted if (stemup.and.tno.gt.63.) and slurudq='u') */
-#line 7301 ""
+#line 7291 ""
}
-#line 7302 ""
+#line 7292 ""
}
-#line 7303 ""
+#line 7293 ""
if (iscrd) {
/* Additional horiz shifts for h-shifted noteheads? */
-#line 7307 ""
+#line 7297 ""
if (bit_test(isdat2[isdat],1)) {
/* Slur start on left-shifted chord notehead. ASSUME downstem. */
-#line 7311 ""
+#line 7301 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
-#line 7312 ""
+#line 7302 ""
ihoff += -2;
-#line 7313 ""
+#line 7303 ""
} else {
-#line 7314 ""
+#line 7304 ""
ihoff += -10;
-#line 7315 ""
+#line 7305 ""
}
-#line 7316 ""
+#line 7306 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
-#line 7320 ""
+#line 7310 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
-#line 7321 ""
+#line 7311 ""
ihoff += 2;
-#line 7322 ""
+#line 7312 ""
} else {
-#line 7323 ""
+#line 7313 ""
ihoff += 10;
-#line 7324 ""
+#line 7314 ""
}
-#line 7325 ""
+#line 7315 ""
}
-#line 7326 ""
+#line 7316 ""
}
-#line 7327 ""
+#line 7317 ""
if (ihoff == 0) {
/* Write stuff for non-shifted start */
/* Writing concatenation */
-#line 7331 ""
+#line 7321 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7331 ""
+#line 7321 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 7331 ""
+#line 7321 ""
i__3[1] = 5, a__1[1] = "islur";
-#line 7331 ""
+#line 7321 ""
i__3[2] = 1, a__1[2] = slurudq;
-#line 7331 ""
+#line 7321 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 7332 ""
+#line 7322 ""
lnote = 7;
-#line 7333 ""
+#line 7323 ""
} else {
/* Writing concatenation */
-#line 7334 ""
+#line 7324 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7334 ""
+#line 7324 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 7334 ""
+#line 7324 ""
i__3[1] = 2, a__1[1] = "is";
-#line 7334 ""
+#line 7324 ""
i__3[2] = 1, a__1[2] = slurudq;
-#line 7334 ""
+#line 7324 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 7335 ""
+#line 7325 ""
lnote = 4;
-#line 7336 ""
+#line 7326 ""
}
-#line 7337 ""
+#line 7327 ""
if (bit_test(isdat2[isdat],4)) {
/* Dotted slur */
-#line 7341 ""
+#line 7331 ""
s_copy(noteq, notexq, (ftnlen)8, (ftnlen)79);
/* Writing concatenation */
-#line 7342 ""
+#line 7332 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7342 ""
+#line 7332 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 7342 ""
+#line 7332 ""
i__3[1] = 6, a__1[1] = "dotted";
-#line 7342 ""
+#line 7332 ""
i__3[2] = 8, a__1[2] = noteq;
-#line 7342 ""
+#line 7332 ""
s_cat(notexq, a__1, i__3, &c__3, (ftnlen)79);
-#line 7343 ""
+#line 7333 ""
lnote += 7;
-#line 7344 ""
+#line 7334 ""
}
/* Add slur index to string */
@@ -17669,250 +17667,250 @@ L6:
/* Print 23-ndxslur */
/* if (11-ndxslur .lt. 10) then */
-#line 7351 ""
+#line 7341 ""
if (23 - comslur_1.ndxslur < 10) {
/* 5/25/08 Allow 24 slurs */
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
/* Writing concatenation */
-#line 7356 ""
+#line 7346 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7356 ""
+#line 7346 ""
i__2 = 71 - comslur_1.ndxslur;
-#line 7356 ""
+#line 7346 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7356 ""
+#line 7346 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 7356 ""
+#line 7346 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7357 ""
+#line 7347 ""
++lnote;
-#line 7358 ""
+#line 7348 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
-#line 7360 ""
+#line 7350 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 7360 ""
+#line 7350 ""
i__5[1] = 2, a__3[1] = "{1";
-#line 7360 ""
+#line 7350 ""
i__2 = 61 - comslur_1.ndxslur;
-#line 7360 ""
+#line 7350 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7360 ""
+#line 7350 ""
i__5[2] = 1, a__3[2] = ch__1;
-#line 7360 ""
+#line 7350 ""
i__5[3] = 1, a__3[3] = "}";
-#line 7360 ""
+#line 7350 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
-#line 7361 ""
+#line 7351 ""
lnote += 4;
-#line 7362 ""
+#line 7352 ""
} else {
/* Writing concatenation */
-#line 7363 ""
+#line 7353 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 7363 ""
+#line 7353 ""
i__5[1] = 2, a__3[1] = "{2";
-#line 7363 ""
+#line 7353 ""
i__2 = 51 - comslur_1.ndxslur;
-#line 7363 ""
+#line 7353 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7363 ""
+#line 7353 ""
i__5[2] = 1, a__3[2] = ch__1;
-#line 7363 ""
+#line 7353 ""
i__5[3] = 1, a__3[3] = "}";
-#line 7363 ""
+#line 7353 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
-#line 7364 ""
+#line 7354 ""
lnote += 4;
-#line 7365 ""
+#line 7355 ""
}
/* Add note name to string */
-#line 7369 ""
+#line 7359 ""
i__2 = nolevs + iupdn + ivoff;
-#line 7369 ""
+#line 7359 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
/* Writing concatenation */
-#line 7370 ""
+#line 7360 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7370 ""
+#line 7360 ""
i__4[1] = lnoten, a__2[1] = noteq;
-#line 7370 ""
+#line 7360 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7371 ""
+#line 7361 ""
lnote += lnoten;
/* Save height (for ornament and barnobox interference) if topmost slur is up */
-#line 7375 ""
+#line 7365 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
-#line 7377 ""
+#line 7367 ""
*islhgt = nolevs + iupdn + ivoff;
/* Save height & idcode if top voice and slur start */
-#line 7381 ""
+#line 7371 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && *islhgt > comsln_1.is1n1) {
-#line 7382 ""
+#line 7372 ""
comsln_1.is1n1 = *islhgt;
-#line 7383 ""
+#line 7373 ""
comsln_1.is2n1 = idcode;
-#line 7384 ""
+#line 7374 ""
}
-#line 7385 ""
+#line 7375 ""
}
-#line 7386 ""
+#line 7376 ""
if ((real) ihoff != 0.f) {
-#line 7387 ""
+#line 7377 ""
shift = ihoff * .1f;
/* Writing concatenation */
-#line 7388 ""
+#line 7378 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7388 ""
+#line 7378 ""
i__4[1] = 1, a__2[1] = "{";
-#line 7388 ""
+#line 7378 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7389 ""
+#line 7379 ""
++lnote;
-#line 7390 ""
+#line 7380 ""
lform = lfmt1_(&shift);
-#line 7391 ""
+#line 7381 ""
i__2 = lnote;
-#line 7391 ""
+#line 7381 ""
ici__1.icierr = 0;
-#line 7391 ""
+#line 7381 ""
ici__1.icirnum = 1;
-#line 7391 ""
+#line 7381 ""
ici__1.icirlen = lnote + lform - i__2;
-#line 7391 ""
+#line 7381 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 7391 ""
+#line 7381 ""
i__3[0] = 2, a__1[0] = "(f";
-#line 7391 ""
+#line 7381 ""
i__6 = lform + 48;
-#line 7391 ""
+#line 7381 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 7391 ""
+#line 7381 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 7391 ""
+#line 7381 ""
i__3[2] = 3, a__1[2] = ".1)";
-#line 7391 ""
+#line 7381 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
6), ch__2);
-#line 7391 ""
+#line 7381 ""
s_wsfi(&ici__1);
-#line 7391 ""
+#line 7381 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
-#line 7391 ""
+#line 7381 ""
e_wsfi();
-#line 7393 ""
+#line 7383 ""
lnote += lform;
/* Writing concatenation */
-#line 7394 ""
+#line 7384 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7394 ""
+#line 7384 ""
i__4[1] = 1, a__2[1] = "}";
-#line 7394 ""
+#line 7384 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7395 ""
+#line 7385 ""
++lnote;
-#line 7396 ""
+#line 7386 ""
}
-#line 7397 ""
+#line 7387 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Zero out ip1 to avoid problems if slur goes to next input blk. */
-#line 7401 ""
+#line 7391 ""
setbits_(&isdata, &c__8, &c__3, &c__0);
/* Set slur-on data for midi. Only treat null-index slurs and ps ties for now. */
-#line 7405 ""
+#line 7395 ""
if (commidi_1.ismidi && idcode == 32) {
-#line 7406 ""
+#line 7396 ""
comslm_1.levson[commidi_1.midchan[*iv + *kv * 24 - 25]] =
nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1];
-#line 7407 ""
+#line 7397 ""
if (settie) {
-#line 7407 ""
+#line 7397 ""
comslm_1.dbltie = TRUE_;
-#line 7407 ""
+#line 7397 ""
}
/* Only way settie=T is if we just set a tie ending. So there's also a slur */
/* start here, so set a flag telling addmidi not to zero out levson */
-#line 7412 ""
+#line 7402 ""
}
-#line 7413 ""
+#line 7403 ""
} else {
/* Slur is ending. Back thru list to find starting slur */
-#line 7417 ""
+#line 7407 ""
for (j = isdat - 1; j >= 1; --j) {
-#line 7418 ""
+#line 7408 ""
if (*iv == igetbits_(&isdat1[j], &c__5, &c__13) && *kv ==
igetbits_(&isdat1[j], &c__1, &c__12) + 1) {
-#line 7420 ""
+#line 7410 ""
if (idcode == igetbits_(&isdat1[j], &c__7, &c__19)) {
-#line 7421 ""
+#line 7411 ""
comslur_1.ndxslur = igetbits_(&isdat1[j], &c__4, &
c__28) + (igetbits_(&isdat1[j], &c__1, &
c__18) << 4);
/* 080531 Allow >16 slurs */
-#line 7426 ""
+#line 7416 ""
if (bit_test(isdat1[j],27)) {
-#line 7426 ""
+#line 7416 ""
*(unsigned char *)slurudq = 'u';
-#line 7426 ""
+#line 7416 ""
}
-#line 7427 ""
+#line 7417 ""
goto L4;
-#line 7428 ""
+#line 7418 ""
}
-#line 7429 ""
+#line 7419 ""
}
-#line 7430 ""
+#line 7420 ""
/* L3: */
-#line 7430 ""
+#line 7420 ""
}
-#line 7431 ""
+#line 7421 ""
s_wsle(&io___521);
-#line 7431 ""
+#line 7421 ""
do_lio(&c__9, &c__1, "Bad place in doslur", (ftnlen)19);
-#line 7431 ""
+#line 7421 ""
e_wsle();
-#line 7432 ""
+#line 7422 ""
stop1_();
-#line 7433 ""
+#line 7423 ""
L4:
-#line 7434 ""
+#line 7424 ""
if (nolevs == 0 || nolevs > 60) {
/* Ending is on a rest, reset nolevs to default starting height */
-#line 7438 ""
+#line 7428 ""
nolevs = igetbits_(&isdat2[j], &c__7, &c__19);
-#line 7439 ""
+#line 7429 ""
}
-#line 7440 ""
+#line 7430 ""
if (bit_test(isdat3[isdat],0)) {
/* Deal with \curve or \midslur */
-#line 7444 ""
+#line 7434 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
/* Remember, only dealing with non-ps slurs */
@@ -17922,598 +17920,598 @@ L4:
/* if (slurudq .eq. 'd') imid = -imid */
/* 3/8/03 added the following */
-#line 7453 ""
+#line 7443 ""
if (*(unsigned char *)slurudq == 'd') {
-#line 7453 ""
+#line 7443 ""
imid = -abs(imid);
-#line 7453 ""
+#line 7443 ""
}
-#line 7455 ""
+#line 7445 ""
if (bit_test(isdat3[isdat],1)) {
/* Writing concatenation */
-#line 7456 ""
+#line 7446 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7456 ""
+#line 7446 ""
i__4[0] = 1, a__2[0] = ch__1;
-#line 7456 ""
+#line 7446 ""
i__4[1] = 5, a__2[1] = "curve";
-#line 7456 ""
+#line 7446 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7457 ""
+#line 7447 ""
lnote = 6;
-#line 7458 ""
+#line 7448 ""
} else {
/* Writing concatenation */
-#line 7459 ""
+#line 7449 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7459 ""
+#line 7449 ""
i__4[0] = 1, a__2[0] = ch__1;
-#line 7459 ""
+#line 7449 ""
i__4[1] = 7, a__2[1] = "midslur";
-#line 7459 ""
+#line 7449 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7460 ""
+#line 7450 ""
lnote = 8;
-#line 7461 ""
+#line 7451 ""
}
-#line 7462 ""
+#line 7452 ""
if (imid < 0 || imid > 9) {
/* Need brackets */
/* Writing concatenation */
-#line 7466 ""
+#line 7456 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7466 ""
+#line 7456 ""
i__4[1] = 1, a__2[1] = "{";
-#line 7466 ""
+#line 7456 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7467 ""
+#line 7457 ""
++lnote;
-#line 7468 ""
+#line 7458 ""
if (imid < -9) {
-#line 7469 ""
+#line 7459 ""
i__2 = lnote;
-#line 7469 ""
+#line 7459 ""
ici__1.icierr = 0;
-#line 7469 ""
+#line 7459 ""
ici__1.icirnum = 1;
-#line 7469 ""
+#line 7459 ""
ici__1.icirlen = lnote + 3 - i__2;
-#line 7469 ""
+#line 7459 ""
ici__1.iciunit = notexq + i__2;
-#line 7469 ""
+#line 7459 ""
ici__1.icifmt = "(i3)";
-#line 7469 ""
+#line 7459 ""
s_wsfi(&ici__1);
-#line 7469 ""
+#line 7459 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
-#line 7469 ""
+#line 7459 ""
e_wsfi();
-#line 7470 ""
+#line 7460 ""
lnote += 3;
-#line 7471 ""
+#line 7461 ""
} else if (imid < 0 || imid > 9) {
-#line 7472 ""
+#line 7462 ""
i__2 = lnote;
-#line 7472 ""
+#line 7462 ""
ici__1.icierr = 0;
-#line 7472 ""
+#line 7462 ""
ici__1.icirnum = 1;
-#line 7472 ""
+#line 7462 ""
ici__1.icirlen = lnote + 2 - i__2;
-#line 7472 ""
+#line 7462 ""
ici__1.iciunit = notexq + i__2;
-#line 7472 ""
+#line 7462 ""
ici__1.icifmt = "(i2)";
-#line 7472 ""
+#line 7462 ""
s_wsfi(&ici__1);
-#line 7472 ""
+#line 7462 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
-#line 7472 ""
+#line 7462 ""
e_wsfi();
-#line 7473 ""
+#line 7463 ""
lnote += 2;
-#line 7474 ""
+#line 7464 ""
} else {
-#line 7475 ""
+#line 7465 ""
i__2 = lnote;
-#line 7475 ""
+#line 7465 ""
ici__1.icierr = 0;
-#line 7475 ""
+#line 7465 ""
ici__1.icirnum = 1;
-#line 7475 ""
+#line 7465 ""
ici__1.icirlen = lnote + 1 - i__2;
-#line 7475 ""
+#line 7465 ""
ici__1.iciunit = notexq + i__2;
-#line 7475 ""
+#line 7465 ""
ici__1.icifmt = "(i1)";
-#line 7475 ""
+#line 7465 ""
s_wsfi(&ici__1);
-#line 7475 ""
+#line 7465 ""
do_fio(&c__1, (char *)&imid, (ftnlen)sizeof(
integer));
-#line 7475 ""
+#line 7465 ""
e_wsfi();
-#line 7476 ""
+#line 7466 ""
++lnote;
-#line 7477 ""
+#line 7467 ""
}
/* Writing concatenation */
-#line 7478 ""
+#line 7468 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7478 ""
+#line 7468 ""
i__4[1] = 1, a__2[1] = "}";
-#line 7478 ""
+#line 7468 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7479 ""
+#line 7469 ""
++lnote;
-#line 7480 ""
+#line 7470 ""
} else {
/* 1=<imid=<9, no brackets */
/* Writing concatenation */
-#line 7484 ""
+#line 7474 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7484 ""
+#line 7474 ""
*(unsigned char *)&ch__1[0] = imid + 48;
-#line 7484 ""
+#line 7474 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 7484 ""
+#line 7474 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7485 ""
+#line 7475 ""
++lnote;
-#line 7486 ""
+#line 7476 ""
}
-#line 7487 ""
+#line 7477 ""
if (bit_test(isdat3[isdat],1)) {
/* \curve; 3 args */
/* Writing concatenation */
-#line 7491 ""
+#line 7481 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7491 ""
+#line 7481 ""
*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
, &c__3, &c__8) + 48;
-#line 7491 ""
+#line 7481 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 7491 ""
+#line 7481 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
/* Writing concatenation */
-#line 7493 ""
+#line 7483 ""
i__4[0] = lnote + 1, a__2[0] = notexq;
-#line 7493 ""
+#line 7483 ""
*(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat]
, &c__3, &c__11) + 48;
-#line 7493 ""
+#line 7483 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 7493 ""
+#line 7483 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7495 ""
+#line 7485 ""
lnote += 2;
-#line 7496 ""
+#line 7486 ""
}
-#line 7497 ""
+#line 7487 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)
80);
-#line 7498 ""
+#line 7488 ""
}
/* Shift slur ending for stem on any note? */
-#line 7502 ""
+#line 7492 ""
if (! stemup && *(unsigned char *)slurudq == 'd' && *tno <
63.f) {
-#line 7502 ""
+#line 7492 ""
ihoff += -8;
-#line 7502 ""
+#line 7492 ""
}
-#line 7504 ""
+#line 7494 ""
if (bit_test(isdat2[isdat],3)) {
/* Shift ending for tie spacing */
-#line 7508 ""
+#line 7498 ""
if (*(unsigned char *)slurudq == 'u') {
-#line 7509 ""
+#line 7499 ""
ihoff += -8;
-#line 7510 ""
+#line 7500 ""
--ivoff;
-#line 7511 ""
+#line 7501 ""
} else if (*(unsigned char *)slurudq == 'd') {
-#line 7512 ""
+#line 7502 ""
++ivoff;
-#line 7513 ""
+#line 7503 ""
if (stemup || *tno > 63.f) {
-#line 7513 ""
+#line 7503 ""
ihoff += -8;
-#line 7513 ""
+#line 7503 ""
}
-#line 7514 ""
+#line 7504 ""
}
-#line 7515 ""
+#line 7505 ""
}
-#line 7516 ""
+#line 7506 ""
if (iscrd) {
/* Shift termination for shifted notehead? */
-#line 7520 ""
+#line 7510 ""
if (bit_test(isdat2[isdat],1)) {
/* Left-shifted chord notehead. ASSUME downstem. */
-#line 7524 ""
+#line 7514 ""
if (nolevs == comtrill_1.minlev && *(unsigned char *)
slurudq == 'd') {
-#line 7525 ""
+#line 7515 ""
ihoff += -2;
-#line 7526 ""
+#line 7516 ""
} else {
-#line 7527 ""
+#line 7517 ""
ihoff += -10;
-#line 7528 ""
+#line 7518 ""
}
-#line 7529 ""
+#line 7519 ""
} else if (bit_test(isdat2[isdat],2)) {
/* Right shifted chord notehead. ASSUME upstem. */
-#line 7533 ""
+#line 7523 ""
if (nolevs == comtrill_1.maxlev && *(unsigned char *)
slurudq == 'u') {
-#line 7534 ""
+#line 7524 ""
ihoff += 2;
-#line 7535 ""
+#line 7525 ""
} else {
-#line 7536 ""
+#line 7526 ""
ihoff += 10;
-#line 7537 ""
+#line 7527 ""
}
-#line 7538 ""
+#line 7528 ""
}
-#line 7539 ""
+#line 7529 ""
}
-#line 7540 ""
+#line 7530 ""
if (ihoff == 0) {
/* Writing concatenation */
-#line 7541 ""
+#line 7531 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7541 ""
+#line 7531 ""
i__4[0] = 1, a__2[0] = ch__1;
-#line 7541 ""
+#line 7531 ""
i__4[1] = 5, a__2[1] = "tslur";
-#line 7541 ""
+#line 7531 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7542 ""
+#line 7532 ""
lnote = 6;
-#line 7543 ""
+#line 7533 ""
} else {
/* Shift needed */
/* Writing concatenation */
-#line 7547 ""
+#line 7537 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7547 ""
+#line 7537 ""
i__4[0] = 1, a__2[0] = ch__1;
-#line 7547 ""
+#line 7537 ""
i__4[1] = 2, a__2[1] = "ts";
-#line 7547 ""
+#line 7537 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7548 ""
+#line 7538 ""
lnote = 3;
-#line 7549 ""
+#line 7539 ""
}
/* Print 23-ndxslur */
/* 5/25/08 Allow 14 slurs (???????????) */
-#line 7554 ""
+#line 7544 ""
if (23 - comslur_1.ndxslur < 10) {
/* Writing concatenation */
-#line 7555 ""
+#line 7545 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7555 ""
+#line 7545 ""
i__2 = 71 - comslur_1.ndxslur;
-#line 7555 ""
+#line 7545 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7555 ""
+#line 7545 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 7555 ""
+#line 7545 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7556 ""
+#line 7546 ""
++lnote;
-#line 7557 ""
+#line 7547 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 7558 ""
+#line 7548 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 7558 ""
+#line 7548 ""
i__5[1] = 2, a__3[1] = "{1";
-#line 7558 ""
+#line 7548 ""
i__2 = 61 - comslur_1.ndxslur;
-#line 7558 ""
+#line 7548 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7558 ""
+#line 7548 ""
i__5[2] = 1, a__3[2] = ch__1;
-#line 7558 ""
+#line 7548 ""
i__5[3] = 1, a__3[3] = "}";
-#line 7558 ""
+#line 7548 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
-#line 7559 ""
+#line 7549 ""
lnote += 4;
-#line 7560 ""
+#line 7550 ""
} else {
/* Writing concatenation */
-#line 7561 ""
+#line 7551 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 7561 ""
+#line 7551 ""
i__5[1] = 2, a__3[1] = "{2";
-#line 7561 ""
+#line 7551 ""
i__2 = 51 - comslur_1.ndxslur;
-#line 7561 ""
+#line 7551 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7561 ""
+#line 7551 ""
i__5[2] = 1, a__3[2] = ch__1;
-#line 7561 ""
+#line 7551 ""
i__5[3] = 1, a__3[3] = "}";
-#line 7561 ""
+#line 7551 ""
s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79);
-#line 7562 ""
+#line 7552 ""
lnote += 4;
-#line 7563 ""
+#line 7553 ""
}
-#line 7564 ""
+#line 7554 ""
if (bit_test(*iornq,11) || bit_test(*iornq,12)) {
/* Raise or lower slur by one unit provided . or _ is on same side as slur */
-#line 7568 ""
+#line 7558 ""
ivoffinc = 0;
-#line 7569 ""
+#line 7559 ""
if (stemup && *(unsigned char *)slurudq == 'd' || !
stemup && *(unsigned char *)slurudq == 'u') {
-#line 7571 ""
+#line 7561 ""
if (stemup) {
-#line 7572 ""
+#line 7562 ""
ivoffinc = -1;
-#line 7573 ""
+#line 7563 ""
} else {
-#line 7574 ""
+#line 7564 ""
ivoffinc = 1;
-#line 7575 ""
+#line 7565 ""
}
-#line 7576 ""
+#line 7566 ""
if ((stemup && *nolev >= *ncm - 2 || ! stemup && *
nolev <= *ncm + 2) && (i__2 = *ncm - *nolev,
abs(i__2)) % 2 == 0) {
-#line 7576 ""
+#line 7566 ""
ivoffinc <<= 1;
-#line 7576 ""
+#line 7566 ""
}
-#line 7579 ""
+#line 7569 ""
}
-#line 7580 ""
+#line 7570 ""
ivoff += ivoffinc;
-#line 7581 ""
+#line 7571 ""
}
-#line 7582 ""
+#line 7572 ""
if (idcode == 1 && tmove) {
/* t-slur height adjustment */
-#line 7586 ""
+#line 7576 ""
iupdn = 1;
-#line 7587 ""
+#line 7577 ""
if (*(unsigned char *)slurudq == 'd') {
-#line 7587 ""
+#line 7577 ""
iupdn = -1;
-#line 7587 ""
+#line 7577 ""
}
-#line 7588 ""
+#line 7578 ""
}
-#line 7589 ""
+#line 7579 ""
i__2 = nolevs + iupdn + ivoff;
-#line 7589 ""
+#line 7579 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
-#line 7590 ""
+#line 7580 ""
if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[
isdat],0) || nolevs == comtrill_1.maxlev)) {
-#line 7592 ""
+#line 7582 ""
*islhgt = nolevs + iupdn + ivoff;
/* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */
-#line 7596 ""
+#line 7586 ""
if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv
- 1] * 24 - 25] && comsln_1.is1n1 > 0) {
-#line 7597 ""
+#line 7587 ""
if (idcode == comsln_1.is2n1) {
-#line 7597 ""
+#line 7587 ""
comsln_1.is1n1 = 0;
-#line 7597 ""
+#line 7587 ""
}
-#line 7598 ""
+#line 7588 ""
}
-#line 7599 ""
+#line 7589 ""
}
/* Writing concatenation */
-#line 7600 ""
+#line 7590 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7600 ""
+#line 7590 ""
i__4[1] = lnoten, a__2[1] = noteq;
-#line 7600 ""
+#line 7590 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7601 ""
+#line 7591 ""
lnote += lnoten;
-#line 7602 ""
+#line 7592 ""
if (ihoff != 0) {
-#line 7603 ""
+#line 7593 ""
shift = ihoff * .1f;
/* Writing concatenation */
-#line 7604 ""
+#line 7594 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7604 ""
+#line 7594 ""
i__4[1] = 1, a__2[1] = "{";
-#line 7604 ""
+#line 7594 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7605 ""
+#line 7595 ""
++lnote;
-#line 7606 ""
+#line 7596 ""
lform = lfmt1_(&shift);
-#line 7607 ""
+#line 7597 ""
i__2 = lnote;
-#line 7607 ""
+#line 7597 ""
ici__1.icierr = 0;
-#line 7607 ""
+#line 7597 ""
ici__1.icirnum = 1;
-#line 7607 ""
+#line 7597 ""
ici__1.icirlen = lnote + lform - i__2;
-#line 7607 ""
+#line 7597 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 7607 ""
+#line 7597 ""
i__3[0] = 2, a__1[0] = "(f";
-#line 7607 ""
+#line 7597 ""
i__6 = lform + 48;
-#line 7607 ""
+#line 7597 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 7607 ""
+#line 7597 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 7607 ""
+#line 7597 ""
i__3[2] = 3, a__1[2] = ".1)";
-#line 7607 ""
+#line 7597 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen)
6), ch__2);
-#line 7607 ""
+#line 7597 ""
s_wsfi(&ici__1);
-#line 7607 ""
+#line 7597 ""
do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real));
-#line 7607 ""
+#line 7597 ""
e_wsfi();
-#line 7609 ""
+#line 7599 ""
lnote += lform;
/* Writing concatenation */
-#line 7610 ""
+#line 7600 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 7610 ""
+#line 7600 ""
i__4[1] = 1, a__2[1] = "}";
-#line 7610 ""
+#line 7600 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 7611 ""
+#line 7601 ""
++lnote;
-#line 7612 ""
+#line 7602 ""
}
-#line 7613 ""
+#line 7603 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
/* Clear the bit from list of slurs in use */
-#line 7617 ""
+#line 7607 ""
comslur_1.listslur = bit_clear(comslur_1.listslur,
comslur_1.ndxslur);
/* Zero out the entire strings for start and stop */
-#line 7621 ""
+#line 7611 ""
isdata = 0;
-#line 7622 ""
+#line 7612 ""
isdat2[isdat] = 0;
-#line 7623 ""
+#line 7613 ""
isdat1[j] = 0;
-#line 7624 ""
+#line 7614 ""
isdat2[j] = 0;
-#line 7625 ""
+#line 7615 ""
isdat3[isdat] = 0;
/* Set midi info for slur ending */
-#line 7629 ""
+#line 7619 ""
if (commidi_1.ismidi && idcode == 32) {
-#line 7630 ""
+#line 7620 ""
icm = commidi_1.midchan[*iv + *kv * 24 - 25];
-#line 7631 ""
+#line 7621 ""
if (comslm_1.slmon[icm]) {
-#line 7632 ""
+#line 7622 ""
if (nolevs + commvel_1.miditran[cominsttrans_1.instno[
*iv - 1] - 1] == comslm_1.levson[icm] && (7 &
*nacc) == 0) {
/* There is a tie here. NB!!! assumed no accidental on 2nd member of tie. */
-#line 7637 ""
+#line 7627 ""
comslm_1.levsoff[icm] = nolevs +
commvel_1.miditran[cominsttrans_1.instno[*
iv - 1] - 1];
-#line 7638 ""
+#line 7628 ""
settie = TRUE_;
-#line 7639 ""
+#line 7629 ""
} else {
-#line 7640 ""
+#line 7630 ""
comslm_1.levsoff[icm] = 0;
-#line 7641 ""
+#line 7631 ""
comslm_1.levson[icm] = 0;
-#line 7642 ""
+#line 7632 ""
comslm_1.slmon[icm] = FALSE_;
-#line 7643 ""
+#line 7633 ""
}
-#line 7644 ""
+#line 7634 ""
}
-#line 7645 ""
+#line 7635 ""
}
-#line 7646 ""
+#line 7636 ""
}
-#line 7647 ""
+#line 7637 ""
isdat1[isdat] = isdata;
-#line 7648 ""
+#line 7638 ""
}
-#line 7649 ""
+#line 7639 ""
/* L1: */
-#line 7649 ""
+#line 7639 ""
}
/* Clear and collapse the slur data list */
-#line 7653 ""
+#line 7643 ""
numdrop = 0;
-#line 7654 ""
+#line 7644 ""
i__1 = *nsdat;
-#line 7654 ""
+#line 7644 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
-#line 7655 ""
+#line 7645 ""
if (isdat1[isdat] == 0) {
-#line 7656 ""
+#line 7646 ""
++numdrop;
-#line 7657 ""
+#line 7647 ""
} else if (numdrop > 0) {
-#line 7658 ""
+#line 7648 ""
isdat1[isdat - numdrop] = isdat1[isdat];
-#line 7659 ""
+#line 7649 ""
isdat2[isdat - numdrop] = isdat2[isdat];
-#line 7660 ""
+#line 7650 ""
isdat3[isdat - numdrop] = isdat3[isdat];
-#line 7661 ""
+#line 7651 ""
isdat1[isdat] = 0;
-#line 7662 ""
+#line 7652 ""
isdat2[isdat] = 0;
-#line 7663 ""
+#line 7653 ""
isdat3[isdat] = 0;
-#line 7664 ""
+#line 7654 ""
}
-#line 7665 ""
+#line 7655 ""
/* L2: */
-#line 7665 ""
+#line 7655 ""
}
-#line 7666 ""
+#line 7656 ""
*nsdat -= numdrop;
/* call report(nsdat,isdat1,isdat2) */
-#line 7668 ""
+#line 7658 ""
return 0;
} /* doslur_ */
@@ -18544,102 +18542,102 @@ L4:
/* iddot = 0 for single dot, 1 for double */
-#line 7676 ""
+#line 7666 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7676 ""
+#line 7666 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 7677 ""
+#line 7667 ""
lfmtup = lfmt1_(updot);
-#line 7678 ""
+#line 7668 ""
lfmtrt = lfmt1_(rtdot);
-#line 7679 ""
+#line 7669 ""
ici__1.icierr = 0;
-#line 7679 ""
+#line 7669 ""
ici__1.icirnum = 1;
-#line 7679 ""
+#line 7669 ""
ici__1.icirlen = 80;
-#line 7679 ""
+#line 7669 ""
ici__1.iciunit = notexq;
/* Writing concatenation */
-#line 7679 ""
+#line 7669 ""
i__1[0] = 6, a__1[0] = "(a37,f";
-#line 7679 ""
+#line 7669 ""
i__2 = lfmtup + 48;
-#line 7679 ""
+#line 7669 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7679 ""
+#line 7669 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 7679 ""
+#line 7669 ""
i__1[2] = 7, a__1[2] = ".1,a2,f";
-#line 7679 ""
+#line 7669 ""
i__3 = lfmtrt + 48;
-#line 7679 ""
+#line 7669 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7679 ""
+#line 7669 ""
i__1[3] = 1, a__1[3] = ch__3;
-#line 7679 ""
+#line 7669 ""
i__1[4] = 7, a__1[4] = ".1,a15)";
-#line 7679 ""
+#line 7669 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__5, (ftnlen)22), ch__2);
-#line 7679 ""
+#line 7669 ""
s_wsfi(&ici__1);
/* Writing concatenation */
-#line 7679 ""
+#line 7669 ""
i__4[0] = 1, a__2[0] = sq;
-#line 7679 ""
+#line 7669 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 7679 ""
+#line 7669 ""
i__4[2] = 1, a__2[2] = sq;
-#line 7679 ""
+#line 7669 ""
i__4[3] = 3, a__2[3] = "def";
-#line 7679 ""
+#line 7669 ""
i__4[4] = 1, a__2[4] = sq;
-#line 7679 ""
+#line 7669 ""
i__4[5] = 12, a__2[5] = "C@Point#1#2{";
-#line 7679 ""
+#line 7669 ""
i__4[6] = 1, a__2[6] = sq;
-#line 7679 ""
+#line 7669 ""
i__4[7] = 6, a__2[7] = "PMXpt{";
-#line 7679 ""
+#line 7669 ""
s_cat(ch__4, a__2, i__4, &c__8, (ftnlen)37);
-#line 7679 ""
+#line 7669 ""
do_fio(&c__1, ch__4, (ftnlen)37);
-#line 7679 ""
+#line 7669 ""
do_fio(&c__1, (char *)&(*updot), (ftnlen)sizeof(real));
-#line 7679 ""
+#line 7669 ""
do_fio(&c__1, "}{", (ftnlen)2);
-#line 7679 ""
+#line 7669 ""
do_fio(&c__1, (char *)&(*rtdot), (ftnlen)sizeof(real));
/* Writing concatenation */
-#line 7679 ""
+#line 7669 ""
i__5[0] = 1, a__3[0] = "}";
-#line 7679 ""
+#line 7669 ""
i__6 = *iddot + 48;
-#line 7679 ""
+#line 7669 ""
chax_(ch__6, (ftnlen)1, &i__6);
-#line 7679 ""
+#line 7669 ""
i__5[1] = 1, a__3[1] = ch__6;
-#line 7679 ""
+#line 7669 ""
i__5[2] = 1, a__3[2] = "}";
-#line 7679 ""
+#line 7669 ""
i__5[3] = 1, a__3[3] = sq;
-#line 7679 ""
+#line 7669 ""
i__5[4] = 11, a__3[4] = "makeatother";
-#line 7679 ""
+#line 7669 ""
s_cat(ch__5, a__3, i__5, &c__5, (ftnlen)15);
-#line 7679 ""
+#line 7669 ""
do_fio(&c__1, ch__5, (ftnlen)15);
-#line 7679 ""
+#line 7669 ""
e_wsfi();
/* Example of string just created: */
/* \makeatletter\def\C@Point#1#2{\PMXpt{.5}{.5}}\makeatother\ */
-#line 7688 ""
+#line 7678 ""
lnote = lfmtup + 54 + lfmtrt;
-#line 7689 ""
+#line 7679 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
-#line 7690 ""
+#line 7680 ""
return 0;
} /* dotmov_ */
@@ -18671,162 +18669,162 @@ L4:
static cilist io___531 = { 0, 6, 0, 0, 0 };
-#line 7700 ""
+#line 7690 ""
i__1 = comtrill_1.ntrill;
-#line 7700 ""
+#line 7690 ""
for (itr = 1; itr <= i__1; ++itr) {
-#line 7701 ""
+#line 7691 ""
if (*iv == comtrill_1.ivtrill[itr - 1] && *ip == comtrill_1.iptrill[
itr - 1]) {
-#line 7701 ""
+#line 7691 ""
goto L2;
-#line 7701 ""
+#line 7691 ""
}
-#line 7702 ""
+#line 7692 ""
/* L1: */
-#line 7702 ""
+#line 7692 ""
}
-#line 7703 ""
+#line 7693 ""
s_wsle(&io___531);
-#line 7703 ""
+#line 7693 ""
do_lio(&c__9, &c__1, "Problem in dotrill. Call Dr. Don", (ftnlen)33);
-#line 7703 ""
+#line 7693 ""
e_wsle();
-#line 7704 ""
+#line 7694 ""
s_stop("", (ftnlen)0);
-#line 7705 ""
+#line 7695 ""
L2:
-#line 7706 ""
+#line 7696 ""
tronly = comtrill_1.xnsktr[itr - 1] < .01f;
-#line 7707 ""
+#line 7697 ""
if (tronly) {
/* Writing concatenation */
-#line 7708 ""
+#line 7698 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7708 ""
+#line 7698 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 7708 ""
+#line 7698 ""
i__2[1] = 9, a__1[1] = "zcharnote";
-#line 7708 ""
+#line 7698 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 7709 ""
+#line 7699 ""
*lnote = 10;
-#line 7710 ""
+#line 7700 ""
} else if (bit_test(*iornq,7)) {
/* Writing concatenation */
-#line 7711 ""
+#line 7701 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7711 ""
+#line 7701 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 7711 ""
+#line 7701 ""
i__2[1] = 6, a__1[1] = "Trille";
-#line 7711 ""
+#line 7701 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 7712 ""
+#line 7702 ""
*lnote = 7;
-#line 7713 ""
+#line 7703 ""
} else {
/* Writing concatenation */
-#line 7714 ""
+#line 7704 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7714 ""
+#line 7704 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 7714 ""
+#line 7704 ""
i__2[1] = 6, a__1[1] = "trille";
-#line 7714 ""
+#line 7704 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 7715 ""
+#line 7705 ""
*lnote = 7;
-#line 7716 ""
+#line 7706 ""
}
/* Writing concatenation */
-#line 7717 ""
+#line 7707 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 7717 ""
+#line 7707 ""
i__3[1] = *lnoten, a__2[1] = noteq;
-#line 7717 ""
+#line 7707 ""
i__3[2] = 1, a__2[2] = "{";
-#line 7717 ""
+#line 7707 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 7718 ""
+#line 7708 ""
*lnote = *lnote + *lnoten + 1;
/* Write trill duration to nearest tenth of a noteskip */
-#line 7722 ""
+#line 7712 ""
if (tronly) {
/* Writing concatenation */
-#line 7723 ""
+#line 7713 ""
i__3[0] = *lnote, a__2[0] = notexq;
-#line 7723 ""
+#line 7713 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7723 ""
+#line 7713 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 7723 ""
+#line 7713 ""
i__3[2] = 6, a__2[2] = "it tr}";
-#line 7723 ""
+#line 7713 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 7724 ""
+#line 7714 ""
*lnote += 7;
-#line 7725 ""
+#line 7715 ""
return 0;
-#line 7726 ""
+#line 7716 ""
}
-#line 7727 ""
+#line 7717 ""
if (comtrill_1.xnsktr[itr - 1] < .95f) {
-#line 7728 ""
+#line 7718 ""
nfmt = 2;
-#line 7729 ""
+#line 7719 ""
} else if (comtrill_1.xnsktr[itr - 1] < 9.95f) {
-#line 7730 ""
+#line 7720 ""
nfmt = 3;
-#line 7731 ""
+#line 7721 ""
} else {
-#line 7732 ""
+#line 7722 ""
nfmt = 4;
-#line 7733 ""
+#line 7723 ""
}
-#line 7734 ""
+#line 7724 ""
i__1 = *lnote;
-#line 7734 ""
+#line 7724 ""
ici__1.icierr = 0;
-#line 7734 ""
+#line 7724 ""
ici__1.icirnum = 1;
-#line 7734 ""
+#line 7724 ""
ici__1.icirlen = *lnote + nfmt - i__1;
-#line 7734 ""
+#line 7724 ""
ici__1.iciunit = notexq + i__1;
/* Writing concatenation */
-#line 7734 ""
+#line 7724 ""
i__3[0] = 2, a__2[0] = "(f";
-#line 7734 ""
+#line 7724 ""
i__4 = nfmt + 48;
-#line 7734 ""
+#line 7724 ""
chax_(ch__1, (ftnlen)1, &i__4);
-#line 7734 ""
+#line 7724 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 7734 ""
+#line 7724 ""
i__3[2] = 3, a__2[2] = ".1)";
-#line 7734 ""
+#line 7724 ""
ici__1.icifmt = (s_cat(ch__2, a__2, i__3, &c__3, (ftnlen)6), ch__2);
-#line 7734 ""
+#line 7724 ""
s_wsfi(&ici__1);
-#line 7734 ""
+#line 7724 ""
do_fio(&c__1, (char *)&comtrill_1.xnsktr[itr - 1], (ftnlen)sizeof(real));
-#line 7734 ""
+#line 7724 ""
e_wsfi();
-#line 7736 ""
+#line 7726 ""
*lnote += nfmt;
/* Writing concatenation */
-#line 7737 ""
+#line 7727 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 7737 ""
+#line 7727 ""
i__2[1] = 1, a__1[1] = "}";
-#line 7737 ""
+#line 7727 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 7738 ""
+#line 7728 ""
++(*lnote);
-#line 7739 ""
+#line 7729 ""
return 0;
} /* dotrill_ */
@@ -18856,41 +18854,41 @@ L2:
/* Only called to end slur started in dograce. */
-#line 7751 ""
+#line 7741 ""
shift = ! (*stemup) && ! (*upslur);
-#line 7752 ""
+#line 7742 ""
if (! shift) {
/* No shift needed */
/* Writing concatenation */
-#line 7756 ""
+#line 7746 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7756 ""
+#line 7746 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 7756 ""
+#line 7746 ""
i__1[1] = 5, a__1[1] = "tslur";
-#line 7756 ""
+#line 7746 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7757 ""
+#line 7747 ""
lnote = 6;
-#line 7758 ""
+#line 7748 ""
} else {
/* Shift needed */
/* Writing concatenation */
-#line 7762 ""
+#line 7752 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 7762 ""
+#line 7752 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 7762 ""
+#line 7752 ""
i__1[1] = 2, a__1[1] = "ts";
-#line 7762 ""
+#line 7752 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7763 ""
+#line 7753 ""
lnote = 3;
-#line 7764 ""
+#line 7754 ""
}
/* if (ndxslur .lt. 10) then */
/* notexq = notexq(1:lnote)//chax(48+ndxslur) */
@@ -18904,105 +18902,105 @@ L2:
/* Print 23-ndxslur */
/* if (11-ndxslur .lt. 10) then */
-#line 7777 ""
+#line 7767 ""
if (23 - *ndxslur < 10) {
/* notexq = notexq(1:lnote)//chax(59-ndxslur) */
/* Writing concatenation */
-#line 7779 ""
+#line 7769 ""
i__1[0] = lnote, a__1[0] = notexq;
-#line 7779 ""
+#line 7769 ""
i__2 = 71 - *ndxslur;
-#line 7779 ""
+#line 7769 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7779 ""
+#line 7769 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 7779 ""
+#line 7769 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7780 ""
+#line 7770 ""
++lnote;
-#line 7781 ""
+#line 7771 ""
} else if (23 - *ndxslur < 20) {
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndxslur)//'}' */
/* Writing concatenation */
-#line 7783 ""
+#line 7773 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 7783 ""
+#line 7773 ""
i__3[1] = 2, a__2[1] = "{1";
-#line 7783 ""
+#line 7773 ""
i__2 = 61 - *ndxslur;
-#line 7783 ""
+#line 7773 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7783 ""
+#line 7773 ""
i__3[2] = 1, a__2[2] = ch__1;
-#line 7783 ""
+#line 7773 ""
i__3[3] = 1, a__2[3] = "}";
-#line 7783 ""
+#line 7773 ""
s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
-#line 7784 ""
+#line 7774 ""
lnote += 4;
-#line 7785 ""
+#line 7775 ""
} else {
/* Writing concatenation */
-#line 7786 ""
+#line 7776 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 7786 ""
+#line 7776 ""
i__3[1] = 2, a__2[1] = "{2";
-#line 7786 ""
+#line 7776 ""
i__2 = 51 - *ndxslur;
-#line 7786 ""
+#line 7776 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 7786 ""
+#line 7776 ""
i__3[2] = 1, a__2[2] = ch__1;
-#line 7786 ""
+#line 7776 ""
i__3[3] = 1, a__2[3] = "}";
-#line 7786 ""
+#line 7776 ""
s_cat(notexq, a__2, i__3, &c__4, (ftnlen)79);
-#line 7787 ""
+#line 7777 ""
lnote += 4;
-#line 7788 ""
+#line 7778 ""
}
-#line 7789 ""
+#line 7779 ""
i__2 = *nolev + *iupdn + *ivoff;
-#line 7789 ""
+#line 7779 ""
notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8);
/* Writing concatenation */
-#line 7790 ""
+#line 7780 ""
i__1[0] = lnote, a__1[0] = notexq;
-#line 7790 ""
+#line 7780 ""
i__1[1] = lnoten, a__1[1] = noteq;
-#line 7790 ""
+#line 7780 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7791 ""
+#line 7781 ""
lnote += lnoten;
-#line 7792 ""
+#line 7782 ""
if (shift) {
-#line 7793 ""
+#line 7783 ""
if (*fontslur) {
/* Writing concatenation */
-#line 7794 ""
+#line 7784 ""
i__1[0] = lnote, a__1[0] = notexq;
-#line 7794 ""
+#line 7784 ""
i__1[1] = 5, a__1[1] = "{-.6}";
-#line 7794 ""
+#line 7784 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7795 ""
+#line 7785 ""
} else {
/* Writing concatenation */
-#line 7796 ""
+#line 7786 ""
i__1[0] = lnote, a__1[0] = notexq;
-#line 7796 ""
+#line 7786 ""
i__1[1] = 5, a__1[1] = "{-.8}";
-#line 7796 ""
+#line 7786 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 7797 ""
+#line 7787 ""
}
-#line 7798 ""
+#line 7788 ""
lnote += 5;
-#line 7799 ""
+#line 7789 ""
}
-#line 7800 ""
+#line 7790 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80);
-#line 7801 ""
+#line 7791 ""
return 0;
} /* endslur_ */
@@ -19045,32 +19043,32 @@ L2:
static cilist io___553 = { 0, 15, 0, "(a)", 0 };
-#line 7813 ""
+#line 7803 ""
if (*iccount <= 78) {
-#line 7814 ""
+#line 7804 ""
s_copy(outq, lineq, (ftnlen)78, (ftnlen)78);
-#line 7815 ""
+#line 7805 ""
iposn = *iccount;
-#line 7816 ""
+#line 7806 ""
} else {
/* Writing concatenation */
-#line 7817 ""
+#line 7807 ""
i__1[0] = 4, a__1[0] = "... ";
-#line 7817 ""
+#line 7807 ""
i__1[1] = 74, a__1[1] = lineq + 54;
-#line 7817 ""
+#line 7807 ""
s_cat(outq, a__1, i__1, &c__2, (ftnlen)78);
-#line 7818 ""
+#line 7808 ""
iposn = *iccount - 50;
-#line 7819 ""
+#line 7809 ""
}
-#line 7820 ""
+#line 7810 ""
s_wsle(&io___541);
-#line 7820 ""
+#line 7810 ""
e_wsle();
-#line 7821 ""
+#line 7811 ""
ibarnop = *ibarno;
-#line 7822 ""
+#line 7812 ""
if (c1omget_1.linesinpmxmod == 0 || c1omget_1.nline >
c1omget_1.line1pmxmod + c1omget_1.linesinpmxmod) {
@@ -19078,299 +19076,299 @@ L2:
/* nlinep = nline-linesinpmxmod */
/* Correct for comments not copied into buffer */
-#line 7829 ""
+#line 7819 ""
nlinep = truelinecount_1.linewcom[c1omget_1.nline - 1] -
c1omget_1.linesinpmxmod;
-#line 7830 ""
+#line 7820 ""
} else {
/* Error is in include file */
-#line 7834 ""
+#line 7824 ""
ibarnop = 0;
-#line 7835 ""
+#line 7825 ""
nlinep = c1omget_1.nline - c1omget_1.line1pmxmod + 1;
-#line 7836 ""
+#line 7826 ""
printl_("ERROR in include file named above, description given below",
(ftnlen)58);
-#line 7838 ""
+#line 7828 ""
}
-#line 7839 ""
+#line 7829 ""
o__1.oerr = 0;
-#line 7839 ""
+#line 7829 ""
o__1.ounit = 19;
-#line 7839 ""
+#line 7829 ""
o__1.ofnmlen = 11;
-#line 7839 ""
+#line 7829 ""
o__1.ofnm = "pmxaerr.dat";
-#line 7839 ""
+#line 7829 ""
o__1.orl = 0;
-#line 7839 ""
+#line 7829 ""
o__1.osta = 0;
-#line 7839 ""
+#line 7829 ""
o__1.oacc = 0;
-#line 7839 ""
+#line 7829 ""
o__1.ofm = 0;
-#line 7839 ""
+#line 7829 ""
o__1.oblnk = 0;
-#line 7839 ""
+#line 7829 ""
f_open(&o__1);
-#line 7840 ""
+#line 7830 ""
s_wsfe(&io___544);
-#line 7840 ""
+#line 7830 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
-#line 7840 ""
+#line 7830 ""
e_wsfe();
-#line 7841 ""
+#line 7831 ""
cl__1.cerr = 0;
-#line 7841 ""
+#line 7831 ""
cl__1.cunit = 19;
-#line 7841 ""
+#line 7831 ""
cl__1.csta = 0;
-#line 7841 ""
+#line 7831 ""
f_clos(&cl__1);
/* Computing MAX */
-#line 7842 ""
+#line 7832 ""
r__1 = ibarnop + .1f;
-#line 7842 ""
+#line 7832 ""
i__2 = 1, i__3 = (integer) (r_lg10(&r__1) + 1);
-#line 7842 ""
+#line 7832 ""
ndigbn = max(i__2,i__3);
-#line 7843 ""
+#line 7833 ""
r__1 = nlinep + .1f;
-#line 7843 ""
+#line 7833 ""
ndignl = (integer) (r_lg10(&r__1) + 1);
-#line 7844 ""
+#line 7834 ""
lenmsg = i_indx(msgq, "!", msgq_len, (ftnlen)1) - 1;
/* Split off msgq(..) since UNIX compilers don't allow concat substring!!! */
-#line 7848 ""
+#line 7838 ""
ci__1.cierr = 0;
-#line 7848 ""
+#line 7838 ""
ci__1.ciunit = 6;
/* Writing concatenation */
-#line 7848 ""
+#line 7838 ""
i__4[0] = 8, a__2[0] = "(/,a15,i";
-#line 7848 ""
+#line 7838 ""
i__2 = ndignl + 48;
-#line 7848 ""
+#line 7838 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7848 ""
+#line 7838 ""
i__4[1] = 1, a__2[1] = ch__2;
-#line 7848 ""
+#line 7838 ""
i__4[2] = 5, a__2[2] = ",a6,i";
-#line 7848 ""
+#line 7838 ""
i__3 = ndigbn + 48;
-#line 7848 ""
+#line 7838 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7848 ""
+#line 7838 ""
i__4[3] = 1, a__2[3] = ch__3;
-#line 7848 ""
+#line 7838 ""
i__4[4] = 3, a__2[4] = ",$)";
-#line 7848 ""
+#line 7838 ""
ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
-#line 7848 ""
+#line 7838 ""
s_wsfe(&ci__1);
-#line 7848 ""
+#line 7838 ""
do_fio(&c__1, " ERROR in line ", (ftnlen)15);
-#line 7848 ""
+#line 7838 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
-#line 7848 ""
+#line 7838 ""
do_fio(&c__1, ", bar ", (ftnlen)6);
-#line 7848 ""
+#line 7838 ""
do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
-#line 7848 ""
+#line 7838 ""
e_wsfe();
-#line 7850 ""
+#line 7840 ""
s_wsfe(&io___548);
-#line 7850 ""
+#line 7840 ""
do_fio(&c__1, msgq, lenmsg);
-#line 7850 ""
+#line 7840 ""
e_wsfe();
-#line 7851 ""
+#line 7841 ""
ci__1.cierr = 0;
-#line 7851 ""
+#line 7841 ""
ci__1.ciunit = 15;
/* Writing concatenation */
-#line 7851 ""
+#line 7841 ""
i__4[0] = 8, a__2[0] = "(/,a15,i";
-#line 7851 ""
+#line 7841 ""
i__2 = ndignl + 48;
-#line 7851 ""
+#line 7841 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7851 ""
+#line 7841 ""
i__4[1] = 1, a__2[1] = ch__2;
-#line 7851 ""
+#line 7841 ""
i__4[2] = 5, a__2[2] = ",a6,i";
-#line 7851 ""
+#line 7841 ""
i__3 = ndigbn + 48;
-#line 7851 ""
+#line 7841 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7851 ""
+#line 7841 ""
i__4[3] = 1, a__2[3] = ch__3;
-#line 7851 ""
+#line 7841 ""
i__4[4] = 3, a__2[4] = ",$)";
-#line 7851 ""
+#line 7841 ""
ci__1.cifmt = (s_cat(ch__1, a__2, i__4, &c__5, (ftnlen)18), ch__1);
-#line 7851 ""
+#line 7841 ""
s_wsfe(&ci__1);
-#line 7851 ""
+#line 7841 ""
do_fio(&c__1, " ERROR in line ", (ftnlen)15);
-#line 7851 ""
+#line 7841 ""
do_fio(&c__1, (char *)&nlinep, (ftnlen)sizeof(integer));
-#line 7851 ""
+#line 7841 ""
do_fio(&c__1, ", bar ", (ftnlen)6);
-#line 7851 ""
+#line 7841 ""
do_fio(&c__1, (char *)&ibarnop, (ftnlen)sizeof(integer));
-#line 7851 ""
+#line 7841 ""
e_wsfe();
-#line 7853 ""
+#line 7843 ""
s_wsfe(&io___549);
-#line 7853 ""
+#line 7843 ""
do_fio(&c__1, msgq, lenmsg);
-#line 7853 ""
+#line 7843 ""
e_wsfe();
-#line 7854 ""
+#line 7844 ""
i10 = iposn / 10;
-#line 7855 ""
+#line 7845 ""
i1 = iposn - i10 * 10;
-#line 7856 ""
+#line 7846 ""
ci__1.cierr = 0;
-#line 7856 ""
+#line 7846 ""
ci__1.ciunit = 6;
/* Writing concatenation */
-#line 7856 ""
+#line 7846 ""
i__5[0] = 1, a__3[0] = "(";
-#line 7856 ""
+#line 7846 ""
i__2 = i10 + 48;
-#line 7856 ""
+#line 7846 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7856 ""
+#line 7846 ""
i__5[1] = 1, a__3[1] = ch__2;
-#line 7856 ""
+#line 7846 ""
i__3 = i1 + 48;
-#line 7856 ""
+#line 7846 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7856 ""
+#line 7846 ""
i__5[2] = 1, a__3[2] = ch__3;
-#line 7856 ""
+#line 7846 ""
i__5[3] = 4, a__3[3] = "x,a)";
-#line 7856 ""
+#line 7846 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
-#line 7856 ""
+#line 7846 ""
s_wsfe(&ci__1);
-#line 7856 ""
+#line 7846 ""
do_fio(&c__1, "v", (ftnlen)1);
-#line 7856 ""
+#line 7846 ""
e_wsfe();
-#line 7857 ""
+#line 7847 ""
ci__1.cierr = 0;
-#line 7857 ""
+#line 7847 ""
ci__1.ciunit = 15;
/* Writing concatenation */
-#line 7857 ""
+#line 7847 ""
i__5[0] = 1, a__3[0] = "(";
-#line 7857 ""
+#line 7847 ""
i__2 = i10 + 48;
-#line 7857 ""
+#line 7847 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7857 ""
+#line 7847 ""
i__5[1] = 1, a__3[1] = ch__2;
-#line 7857 ""
+#line 7847 ""
i__3 = i1 + 48;
-#line 7857 ""
+#line 7847 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7857 ""
+#line 7847 ""
i__5[2] = 1, a__3[2] = ch__3;
-#line 7857 ""
+#line 7847 ""
i__5[3] = 4, a__3[3] = "x,a)";
-#line 7857 ""
+#line 7847 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
-#line 7857 ""
+#line 7847 ""
s_wsfe(&ci__1);
-#line 7857 ""
+#line 7847 ""
do_fio(&c__1, "v", (ftnlen)1);
-#line 7857 ""
+#line 7847 ""
e_wsfe();
-#line 7858 ""
+#line 7848 ""
s_wsle(&io___552);
-#line 7858 ""
+#line 7848 ""
do_lio(&c__9, &c__1, outq, (ftnlen)78);
-#line 7858 ""
+#line 7848 ""
e_wsle();
-#line 7859 ""
+#line 7849 ""
s_wsfe(&io___553);
/* Writing concatenation */
-#line 7859 ""
+#line 7849 ""
i__1[0] = 1, a__1[0] = " ";
-#line 7859 ""
+#line 7849 ""
i__1[1] = 78, a__1[1] = outq;
-#line 7859 ""
+#line 7849 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)79);
-#line 7859 ""
+#line 7849 ""
do_fio(&c__1, ch__5, (ftnlen)79);
-#line 7859 ""
+#line 7849 ""
e_wsfe();
-#line 7860 ""
+#line 7850 ""
ci__1.cierr = 0;
-#line 7860 ""
+#line 7850 ""
ci__1.ciunit = 6;
/* Writing concatenation */
-#line 7860 ""
+#line 7850 ""
i__5[0] = 1, a__3[0] = "(";
-#line 7860 ""
+#line 7850 ""
i__2 = i10 + 48;
-#line 7860 ""
+#line 7850 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7860 ""
+#line 7850 ""
i__5[1] = 1, a__3[1] = ch__2;
-#line 7860 ""
+#line 7850 ""
i__3 = i1 + 48;
-#line 7860 ""
+#line 7850 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7860 ""
+#line 7850 ""
i__5[2] = 1, a__3[2] = ch__3;
-#line 7860 ""
+#line 7850 ""
i__5[3] = 4, a__3[3] = "x,a)";
-#line 7860 ""
+#line 7850 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
-#line 7860 ""
+#line 7850 ""
s_wsfe(&ci__1);
-#line 7860 ""
+#line 7850 ""
do_fio(&c__1, "^", (ftnlen)1);
-#line 7860 ""
+#line 7850 ""
e_wsfe();
-#line 7861 ""
+#line 7851 ""
ci__1.cierr = 0;
-#line 7861 ""
+#line 7851 ""
ci__1.ciunit = 15;
/* Writing concatenation */
-#line 7861 ""
+#line 7851 ""
i__5[0] = 1, a__3[0] = "(";
-#line 7861 ""
+#line 7851 ""
i__2 = i10 + 48;
-#line 7861 ""
+#line 7851 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 7861 ""
+#line 7851 ""
i__5[1] = 1, a__3[1] = ch__2;
-#line 7861 ""
+#line 7851 ""
i__3 = i1 + 48;
-#line 7861 ""
+#line 7851 ""
chax_(ch__3, (ftnlen)1, &i__3);
-#line 7861 ""
+#line 7851 ""
i__5[2] = 1, a__3[2] = ch__3;
-#line 7861 ""
+#line 7851 ""
i__5[3] = 4, a__3[3] = "x,a)";
-#line 7861 ""
+#line 7851 ""
ci__1.cifmt = (s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)7), ch__4);
-#line 7861 ""
+#line 7851 ""
s_wsfe(&ci__1);
-#line 7861 ""
+#line 7851 ""
do_fio(&c__1, "^", (ftnlen)1);
-#line 7861 ""
+#line 7851 ""
e_wsfe();
-#line 7862 ""
+#line 7852 ""
return 0;
} /* errmsg_ */
@@ -19397,76 +19395,76 @@ L2:
/* Get elemskips to previous note. Called only for graces, no xtups involved. */
-#line 7882 ""
+#line 7872 ""
/* Parameter adjustments */
-#line 7882 ""
+#line 7872 ""
--tstart;
-#line 7882 ""
+#line 7872 ""
--space;
-#line 7882 ""
+#line 7872 ""
-#line 7882 ""
+#line 7872 ""
/* Function Body */
-#line 7882 ""
+#line 7872 ""
itnd = i_nint(&all_1.to[*in - 1]);
-#line 7883 ""
+#line 7873 ""
if (*ip == 1 || itnd == *itrpt) {
/* Start of bar or after rpt. */
-#line 7887 ""
+#line 7877 ""
*esk = *fbar;
-#line 7888 ""
+#line 7878 ""
return 0;
-#line 7889 ""
+#line 7879 ""
} else {
-#line 7890 ""
+#line 7880 ""
*esk = 0.f;
-#line 7891 ""
+#line 7881 ""
itprev = itnd - all_1.nodur[*ivx + (*ip - 1) * 24 - 25];
-#line 7892 ""
+#line 7882 ""
for (iib = *ib; iib >= 1; --iib) {
-#line 7893 ""
+#line 7883 ""
if (tstart[iib] < itprev + comtol_1.tol) {
/* This is the block */
-#line 7897 ""
+#line 7887 ""
r__1 = (real) (itnd - itprev) / space[iib];
-#line 7897 ""
+#line 7887 ""
nnsk = i_nint(&r__1);
-#line 7898 ""
+#line 7888 ""
*esk += nnsk * feon_(&space[iib]);
-#line 7899 ""
+#line 7889 ""
return 0;
-#line 7900 ""
+#line 7890 ""
} else {
-#line 7901 ""
+#line 7891 ""
r__1 = (itnd - tstart[iib]) / space[iib];
-#line 7901 ""
+#line 7891 ""
nnsk = i_nint(&r__1);
-#line 7902 ""
+#line 7892 ""
*esk += nnsk * feon_(&space[iib]);
-#line 7903 ""
+#line 7893 ""
itnd = i_nint(&tstart[iib]);
-#line 7904 ""
+#line 7894 ""
}
-#line 7905 ""
+#line 7895 ""
/* L1: */
-#line 7905 ""
+#line 7895 ""
}
-#line 7906 ""
+#line 7896 ""
}
-#line 7907 ""
+#line 7897 ""
s_wsle(&io___558);
-#line 7907 ""
+#line 7897 ""
do_lio(&c__9, &c__1, "Problem in eskb4. Send files to Dr. Don", (ftnlen)
40);
-#line 7907 ""
+#line 7897 ""
e_wsle();
-#line 7908 ""
+#line 7898 ""
s_stop("", (ftnlen)0);
-#line 7909 ""
+#line 7899 ""
return 0;
} /* eskb4_ */
@@ -19478,9 +19476,9 @@ doublereal f1eon_(real *time)
/* Builtin functions */
double sqrt(doublereal);
-#line 7911 ""
+#line 7901 ""
ret_val = sqrt(*time / 2);
-#line 7912 ""
+#line 7902 ""
return ret_val;
} /* f1eon_ */
@@ -19493,13 +19491,13 @@ doublereal feon_(real *time)
/* Builtin functions */
double sqrt(doublereal), pow_dd(doublereal *, doublereal *);
-#line 7916 ""
+#line 7906 ""
d__1 = (doublereal) sqrt(*time / 2);
-#line 7916 ""
+#line 7906 ""
d__2 = (doublereal) (1.f - comeon_1.eonk);
-#line 7916 ""
+#line 7906 ""
ret_val = pow_dd(&d__1, &d__2) * comeon_1.ewmxk;
-#line 7917 ""
+#line 7907 ""
return ret_val;
} /* feon_ */
@@ -19578,428 +19576,432 @@ doublereal feon_(real *time)
/* Called once per voice per bar, after setting forced beams. */
-/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */
+/* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(24), */
/* * itr(48),nodue(48) */
/* logical short(48),eqonly */
-#line 7947 ""
+#line 7937 ""
/* Parameter adjustments */
-#line 7947 ""
+#line 7937 ""
--mapfb;
-#line 7947 ""
+#line 7937 ""
--numbms;
-#line 7947 ""
+#line 7937 ""
-#line 7947 ""
+#line 7937 ""
/* Function Body */
-#line 7968 ""
+#line 7958 ""
ip = 0;
-#line 7969 ""
+#line 7959 ""
nreal = 0;
-#line 7970 ""
+#line 7960 ""
itnow = 0;
-#line 7971 ""
+#line 7961 ""
L1:
-#line 7972 ""
+#line 7962 ""
++ip;
-#line 7973 ""
+#line 7963 ""
if (ip > all_1.nn[commvl_1.ivx - 1]) {
-#line 7973 ""
+#line 7963 ""
goto L9;
-#line 7973 ""
+#line 7963 ""
}
-#line 7974 ""
+#line 7964 ""
L11:
-#line 7974 ""
+#line 7964 ""
if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
/* Ignore all xtup notes except the last, the one with nodur > 0 . */
/* Xtups are irrelevant here since they are already all in forced beams. */
/* Will update itnow by nodur at the END of this loop */
-#line 7980 ""
+#line 7970 ""
++ip;
-#line 7981 ""
+#line 7971 ""
goto L11;
-#line 7982 ""
+#line 7972 ""
}
-#line 7983 ""
+#line 7973 ""
++nreal;
-#line 7984 ""
+#line 7974 ""
nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 7985 ""
+#line 7975 ""
short__[nreal - 1] = nodue[nreal - 1] < 16 && ! bit_test(all_1.irest[
commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(all_1.islur[
commvl_1.ivx + ip * 24 - 25],18);
/* Rule out notes that have 'alone'-flag set */
-#line 7991 ""
+#line 7981 ""
ipr[nreal - 1] = ip;
-#line 7992 ""
+#line 7982 ""
itr[nreal - 1] = itnow;
-#line 7993 ""
+#line 7983 ""
if (nodue[nreal - 1] == 1) {
/* 64th gap */
-#line 7997 ""
+#line 7987 ""
if (itnow % 2 == 0) {
/* Start of 32nd gap, lump with following note */
-#line 8001 ""
+#line 7991 ""
++ip;
-#line 8002 ""
+#line 7992 ""
nodue[nreal - 1] = all_1.nodur[commvl_1.ivx + ip * 24 - 25] + 1;
-#line 8003 ""
+#line 7993 ""
itnow += nodue[nreal - 1];
-#line 8004 ""
+#line 7994 ""
} else {
/* End of 32nd gap, lump with preceeding note */
-#line 8008 ""
+#line 7998 ""
--nreal;
-#line 8009 ""
+#line 7999 ""
++nodue[nreal - 1];
-#line 8010 ""
+#line 8000 ""
++itnow;
-#line 8011 ""
+#line 8001 ""
}
-#line 8012 ""
+#line 8002 ""
} else {
-#line 8013 ""
+#line 8003 ""
itnow += all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 8014 ""
+#line 8004 ""
}
-#line 8015 ""
+#line 8005 ""
goto L1;
-#line 8016 ""
+#line 8006 ""
L9:
-#line 8017 ""
+#line 8007 ""
ir1 = 1;
-#line 8018 ""
+#line 8008 ""
itseg = all_1.lenbar / *ibmrep;
-#line 8019 ""
+#line 8009 ""
i__1 = *ibmrep;
-#line 8019 ""
+#line 8009 ""
for (irep = 1; irep <= i__1; ++irep) {
/* Set bitmaps for all shorts neighbored by a short. Each bit represents a */
/* span of 32nd note. maps, mapm, mape record start, full duration, and end */
/* of consecutive span of beamable (<1/4) notes. */
-#line 8025 ""
+#line 8015 ""
maps = 0;
-#line 8026 ""
+#line 8016 ""
mapm = 0;
-#line 8027 ""
+#line 8017 ""
mape = 0;
-#line 8028 ""
+#line 8018 ""
itend = itseg * irep;
-#line 8029 ""
+#line 8019 ""
itoff = itend - itseg;
-#line 8030 ""
+#line 8020 ""
i__2 = nreal;
-#line 8030 ""
+#line 8020 ""
for (ir = ir1; ir <= i__2; ++ir) {
-#line 8031 ""
+#line 8021 ""
it2 = itr[ir - 1] + nodue[ir - 1] - 2;
-#line 8032 ""
+#line 8022 ""
if (it2 >= itend) {
-#line 8033 ""
+#line 8023 ""
ir1 = ir;
-#line 8034 ""
+#line 8024 ""
goto L14;
-#line 8035 ""
+#line 8025 ""
}
/* if (short(ir).and.((ir.gt.1.and.short(ir-1)).or.(ir.lt.nreal */
/* Computing MAX */
-#line 8037 ""
+#line 8027 ""
i__3 = ir - 1;
-#line 8037 ""
+#line 8027 ""
if (short__[ir - 1] && (ir > 1 && short__[max(i__3,1) - 1] || ir <
nreal && short__[ir])) {
-#line 8039 ""
+#line 8029 ""
ib1 = (itr[ir - 1] - itoff) / 2;
-#line 8040 ""
+#line 8030 ""
ib2 = (it2 - itoff) / 2;
-#line 8041 ""
+#line 8031 ""
if (max(ib1,ib2) > 47 || ir > 48 || min(ib1,ib2) < 0) {
-#line 8041 ""
+#line 8031 ""
return 0;
-#line 8041 ""
+#line 8031 ""
}
+/* if (max(ib1,ib2).gt.247 .or. ir.gt.248 .or. */
+/* * min(ib1,ib2).lt.0) return */
/* Must have an odd number obe beats in a long bar. Auto-beam won't work */
-#line 8046 ""
+#line 8038 ""
nip1[ib1] = ipr[ir - 1];
-#line 8047 ""
+#line 8039 ""
nip2[ib2] = ipr[ir - 1];
/* nip1,2(ib) = 0 unless a real note starts,ends on bit ib; then = ip */
-#line 8051 ""
+#line 8043 ""
maps = bit_set(maps,ib1);
-#line 8052 ""
+#line 8044 ""
mape = bit_set(mape,ib2);
-#line 8053 ""
+#line 8045 ""
i__3 = ib2;
-#line 8053 ""
+#line 8045 ""
for (ib = ib1; ib <= i__3; ++ib) {
-#line 8054 ""
+#line 8046 ""
mapm = bit_set(mapm,ib);
-#line 8055 ""
+#line 8047 ""
/* L3: */
-#line 8055 ""
+#line 8047 ""
}
-#line 8056 ""
+#line 8048 ""
}
-#line 8057 ""
+#line 8049 ""
/* L2: */
-#line 8057 ""
+#line 8049 ""
}
-#line 8058 ""
+#line 8050 ""
L14:
-#line 8059 ""
+#line 8051 ""
if (mapm == 0) {
-#line 8059 ""
+#line 8051 ""
goto L13;
-#line 8059 ""
+#line 8051 ""
}
/* Zero out bits from forced beams */
-#line 8063 ""
+#line 8055 ""
maps &= ~ mapfb[irep];
-#line 8064 ""
+#line 8056 ""
mapm &= ~ mapfb[irep];
-#line 8065 ""
+#line 8057 ""
mape &= ~ mapfb[irep];
/* Compare map with template. */
-#line 8069 ""
+#line 8061 ""
i__2 = nummask[combeam_1.ibmtyp - 1];
-#line 8069 ""
+#line 8061 ""
for (it = 1; it <= i__2; ++it) {
-#line 8070 ""
+#line 8062 ""
masknow = mask[it + combeam_1.ibmtyp * 49 - 50];
-#line 8071 ""
+#line 8063 ""
if ((masknow & mapm) == masknow) {
/* Find least significant bit in the mask to check start time */
-#line 8075 ""
+#line 8067 ""
mtemp = masknow;
-#line 8076 ""
+#line 8068 ""
maskm = masknow;
-#line 8077 ""
+#line 8069 ""
for (is1 = 0; is1 <= 47; ++is1) {
-#line 8078 ""
+/* do 5 is1 = 0 , 247 */
+#line 8071 ""
if ((1 & mtemp) == 1) {
-#line 8078 ""
+#line 8071 ""
goto L6;
-#line 8078 ""
+#line 8071 ""
}
-#line 8079 ""
+#line 8072 ""
mtemp = lbit_shift(mtemp, (ftnlen)-1);
-#line 8080 ""
+#line 8073 ""
/* L5: */
-#line 8080 ""
+#line 8073 ""
}
-#line 8081 ""
+#line 8074 ""
L6:
-#line 8082 ""
+#line 8075 ""
if ((lbit_shift((ftnlen)1, is1) & maps) == 0) {
-#line 8082 ""
+#line 8075 ""
goto L4;
-#line 8082 ""
+#line 8075 ""
}
/* is1 is the bit where the beam starts. Continue shifting to */
/* find most significant bit in the mask to check ending time */
-#line 8087 ""
+#line 8080 ""
for (is2 = is1; is2 <= 47; ++is2) {
-#line 8088 ""
+/* do 7 is2 = is1 , 247 */
+#line 8082 ""
mtemp = lbit_shift(mtemp, (ftnlen)-1);
-#line 8089 ""
+#line 8083 ""
if ((1 & ~ mtemp) == 1) {
-#line 8089 ""
+#line 8083 ""
goto L8;
-#line 8089 ""
+#line 8083 ""
}
-#line 8090 ""
+#line 8084 ""
/* L7: */
-#line 8090 ""
+#line 8084 ""
}
-#line 8091 ""
+#line 8085 ""
L8:
/* is2 is now the bit on which the beam ends. */
-#line 8095 ""
+#line 8089 ""
if ((lbit_shift((ftnlen)1, is2) & mape) == 0) {
-#line 8095 ""
+#line 8089 ""
goto L4;
-#line 8095 ""
+#line 8089 ""
}
/* Did we pick out a single note from the middle of a longer sequence? */
-#line 8099 ""
+#line 8093 ""
if (nip1[is1] == nip2[is2]) {
-#line 8099 ""
+#line 8093 ""
goto L4;
-#line 8099 ""
+#line 8093 ""
}
/* We almost have a beam. Check equality of notes if needed. */
-#line 8103 ""
+#line 8097 ""
if (eqonly[it + combeam_1.ibmtyp * 49 - 50]) {
-#line 8104 ""
+#line 8098 ""
i__3 = nip2[is2];
-#line 8104 ""
+#line 8098 ""
for (ip = nip1[is1]; ip <= i__3; ++ip) {
-#line 8105 ""
+#line 8099 ""
if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] != 8) {
/* There is a non-1/8th note in this beam. Exit if not 2 quarters */
-#line 8109 ""
+#line 8103 ""
if (is2 - is1 != 15) {
-#line 8109 ""
+#line 8103 ""
goto L4;
-#line 8109 ""
+#line 8103 ""
}
/* Beam is 2 quarters long. Check if can split in half. */
-#line 8113 ""
+#line 8107 ""
ithalf = 0;
-#line 8114 ""
+#line 8108 ""
i__4 = nip2[is2];
-#line 8114 ""
+#line 8108 ""
for (iip = nip1[is1]; iip <= i__4; ++iip) {
-#line 8115 ""
+#line 8109 ""
ithalf += all_1.nodur[commvl_1.ivx + iip * 24
- 25];
-#line 8116 ""
+#line 8110 ""
if (ithalf > 16) {
-#line 8116 ""
+#line 8110 ""
goto L4;
-#line 8116 ""
+#line 8110 ""
}
-#line 8117 ""
+#line 8111 ""
if (ithalf == 16) {
-#line 8117 ""
+#line 8111 ""
goto L21;
-#line 8117 ""
+#line 8111 ""
}
-#line 8118 ""
+#line 8112 ""
/* L20: */
-#line 8118 ""
+#line 8112 ""
}
-#line 8119 ""
+#line 8113 ""
s_wsle(&io___592);
-#line 8119 ""
+#line 8113 ""
do_lio(&c__9, &c__1, "Problem in findbeam, pleas"\
"e call Dr. Don", (ftnlen)40);
-#line 8119 ""
+#line 8113 ""
e_wsle();
-#line 8120 ""
+#line 8114 ""
goto L4;
-#line 8121 ""
+#line 8115 ""
L21:
/* Otherwise, split in half by keeping only the first half. Other half will */
/* be picked up later, assuming masks are listed longest first. */
-#line 8126 ""
+#line 8120 ""
is2 = is1 + 7;
/* Reset maskm (since only used part of mask), used later to zero out */
/* bits that contain beams */
-#line 8131 ""
+#line 8125 ""
maskm = 0;
-#line 8132 ""
+#line 8126 ""
i__4 = is2;
-#line 8132 ""
+#line 8126 ""
for (is = is1; is <= i__4; ++is) {
-#line 8133 ""
+#line 8127 ""
maskm = bit_set(maskm,is);
-#line 8134 ""
+#line 8128 ""
/* L15: */
-#line 8134 ""
+#line 8128 ""
}
-#line 8135 ""
+#line 8129 ""
goto L16;
-#line 8136 ""
+#line 8130 ""
}
-#line 8137 ""
+#line 8131 ""
/* L10: */
-#line 8137 ""
+#line 8131 ""
}
-#line 8138 ""
+#line 8132 ""
}
-#line 8139 ""
+#line 8133 ""
L16:
/* This is a beam. If last "effective" ends on odd 64th, add 1 more */
/* if (abs(mod(to(iand(255,ipl(ivx,nip2(is2)))) */
/* * +nodur(ivx,nip2(is2)),2.)) .gt. tol) then */
-#line 8145 ""
+#line 8139 ""
r__2 = all_1.to[comipl2_1.ipl2[commvl_1.ivx + nip2[is2] * 24
- 25] - 1] + all_1.nodur[commvl_1.ivx + nip2[is2] *
24 - 25] + comtol_1.tol * .5f;
-#line 8145 ""
+#line 8139 ""
if ((r__1 = r_mod(&r__2, &c_b1901), dabs(r__1)) >
comtol_1.tol) {
-#line 8147 ""
+#line 8141 ""
++nip2[is2];
-#line 8148 ""
+#line 8142 ""
}
-#line 8149 ""
+#line 8143 ""
++numbms[commvl_1.ivx];
-#line 8150 ""
+#line 8144 ""
numnew = numbms[commvl_1.ivx];
-#line 8151 ""
+#line 8145 ""
logbeam_(&numnew, &nip1[is1], &nip2[is2]);
/* Zero out the appropriate bits so these notes don't get used again */
-#line 8155 ""
+#line 8149 ""
mapm &= ~ maskm;
-#line 8156 ""
+#line 8150 ""
if (mapm == 0) {
-#line 8156 ""
+#line 8150 ""
goto L13;
-#line 8156 ""
+#line 8150 ""
}
-#line 8157 ""
+#line 8151 ""
maps &= ~ maskm;
-#line 8158 ""
+#line 8152 ""
mape &= ~ maskm;
-#line 8159 ""
+#line 8153 ""
}
-#line 8160 ""
+#line 8154 ""
L4:
-#line 8160 ""
+#line 8154 ""
;
-#line 8160 ""
+#line 8154 ""
}
-#line 8161 ""
+#line 8155 ""
L13:
-#line 8161 ""
+#line 8155 ""
;
-#line 8161 ""
+#line 8155 ""
}
-#line 8162 ""
+#line 8156 ""
return 0;
} /* findbeam_ */
@@ -20030,85 +20032,83 @@ L13:
/* Compute an exponent eonk for use in the "flattened" formula for elemskips */
/* vs time. We must solve the eqution f = 0. Initial quess is eonk0. */
-/* logical gotclef */
-/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
-#line 8177 ""
+#line 8169 ""
comeon_1.eonk = *eonk0;
-#line 8178 ""
+#line 8170 ""
niter = 0;
-#line 8179 ""
+#line 8171 ""
L1:
-#line 8180 ""
+#line 8172 ""
d__1 = (doublereal) f1eon_(dtmax);
-#line 8180 ""
+#line 8172 ""
d__2 = (doublereal) comeon_1.eonk;
-#line 8180 ""
+#line 8172 ""
comeon_1.ewmxk = pow_dd(&d__1, &d__2);
-#line 8181 ""
+#line 8173 ""
++niter;
-#line 8182 ""
+#line 8174 ""
esum = 0.f;
-#line 8183 ""
+#line 8175 ""
desum = 0.f;
-#line 8184 ""
+#line 8176 ""
i__1 = *nptr2;
-#line 8184 ""
+#line 8176 ""
for (iptr = *nptr1; iptr <= i__1; ++iptr) {
-#line 8185 ""
+#line 8177 ""
targ = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1];
-#line 8186 ""
+#line 8178 ""
esum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
feon_(&targ);
-#line 8187 ""
+#line 8179 ""
d__1 = (doublereal) (*dtmax / targ);
-#line 8187 ""
+#line 8179 ""
d__2 = (doublereal) comeon_1.eonk;
-#line 8187 ""
+#line 8179 ""
detarg = sqrt(targ / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / targ);
-#line 8188 ""
+#line 8180 ""
desum += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr - 1] *
detarg;
-#line 8189 ""
+#line 8181 ""
/* L2: */
-#line 8189 ""
+#line 8181 ""
}
-#line 8190 ""
+#line 8182 ""
f = *wovera * feon_(dtmin) - *xelsk - esum;
-#line 8191 ""
+#line 8183 ""
d__1 = (doublereal) (*dtmax / *dtmin);
-#line 8191 ""
+#line 8183 ""
d__2 = (doublereal) comeon_1.eonk;
-#line 8191 ""
+#line 8183 ""
fp = *wovera * sqrt(*dtmin / 2 * pow_dd(&d__1, &d__2)) * log(*dtmax / *
dtmin) - desum;
-#line 8193 ""
+#line 8185 ""
if (dabs(fp) < comtol_1.tol || (r__1 = comeon_1.eonk - .5f, dabs(r__1)) >
.5f || niter > 100) {
-#line 8194 ""
+#line 8186 ""
printl_("Error in findeonk. Please send source to Dr. Don", (ftnlen)
49);
-#line 8196 ""
+#line 8188 ""
comeon_1.eonk = 0.f;
-#line 8197 ""
+#line 8189 ""
comeon_1.ewmxk = 1.f;
-#line 8198 ""
+#line 8190 ""
return 0;
-#line 8199 ""
+#line 8191 ""
}
-#line 8200 ""
+#line 8192 ""
dsoln = -f / fp;
-#line 8201 ""
+#line 8193 ""
if (dabs(dsoln) < comtol_1.tol * .1f) {
-#line 8201 ""
+#line 8193 ""
return 0;
-#line 8201 ""
+#line 8193 ""
}
/* Not converged yet, try again */
-#line 8205 ""
+#line 8197 ""
comeon_1.eonk += dsoln;
-#line 8206 ""
+#line 8198 ""
goto L1;
} /* findeonk_ */
@@ -20135,136 +20135,136 @@ doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc)
/* This return the real duration of a note */
-#line 8215 ""
+#line 8207 ""
/* Parameter adjustments */
-#line 8215 ""
+#line 8207 ""
nacc -= 25;
-#line 8215 ""
+#line 8207 ""
nodur -= 25;
-#line 8215 ""
+#line 8207 ""
-#line 8215 ""
+#line 8207 ""
/* Function Body */
-#line 8215 ""
+#line 8207 ""
ipback = *ip;
-#line 8216 ""
+#line 8208 ""
if (nodur[*ivx + *ip * 24] > 0) {
-#line 8217 ""
+#line 8209 ""
if (*ip > 1) {
/* Check if this is last note of xtup */
-#line 8221 ""
+#line 8213 ""
if (nodur[*ivx + (*ip - 1) * 24] == 0) {
-#line 8222 ""
+#line 8214 ""
ipback = *ip - 1;
-#line 8223 ""
+#line 8215 ""
goto L2;
-#line 8224 ""
+#line 8216 ""
}
-#line 8225 ""
+#line 8217 ""
}
-#line 8226 ""
+#line 8218 ""
ret_val = (real) nodur[*ivx + *ip * 24];
-#line 8227 ""
+#line 8219 ""
return ret_val;
-#line 8228 ""
+#line 8220 ""
}
-#line 8229 ""
+#line 8221 ""
L2:
/* Count back to prior non zero note. Start at ip to avoid neg index if ip=1. */
/* Count how many doubled xtups notes there are from ip-1 to first note. */
-#line 8234 ""
+#line 8226 ""
ndoub = 0;
-#line 8235 ""
+#line 8227 ""
for (ip1m1 = ipback; ip1m1 >= 1; --ip1m1) {
-#line 8236 ""
+#line 8228 ""
if (nodur[*ivx + ip1m1 * 24] > 0) {
-#line 8236 ""
+#line 8228 ""
goto L4;
-#line 8236 ""
+#line 8228 ""
}
-#line 8237 ""
+#line 8229 ""
if (ip1m1 < *ip && bit_test(nacc[*ivx + ip1m1 * 24],18)) {
-#line 8237 ""
+#line 8229 ""
++ndoub;
-#line 8237 ""
+#line 8229 ""
}
-#line 8238 ""
+#line 8230 ""
/* L1: */
-#line 8238 ""
+#line 8230 ""
}
-#line 8239 ""
+#line 8231 ""
L4:
/* count forward to next non-0 nodur. Start at ip in case last note of xtup. */
-#line 8243 ""
+#line 8235 ""
for (iip = *ip; iip <= 200; ++iip) {
/* Count doubled xtup notes from ip to end. */
-#line 8247 ""
+#line 8239 ""
if (bit_test(nacc[*ivx + iip * 24],18)) {
-#line 8247 ""
+#line 8239 ""
++ndoub;
-#line 8247 ""
+#line 8239 ""
}
-#line 8248 ""
+#line 8240 ""
if (nodur[*ivx + iip * 24] > 0) {
/* fnote = nodur(ivx,iip)/float(iip-ip1m1) */
-#line 8250 ""
+#line 8242 ""
ret_val = nodur[*ivx + iip * 24] / (real) (iip - ip1m1 + ndoub);
-#line 8251 ""
+#line 8243 ""
if (bit_test(nacc[*ivx + *ip * 24],18)) {
-#line 8252 ""
+#line 8244 ""
ret_val *= 2;
-#line 8253 ""
+#line 8245 ""
} else if (bit_test(nacc[*ivx + *ip * 24],27)) {
-#line 8254 ""
+#line 8246 ""
ret_val *= 1.5f;
-#line 8255 ""
+#line 8247 ""
} else if (*ip > 1) {
-#line 8256 ""
+#line 8248 ""
if (bit_test(nacc[*ivx + (*ip - 1) * 24],27)) {
-#line 8256 ""
+#line 8248 ""
ret_val *= .5f;
-#line 8256 ""
+#line 8248 ""
}
-#line 8257 ""
+#line 8249 ""
}
-#line 8258 ""
+#line 8250 ""
return ret_val;
-#line 8259 ""
+#line 8251 ""
}
-#line 8260 ""
+#line 8252 ""
/* L3: */
-#line 8260 ""
+#line 8252 ""
}
-#line 8261 ""
+#line 8253 ""
s_wsle(&io___608);
-#line 8261 ""
+#line 8253 ""
do_lio(&c__9, &c__1, " ", (ftnlen)1);
-#line 8261 ""
+#line 8253 ""
e_wsle();
-#line 8262 ""
+#line 8254 ""
printl_("Probable misplaced barline or incorrect meter, stopping", (
ftnlen)55);
-#line 8264 ""
+#line 8256 ""
s_wsle(&io___609);
-#line 8264 ""
+#line 8256 ""
do_lio(&c__9, &c__1, "ivx,ip:", (ftnlen)7);
-#line 8264 ""
+#line 8256 ""
do_lio(&c__3, &c__1, (char *)&(*ivx), (ftnlen)sizeof(integer));
-#line 8264 ""
+#line 8256 ""
do_lio(&c__3, &c__1, (char *)&(*ip), (ftnlen)sizeof(integer));
-#line 8264 ""
+#line 8256 ""
e_wsle();
-#line 8265 ""
+#line 8257 ""
stop1_();
-#line 8266 ""
+#line 8258 ""
return ret_val;
} /* fnote_ */
@@ -20285,50 +20285,50 @@ L4:
/* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */
/* then reads in a new line. Resets iccount. Ends program if no more input. */
-#line 8280 ""
+#line 8272 ""
if (*iccount == 128) {
-#line 8281 ""
+#line 8273 ""
read10_(lineq, &c1omget_1.lastchar, (ftnlen)128);
-#line 8282 ""
+#line 8274 ""
if (c1omget_1.lastchar) {
-#line 8282 ""
+#line 8274 ""
return 0;
-#line 8282 ""
+#line 8274 ""
}
-#line 8283 ""
+#line 8275 ""
if (! commac_1.endmac) {
-#line 8284 ""
+#line 8276 ""
*iccount = 0;
-#line 8285 ""
+#line 8277 ""
if (! commac_1.mplay) {
-#line 8285 ""
+#line 8277 ""
++c1omget_1.nline;
-#line 8285 ""
+#line 8277 ""
}
-#line 8286 ""
+#line 8278 ""
} else {
-#line 8287 ""
+#line 8279 ""
commac_1.endmac = FALSE_;
-#line 8288 ""
+#line 8280 ""
*iccount = commac_1.icchold;
-#line 8289 ""
+#line 8281 ""
s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
-#line 8290 ""
+#line 8282 ""
}
-#line 8291 ""
+#line 8283 ""
if (commac_1.mrecord) {
-#line 8292 ""
+#line 8284 ""
m1rec1_(lineq, iccount, &ibarcnt, &ibaroff, &nbars, &ndxm, (
ftnlen)128);
-#line 8293 ""
+#line 8285 ""
}
-#line 8294 ""
+#line 8286 ""
}
-#line 8295 ""
+#line 8287 ""
++(*iccount);
-#line 8296 ""
+#line 8288 ""
*(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
-#line 8297 ""
+#line 8289 ""
return 0;
} /* g1etchar_ */
@@ -20350,7 +20350,8 @@ L4:
address a__1[3], a__2[2], a__3[4];
integer i__1, i__2[3], i__3[2], i__4, i__5, i__6, i__7, i__8[4];
real r__1;
- char ch__1[42], ch__2[1], ch__3[2], ch__4[55], ch__5[54], ch__6[46];
+ char ch__1[42], ch__2[1], ch__3[2], ch__4[1], ch__5[55], ch__6[54], ch__7[
+ 46];
icilist ici__1;
/* Builtin functions */
@@ -20361,8 +20362,7 @@ L4:
integer do_fio(integer *, char *, ftnlen), e_wsfe(void), s_cmp(char *,
char *, ftnlen, ftnlen), i_nint(real *);
double log(doublereal);
- integer pow_ii(integer *, integer *), s_rsfe(cilist *), e_rsfe(void),
- s_rsfi(icilist *), e_rsfi(void);
+ integer pow_ii(integer *, integer *), s_rsfi(icilist *), e_rsfi(void);
/* Local variables */
extern integer i1fnodur_(integer *, char *, ftnlen);
@@ -20453,4618 +20453,4664 @@ L4:
static cilist io___692 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 };
static cilist io___696 = { 0, 6, 0, 0, 0 };
static cilist io___697 = { 0, 6, 0, 0, 0 };
- static cilist io___698 = { 0, 5, 0, "(a)", 0 };
+ static cilist io___701 = { 0, 6, 0, 0, 0 };
static cilist io___702 = { 0, 6, 0, 0, 0 };
- static cilist io___703 = { 0, 6, 0, 0, 0 };
-/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
-#line 8371 ""
+#line 8362 ""
cdot = FALSE_;
-#line 8372 ""
+#line 8363 ""
twotrem = FALSE_;
-#line 8373 ""
+#line 8364 ""
L1:
-#line 8373 ""
+#line 8364 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 8374 ""
+#line 8365 ""
if (*(unsigned char *)charq != ' ') {
-#line 8374 ""
+#line 8365 ""
*(unsigned char *)charlq = *(unsigned char *)charq;
-#line 8374 ""
+#line 8365 ""
}
-#line 8375 ""
+#line 8366 ""
if (c1omget_1.lastchar) {
-#line 8376 ""
+#line 8367 ""
if (i_indx("/%", charlq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 8377 ""
+#line 8368 ""
s_wsle(&io___621);
-#line 8377 ""
+#line 8368 ""
e_wsle();
-#line 8378 ""
+#line 8369 ""
s_wsle(&io___622);
-#line 8378 ""
+#line 8369 ""
do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8);
-#line 8378 ""
+#line 8369 ""
e_wsle();
-#line 8379 ""
+#line 8370 ""
s_wsle(&io___623);
-#line 8379 ""
+#line 8370 ""
do_lio(&c__9, &c__1, "Last non-blank character is \"", (ftnlen)29)
;
-#line 8379 ""
+#line 8370 ""
do_lio(&c__9, &c__1, charlq, (ftnlen)1);
-#line 8379 ""
+#line 8370 ""
do_lio(&c__9, &c__1, "\", not \"/,%\"", (ftnlen)12);
-#line 8379 ""
+#line 8370 ""
e_wsle();
-#line 8380 ""
+#line 8371 ""
s_wsle(&io___624);
-#line 8380 ""
+#line 8371 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
-#line 8380 ""
+#line 8371 ""
i__1 = *(unsigned char *)charlq;
-#line 8380 ""
+#line 8371 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 8380 ""
+#line 8371 ""
e_wsle();
-#line 8381 ""
+#line 8372 ""
s_wsfe(&io___625);
/* Writing concatenation */
-#line 8381 ""
+#line 8372 ""
i__2[0] = 29, a__1[0] = "Last non-blank character is \"";
-#line 8381 ""
+#line 8372 ""
i__2[1] = 1, a__1[1] = charlq;
-#line 8381 ""
+#line 8372 ""
i__2[2] = 12, a__1[2] = "\", not \"/,%\"";
-#line 8381 ""
+#line 8372 ""
s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)42);
-#line 8381 ""
+#line 8372 ""
do_fio(&c__1, ch__1, (ftnlen)42);
-#line 8381 ""
+#line 8372 ""
e_wsfe();
-#line 8383 ""
+#line 8374 ""
s_wsfe(&io___626);
-#line 8383 ""
+#line 8374 ""
do_fio(&c__1, "ASCII code:", (ftnlen)11);
-#line 8383 ""
+#line 8374 ""
i__1 = *(unsigned char *)charlq;
-#line 8383 ""
+#line 8374 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 8383 ""
+#line 8374 ""
e_wsfe();
/* Append " /" to last line. NB lastchar=.true. => ilbuf=nlbuf+1. */
-#line 8387 ""
+#line 8378 ""
--inbuff_1.ilbuf;
-#line 8388 ""
+#line 8379 ""
inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) (inbuff_1.lbuf[
inbuff_1.ilbuf - 1] + 2);
/* Writing concatenation */
-#line 8389 ""
+#line 8380 ""
i__3[0] = inbuff_1.ipbuf, a__2[0] = inbuff_1.bufq;
-#line 8389 ""
+#line 8380 ""
i__3[1] = 2, a__2[1] = " /";
-#line 8389 ""
+#line 8380 ""
s_cat(inbuff_1.bufq, a__2, i__3, &c__2, (ftnlen)131072);
-#line 8390 ""
+#line 8381 ""
s_wsle(&io___627);
-#line 8390 ""
+#line 8381 ""
do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
-#line 8390 ""
+#line 8381 ""
e_wsle();
-#line 8391 ""
+#line 8382 ""
s_wsle(&io___628);
-#line 8391 ""
+#line 8382 ""
do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18);
-#line 8391 ""
+#line 8382 ""
e_wsle();
/* Writing concatenation */
-#line 8392 ""
+#line 8383 ""
i__3[0] = a1ll_2.iccount, a__2[0] = lineq;
-#line 8392 ""
+#line 8383 ""
i__3[1] = 2, a__2[1] = " /";
-#line 8392 ""
+#line 8383 ""
s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128);
-#line 8393 ""
+#line 8384 ""
c1omget_1.lastchar = FALSE_;
-#line 8394 ""
+#line 8385 ""
goto L1;
-#line 8395 ""
+#line 8386 ""
}
-#line 8396 ""
+#line 8387 ""
return 0;
-#line 8397 ""
+#line 8388 ""
}
-#line 8398 ""
+#line 8389 ""
if (*(unsigned char *)charq == ' ') {
-#line 8399 ""
+#line 8390 ""
goto L1;
-#line 8400 ""
+#line 8391 ""
} else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) {
-#line 8401 ""
+#line 8392 ""
a1ll_2.iccount = 128;
-#line 8402 ""
+#line 8393 ""
goto L1;
/* Replacement 1/22/12 since gfortran 4.7 with -O was choking here! */
/* else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. */
-#line 8407 ""
+#line 8398 ""
} else if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) > 0 || *(
unsigned char *)charq == 'r') {
-/* This is a note/rest. gotclef is only used for checking for clef before "/" */
+/* This is a note/rest. */
-#line 8412 ""
+#line 8403 ""
if (cdot) {
-#line 8412 ""
+#line 8403 ""
goto L28;
-#line 8412 ""
+#line 8403 ""
}
-/* if (gotclef) gotclef=.false. */
-#line 8414 ""
+#line 8404 ""
idotform = 0;
-#line 8415 ""
+#line 8405 ""
numnum = 0;
-#line 8416 ""
+#line 8406 ""
plusmin = FALSE_;
-#line 8417 ""
+#line 8407 ""
L28:
-#line 8417 ""
+#line 8407 ""
++a1ll_2.nnl[c1ommvl_1.ivx - 1];
-#line 8418 ""
+#line 8408 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 200) {
-#line 8419 ""
+#line 8409 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8419 ""
+#line 8409 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu"\
"sic. Use smaller blocks!", (ftnlen)128, (ftnlen)48);
-#line 8421 ""
+#line 8411 ""
stop1_();
-#line 8422 ""
+#line 8412 ""
}
-#line 8423 ""
+#line 8413 ""
*(unsigned char *)dotq = 'x';
/* Check if this is 'r ' and previous note was full-bar-pause */
-#line 8427 ""
+#line 8417 ""
i__1 = a1ll_2.iccount;
/* Computing MAX */
-#line 8427 ""
+#line 8417 ""
i__4 = 1, i__5 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
/* Computing MAX */
-#line 8427 ""
+#line 8417 ""
i__6 = 1, i__7 = a1ll_2.nnl[c1ommvl_1.ivx - 1] - 1;
-#line 8427 ""
+#line 8417 ""
fulbrp = *(unsigned char *)charq == 'r' && s_cmp(lineq + i__1, " ",
a1ll_2.iccount + 1 - i__1, (ftnlen)1) == 0 && a1ll_2.nnl[
c1ommvl_1.ivx - 1] > 1 && a1ll_2.rest[c1ommvl_1.ivx + max(
i__4,i__5) * 24 - 25] && a1ll_2.nodur[c1ommvl_1.ivx + max(
i__6,i__7) * 24 - 25] == a1ll_2.lenbar;
-#line 8430 ""
+#line 8420 ""
L2:
-#line 8430 ""
+#line 8420 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 8431 ""
+#line 8421 ""
ic = *(unsigned char *)durq;
-#line 8432 ""
+#line 8422 ""
if (ic <= 57 && ic >= 48) {
/* Digit */
-#line 8436 ""
+#line 8426 ""
if (numnum == 0) {
-#line 8437 ""
+#line 8427 ""
c1omnotes_1.nnodur = ic - 48;
-#line 8438 ""
+#line 8428 ""
numnum = 1;
-#line 8439 ""
+#line 8429 ""
goto L2;
-#line 8440 ""
+#line 8430 ""
} else if (numnum == 1) {
-#line 8441 ""
+#line 8431 ""
if (*(unsigned char *)charq == 'r') {
-#line 8442 ""
+#line 8432 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8442 ""
+#line 8432 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a"\
"llowed after rest symbol \"r\"!", (ftnlen)128, (
ftnlen)45);
-#line 8444 ""
+#line 8434 ""
stop1_();
-#line 8445 ""
+#line 8435 ""
}
-#line 8446 ""
+#line 8436 ""
numnum = 2;
-#line 8447 ""
+#line 8437 ""
if (plusmin) {
-#line 8448 ""
+#line 8438 ""
s_wsle(&io___636);
-#line 8448 ""
+#line 8438 ""
e_wsle();
-#line 8449 ""
+#line 8439 ""
s_wsle(&io___637);
-#line 8449 ""
+#line 8439 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
25);
-#line 8449 ""
+#line 8439 ""
e_wsle();
-#line 8450 ""
+#line 8440 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8450 ""
+#line 8440 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\
".2, +/- was ignored if octave was!", (ftnlen)128,
(ftnlen)50);
-#line 8452 ""
+#line 8442 ""
s_wsle(&io___638);
-#line 8452 ""
+#line 8442 ""
do_lio(&c__9, &c__1, "explicitly specified. May need to"\
" edit old editions", (ftnlen)52);
-#line 8452 ""
+#line 8442 ""
e_wsle();
-#line 8454 ""
+#line 8444 ""
}
-#line 8455 ""
+#line 8445 ""
goto L2;
-#line 8456 ""
+#line 8446 ""
} else {
-#line 8457 ""
+#line 8447 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8457 ""
+#line 8447 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy"\
"mbol!", (ftnlen)128, (ftnlen)25);
-#line 8459 ""
+#line 8449 ""
stop1_();
-#line 8460 ""
+#line 8450 ""
}
-#line 8461 ""
+#line 8451 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 8462 ""
+#line 8452 ""
*(unsigned char *)dotq = *(unsigned char *)durq;
-#line 8463 ""
+#line 8453 ""
i__1 = a1ll_2.iccount;
-#line 8463 ""
+#line 8453 ""
if (s_cmp(lineq + i__1, "d", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
-#line 8464 ""
+#line 8454 ""
c1omnotes_1.iddot = 1;
-#line 8465 ""
+#line 8455 ""
++a1ll_2.iccount;
/* Since we flow out, double dots won't work with other dot options */
-#line 8469 ""
+#line 8459 ""
}
-#line 8470 ""
+#line 8460 ""
i__1 = a1ll_2.iccount;
-#line 8470 ""
+#line 8460 ""
if (i_indx("+-", lineq + i__1, (ftnlen)2, a1ll_2.iccount + 1 -
i__1) > 0) {
/* move a dot, provided a number follows. */
-#line 8474 ""
+#line 8464 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8475 ""
+#line 8465 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8476 ""
+#line 8466 ""
if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) == 0)
{
/* Backup, exit the loop normally */
-#line 8480 ""
+#line 8470 ""
a1ll_2.iccount += -2;
-#line 8481 ""
+#line 8471 ""
goto L2;
-#line 8482 ""
+#line 8472 ""
}
-#line 8483 ""
+#line 8473 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 8484 ""
+#line 8474 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift also */
-#line 8488 ""
+#line 8478 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 8489 ""
+#line 8479 ""
if (i_indx("0123456789-.", durq, (ftnlen)12, (ftnlen)1) ==
0) {
-#line 8490 ""
+#line 8480 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8490 ""
+#line 8480 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num"\
"ber after 2nd +/- (shift dot)!", (ftnlen)128,
(ftnlen)42);
-#line 8492 ""
+#line 8482 ""
stop1_();
-#line 8493 ""
+#line 8483 ""
}
-#line 8494 ""
+#line 8484 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
-#line 8495 ""
+#line 8485 ""
}
-#line 8496 ""
+#line 8486 ""
--a1ll_2.iccount;
-#line 8497 ""
+#line 8487 ""
}
-#line 8498 ""
+#line 8488 ""
goto L2;
-#line 8499 ""
+#line 8489 ""
} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Accidental shift */
/* if (index('fsn',lineq(iccount-1:iccount-1)) .eq. 0) then */
-#line 8504 ""
+#line 8494 ""
i__1 = a1ll_2.iccount - 2;
-#line 8504 ""
+#line 8494 ""
if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 -
i__1) == 0) {
-#line 8505 ""
+#line 8495 ""
i__1 = a1ll_2.iccount - 1;
-#line 8505 ""
+#line 8495 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8505 ""
+#line 8495 ""
errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o"\
"r \"A\" before \"<\" or \">\"!", (ftnlen)128, (ftnlen)
48);
/* * 'Expected "f", "s", or "n" before "<" or ">"!') */
-#line 8508 ""
+#line 8498 ""
stop1_();
-#line 8509 ""
+#line 8499 ""
}
-#line 8510 ""
+#line 8500 ""
ipm = 1;
-#line 8511 ""
+#line 8501 ""
if (*(unsigned char *)durq == '<') {
-#line 8511 ""
+#line 8501 ""
ipm = -1;
-#line 8511 ""
+#line 8501 ""
}
-#line 8512 ""
+#line 8502 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 8513 ""
+#line 8503 ""
if (i_indx("123456789.0", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 8514 ""
+#line 8504 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8514 ""
+#line 8504 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte"\
"r </> (accidental shift)!", (ftnlen)128, (ftnlen)45);
-#line 8516 ""
+#line 8506 ""
stop1_();
-#line 8517 ""
+#line 8507 ""
}
-#line 8518 ""
+#line 8508 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 8519 ""
+#line 8509 ""
fnum = ipm * fnum;
-#line 8520 ""
+#line 8510 ""
if (fnum < -5.35f || fnum > 1.f) {
-#line 8521 ""
+#line 8511 ""
i__1 = a1ll_2.iccount - 1;
-#line 8521 ""
+#line 8511 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8521 ""
+#line 8511 ""
errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu"\
"st be >-5.35 and <1.0!", (ftnlen)128, (ftnlen)52);
-#line 8523 ""
+#line 8513 ""
stop1_();
-#line 8524 ""
+#line 8514 ""
}
-#line 8525 ""
+#line 8515 ""
--a1ll_2.iccount;
-#line 8526 ""
+#line 8516 ""
goto L2;
-#line 8527 ""
+#line 8517 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8528 ""
+#line 8518 ""
if (*(unsigned char *)charq != 'r') {
-#line 8529 ""
+#line 8519 ""
i__1 = a1ll_2.iccount - 2;
-#line 8529 ""
+#line 8519 ""
if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount -
1 - i__1) > 0) {
-#line 8530 ""
+#line 8520 ""
ipm = 1;
-#line 8531 ""
+#line 8521 ""
if (*(unsigned char *)durq == '-') {
-#line 8531 ""
+#line 8521 ""
ipm = -1;
-#line 8531 ""
+#line 8521 ""
}
-#line 8532 ""
+#line 8522 ""
i__1 = a1ll_2.iccount;
-#line 8532 ""
+#line 8522 ""
if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
a1ll_2.iccount + 1 - i__1) > 0) {
/* This may be start of accidental shift, but may be octave jump; then duration */
-#line 8537 ""
+#line 8527 ""
icsav = a1ll_2.iccount;
-#line 8538 ""
+#line 8528 ""
++a1ll_2.iccount;
-#line 8539 ""
+#line 8529 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 8540 ""
+#line 8530 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* This is an accid shift since there's a 2nd consecutive signed number. */
/* Check size of 1st number. */
-#line 8545 ""
+#line 8535 ""
if (fnum > 30.5f) {
-#line 8546 ""
+#line 8536 ""
i__1 = a1ll_2.iccount - 1;
-#line 8546 ""
+#line 8536 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8546 ""
+#line 8536 ""
errmsg_(lineq, &i__1, &i__4, "Vertical accid"\
"ental shift must be less than 31!", (
ftnlen)128, (ftnlen)47);
-#line 8548 ""
+#line 8538 ""
stop1_();
-#line 8549 ""
+#line 8539 ""
}
-#line 8550 ""
+#line 8540 ""
ipm = 1;
-#line 8551 ""
+#line 8541 ""
if (*(unsigned char *)durq == '-') {
-#line 8551 ""
+#line 8541 ""
ipm = -1;
-#line 8551 ""
+#line 8541 ""
}
-#line 8552 ""
+#line 8542 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
128, (ftnlen)1);
-#line 8553 ""
+#line 8543 ""
if (i_indx("1234567890.", durq, (ftnlen)11, (
ftnlen)1) == 0) {
-#line 8554 ""
+#line 8544 ""
i__1 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8554 ""
+#line 8544 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe"\
"cted 2nd number of accidental shift)!"
, (ftnlen)128, (ftnlen)41);
-#line 8556 ""
+#line 8546 ""
stop1_();
-#line 8557 ""
+#line 8547 ""
}
-#line 8558 ""
+#line 8548 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 8559 ""
+#line 8549 ""
fnum = ipm * fnum;
-#line 8560 ""
+#line 8550 ""
if (fnum < -5.35f || fnum > 1.f) {
-#line 8561 ""
+#line 8551 ""
i__1 = a1ll_2.iccount - 1;
-#line 8561 ""
+#line 8551 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8561 ""
+#line 8551 ""
errmsg_(lineq, &i__1, &i__4, "Horiz. acciden"\
"tal shift must be >-5.35 and <1.0!", (
ftnlen)128, (ftnlen)48);
-#line 8563 ""
+#line 8553 ""
stop1_();
-#line 8564 ""
+#line 8554 ""
}
-#line 8565 ""
+#line 8555 ""
--a1ll_2.iccount;
-#line 8566 ""
+#line 8556 ""
goto L2;
-#line 8567 ""
+#line 8557 ""
} else {
/* Not accid shift, reset, then flow out */
-#line 8571 ""
+#line 8561 ""
a1ll_2.iccount = icsav;
-#line 8572 ""
+#line 8562 ""
}
-#line 8573 ""
+#line 8563 ""
}
-#line 8574 ""
+#line 8564 ""
}
-#line 8575 ""
+#line 8565 ""
plusmin = TRUE_;
-#line 8576 ""
+#line 8566 ""
if (numnum == 2) {
-#line 8577 ""
+#line 8567 ""
s_wsle(&io___643);
-#line 8577 ""
+#line 8567 ""
e_wsle();
-#line 8578 ""
+#line 8568 ""
s_wsle(&io___644);
-#line 8578 ""
+#line 8568 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)
25);
-#line 8578 ""
+#line 8568 ""
e_wsle();
-#line 8579 ""
+#line 8569 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8579 ""
+#line 8569 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\
".2, +/- was ignored if octave was!", (ftnlen)128,
(ftnlen)50);
-#line 8581 ""
+#line 8571 ""
s_wsle(&io___645);
-#line 8581 ""
+#line 8571 ""
do_lio(&c__9, &c__1, "explicitly specified. May need to"\
" edit old editions", (ftnlen)52);
-#line 8581 ""
+#line 8571 ""
e_wsle();
-#line 8583 ""
+#line 8573 ""
}
-#line 8584 ""
+#line 8574 ""
goto L2;
/* It's a rest containing +|- . Must refer to a vertical shift. Read past. */
-#line 8588 ""
+#line 8578 ""
} else {
-#line 8589 ""
+#line 8579 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8590 ""
+#line 8580 ""
readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (
ftnlen)1);
-#line 8591 ""
+#line 8581 ""
i__1 = a1ll_2.iccount - 2;
-#line 8591 ""
+#line 8581 ""
if (s_cmp(lineq + i__1, ".", a1ll_2.iccount - 1 - i__1, (
ftnlen)1) == 0) {
-#line 8591 ""
+#line 8581 ""
--a1ll_2.iccount;
-#line 8591 ""
+#line 8581 ""
}
-#line 8592 ""
+#line 8582 ""
--a1ll_2.iccount;
-#line 8593 ""
+#line 8583 ""
goto L2;
-#line 8594 ""
+#line 8584 ""
}
/* else if (index('ulare',durq) .gt. 0) then */
-#line 8596 ""
+#line 8586 ""
} else if (i_indx("ularec", durq, (ftnlen)6, (ftnlen)1) > 0) {
-#line 8597 ""
+#line 8587 ""
goto L2;
-#line 8598 ""
+#line 8588 ""
} else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Stemlength change */
-#line 8602 ""
+#line 8592 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 8603 ""
+#line 8593 ""
if (i_indx(".0123456789:", durq, (ftnlen)12, (ftnlen)1) == 0) {
-#line 8604 ""
+#line 8594 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8604 ""
+#line 8594 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb"\
"er or colon here!", (ftnlen)128, (ftnlen)37);
-#line 8606 ""
+#line 8596 ""
stop1_();
-#line 8607 ""
+#line 8597 ""
}
-#line 8608 ""
+#line 8598 ""
if (*(unsigned char *)durq == ':') {
-#line 8609 ""
+#line 8599 ""
if (! comkeys_1.stickys) {
-#line 8610 ""
+#line 8600 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8610 ""
+#line 8600 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick"\
"y stemlegth changes without turning on!", (ftnlen)
128, (ftnlen)55);
-#line 8612 ""
+#line 8602 ""
stop1_();
-#line 8613 ""
+#line 8603 ""
}
-#line 8614 ""
+#line 8604 ""
comkeys_1.stickys = FALSE_;
-#line 8615 ""
+#line 8605 ""
goto L2;
-#line 8616 ""
+#line 8606 ""
}
-#line 8617 ""
+#line 8607 ""
readnum_(lineq, &a1ll_2.iccount, durq, &dum, (ftnlen)128, (ftnlen)
1);
/* if (dum.lt..5 .or. dum.gt.4.) then */
-#line 8619 ""
+#line 8609 ""
if (*(unsigned char *)durq == 'L' && dum > 20.f || *(unsigned
char *)durq == 'S' && dum > 4.f) {
-#line 8621 ""
+#line 8611 ""
i__1 = a1ll_2.iccount - 1;
-#line 8621 ""
+#line 8611 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8621 ""
+#line 8611 ""
errmsg_(lineq, &i__1, &i__4, "Stemlength change amount too b"\
"ig!", (ftnlen)128, (ftnlen)33);
-#line 8623 ""
+#line 8613 ""
stop1_();
-#line 8624 ""
+#line 8614 ""
}
-#line 8625 ""
+#line 8615 ""
if (*(unsigned char *)durq != ':') {
-#line 8626 ""
+#line 8616 ""
--a1ll_2.iccount;
-#line 8627 ""
+#line 8617 ""
} else {
-#line 8628 ""
+#line 8618 ""
if (comkeys_1.stickys) {
-#line 8629 ""
+#line 8619 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8629 ""
+#line 8619 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky"\
" stemshrinks when already on!", (ftnlen)128, (
ftnlen)45);
-#line 8631 ""
+#line 8621 ""
stop1_();
-#line 8632 ""
+#line 8622 ""
}
-#line 8633 ""
+#line 8623 ""
comkeys_1.stickys = TRUE_;
-#line 8634 ""
+#line 8624 ""
}
-#line 8635 ""
+#line 8625 ""
goto L2;
-#line 8636 ""
+#line 8626 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */
/* MUST come right after "f,s,n" */
-#line 8641 ""
+#line 8631 ""
i__1 = a1ll_2.iccount;
-#line 8641 ""
+#line 8631 ""
if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
-#line 8641 ""
+#line 8631 ""
++a1ll_2.iccount;
-#line 8641 ""
+#line 8631 ""
}
-#line 8642 ""
+#line 8632 ""
goto L2;
-#line 8643 ""
+#line 8633 ""
} else if (*(unsigned char *)durq == 'p') {
-#line 8644 ""
+#line 8634 ""
fulbrp = *(unsigned char *)charq == 'r';
-#line 8645 ""
+#line 8635 ""
if (! fulbrp) {
-#line 8646 ""
+#line 8636 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8646 ""
+#line 8636 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl"\
"y works with \"r\" (rest)!", (ftnlen)128, (ftnlen)42);
-#line 8648 ""
+#line 8638 ""
stop1_();
-#line 8649 ""
+#line 8639 ""
}
-#line 8650 ""
+#line 8640 ""
goto L2;
-#line 8651 ""
+#line 8641 ""
} else if (*(unsigned char *)durq == 'b') {
-#line 8652 ""
+#line 8642 ""
if (*(unsigned char *)charq != 'r') {
-#line 8653 ""
+#line 8643 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8653 ""
+#line 8643 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I"\
" expected \"rb\"!", (ftnlen)128, (ftnlen)33);
-#line 8655 ""
+#line 8645 ""
stop1_();
-#line 8656 ""
+#line 8646 ""
} else if (numnum == 2) {
-#line 8657 ""
+#line 8647 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8657 ""
+#line 8647 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &"\
" \"b\" with two numbers!", (ftnlen)128, (ftnlen)39);
-#line 8659 ""
+#line 8649 ""
}
-#line 8660 ""
+#line 8650 ""
goto L2;
-#line 8661 ""
+#line 8651 ""
} else if (*(unsigned char *)durq == 'x') {
/* Xtuplet. Count number of doubled notes (for unequal xtups) */
-#line 8665 ""
+#line 8655 ""
if (bit_test(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25],18)) {
-#line 8666 ""
+#line 8656 ""
ndoub = 1;
-#line 8667 ""
+#line 8657 ""
} else {
-#line 8668 ""
+#line 8658 ""
ndoub = 0;
-#line 8669 ""
+#line 8659 ""
}
/* Will set all durations to 0 except last one. */
-#line 8673 ""
+#line 8663 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 8674 ""
+#line 8664 ""
if (i_indx("123456789T", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 8675 ""
+#line 8665 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8675 ""
+#line 8665 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \""\
"x\" in xtuplet must be \"1\"-\"9\" or \"T\"!", (
ftnlen)128, (ftnlen)55);
-#line 8677 ""
+#line 8667 ""
stop1_();
-#line 8678 ""
+#line 8668 ""
}
-#line 8679 ""
+#line 8669 ""
if (*(unsigned char *)durq == 'T') {
/* Set a flag for checking 2nd note inputs if dot is moved */
-#line 8683 ""
+#line 8673 ""
twotrem = TRUE_;
/* Check all x-tremolo inputs here; set fnum=2 */
-#line 8687 ""
+#line 8677 ""
fnum = 2.f;
-#line 8688 ""
+#line 8678 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
;
-#line 8689 ""
+#line 8679 ""
if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 8690 ""
+#line 8680 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8690 ""
+#line 8680 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char aft"\
"er \"T\" in xtuplet must be \"0\"-\"3\" or blank!"
, (ftnlen)128, (ftnlen)57);
-#line 8692 ""
+#line 8682 ""
stop1_();
-#line 8693 ""
+#line 8683 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 8694 ""
+#line 8684 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 8695 ""
+#line 8685 ""
if (i_indx("0123 ", durq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 8696 ""
+#line 8686 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8696 ""
+#line 8686 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "This char mu"\
"st be \"0\"-\"3\" or blank!", (ftnlen)128, (
ftnlen)35);
-#line 8698 ""
+#line 8688 ""
stop1_();
-#line 8699 ""
+#line 8689 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 8700 ""
+#line 8690 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
/* Probably blank unles other options entered */
-#line 8704 ""
+#line 8694 ""
}
-#line 8705 ""
+#line 8695 ""
}
-#line 8706 ""
+#line 8696 ""
} else {
/* durq is digit, normal xtup */
-#line 8710 ""
+#line 8700 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
/* Leaves durq at next char after number */
-#line 8714 ""
+#line 8704 ""
if (fnum > 99.f) {
-#line 8715 ""
+#line 8705 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8715 ""
+#line 8705 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot h"\
"ave more than 99 notes!", (ftnlen)128, (ftnlen)39)
;
-#line 8717 ""
+#line 8707 ""
stop1_();
-#line 8718 ""
+#line 8708 ""
} else if (i_indx(" DFnd", durq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 8719 ""
+#line 8709 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8719 ""
+#line 8709 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal chara"\
"cters here are \" \",\"D\",\"F\",\"n\"!", (ftnlen)
128, (ftnlen)47);
-#line 8721 ""
+#line 8711 ""
stop1_();
-#line 8722 ""
+#line 8712 ""
}
-#line 8723 ""
+#line 8713 ""
}
/* End of mandatory xtup inputs. Check for options. Note D,F,d must precede n. */
-#line 8727 ""
+#line 8717 ""
if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double xtup note to make an un= xtup. Here, number already set, but may also */
/* have used this before number was set. */
-#line 8732 ""
+#line 8722 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx +
a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],18);
-#line 8733 ""
+#line 8723 ""
ndoub = 1;
-#line 8734 ""
+#line 8724 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8735 ""
+#line 8725 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 8736 ""
+#line 8726 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx +
a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25],27);
-#line 8737 ""
+#line 8727 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8738 ""
+#line 8728 ""
}
-#line 8739 ""
+#line 8729 ""
if (*(unsigned char *)durq == 'n') {
/* Number alteration stuff. After 'n', require '+-123456789fs ', no more 'DF'. */
-#line 8743 ""
+#line 8733 ""
numshft = 0;
-#line 8744 ""
+#line 8734 ""
L30:
-#line 8744 ""
+#line 8734 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8745 ""
+#line 8735 ""
if (*(unsigned char *)durq == 'f') {
-#line 8746 ""
+#line 8736 ""
goto L30;
-#line 8747 ""
+#line 8737 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8748 ""
+#line 8738 ""
++numshft;
-#line 8749 ""
+#line 8739 ""
if (numshft == 3) {
-#line 8750 ""
+#line 8740 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8750 ""
+#line 8740 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift"\
"s are allowed after \"n\" in xtup!", (ftnlen)
128, (ftnlen)44);
-#line 8752 ""
+#line 8742 ""
stop1_();
-#line 8753 ""
+#line 8743 ""
}
-#line 8754 ""
+#line 8744 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 8755 ""
+#line 8745 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
0) {
-#line 8756 ""
+#line 8746 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8756 ""
+#line 8746 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\
"er should be a digit or \".\"!", (ftnlen)128,
(ftnlen)40);
-#line 8758 ""
+#line 8748 ""
stop1_();
-#line 8759 ""
+#line 8749 ""
}
-#line 8760 ""
+#line 8750 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
-#line 8761 ""
+#line 8751 ""
--a1ll_2.iccount;
/* if ((numshft.eq.1 .and. snum.gt.15.1) .or. */
-#line 8763 ""
+#line 8753 ""
if (numshft == 1 && snum > 64.f || numshft == 2 && snum >
1.51f) {
-#line 8765 ""
+#line 8755 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8765 ""
+#line 8755 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number"\
" after \"n\" in xtup is out of range!", (
ftnlen)128, (ftnlen)47);
-#line 8767 ""
+#line 8757 ""
stop1_();
-#line 8768 ""
+#line 8758 ""
}
-#line 8769 ""
+#line 8759 ""
goto L30;
-#line 8770 ""
+#line 8760 ""
} else if (*(unsigned char *)durq == 's') {
/* Slope alteration for bracket */
-#line 8774 ""
+#line 8764 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 8775 ""
+#line 8765 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 8776 ""
+#line 8766 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8776 ""
+#line 8766 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad"\
"justment, this character must be \"+\" or \"-"\
"\"!", (ftnlen)128, (ftnlen)56);
-#line 8778 ""
+#line 8768 ""
stop1_();
-#line 8779 ""
+#line 8769 ""
}
-#line 8780 ""
+#line 8770 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 8781 ""
+#line 8771 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
{
-#line 8782 ""
+#line 8772 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8782 ""
+#line 8772 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\
"er should be a digit!", (ftnlen)128, (ftnlen)
33);
-#line 8784 ""
+#line 8774 ""
stop1_();
-#line 8785 ""
+#line 8775 ""
}
-#line 8786 ""
+#line 8776 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
-#line 8787 ""
+#line 8777 ""
--a1ll_2.iccount;
-#line 8788 ""
+#line 8778 ""
if (i_nint(&snum) > 15) {
-#line 8789 ""
+#line 8779 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8789 ""
+#line 8779 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust"\
"ment cannot exceed 15!", (ftnlen)128, (ftnlen)
34);
-#line 8791 ""
+#line 8781 ""
stop1_();
-#line 8792 ""
+#line 8782 ""
}
-#line 8793 ""
+#line 8783 ""
goto L30;
-#line 8794 ""
+#line 8784 ""
} else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) >
0) {
/* Unsigned integer => alternate printed number */
-#line 8798 ""
+#line 8788 ""
readnum_(lineq, &a1ll_2.iccount, durq, &snum, (ftnlen)128,
(ftnlen)1);
-#line 8799 ""
+#line 8789 ""
if (snum > 15.1f) {
-#line 8800 ""
+#line 8790 ""
i__1 = a1ll_2.iccount - 1;
-#line 8800 ""
+#line 8790 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8800 ""
+#line 8790 ""
errmsg_(lineq, &i__1, &i__4, "Alternate xtup number "\
"after \"n\" must be <16!", (ftnlen)128, (
ftnlen)44);
-#line 8802 ""
+#line 8792 ""
stop1_();
-#line 8803 ""
+#line 8793 ""
}
-#line 8804 ""
+#line 8794 ""
--a1ll_2.iccount;
-#line 8805 ""
+#line 8795 ""
goto L30;
-#line 8806 ""
+#line 8796 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 8807 ""
+#line 8797 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8807 ""
+#line 8797 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
"r after \"n\" in xtup!", (ftnlen)128, (ftnlen)36);
-#line 8809 ""
+#line 8799 ""
stop1_();
-#line 8810 ""
+#line 8800 ""
}
-#line 8811 ""
+#line 8801 ""
}
-#line 8812 ""
+#line 8802 ""
ntup = i_nint(&fnum);
-#line 8813 ""
+#line 8803 ""
i__1 = ntup;
-#line 8813 ""
+#line 8803 ""
for (itup = 2; itup <= i__1; ++itup) {
-#line 8814 ""
+#line 8804 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = 0;
-#line 8815 ""
+#line 8805 ""
++a1ll_2.nnl[c1ommvl_1.ivx - 1];
-#line 8816 ""
+#line 8806 ""
L110:
-#line 8816 ""
+#line 8806 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 8817 ""
+#line 8807 ""
if (*(unsigned char *)durq == ' ') {
-#line 8818 ""
+#line 8808 ""
goto L110;
-#line 8819 ""
+#line 8809 ""
} else if (*(unsigned char *)durq == 'o') {
/* Ornament in xtup. "o" symbol must come AFTER the affected note */
-#line 8823 ""
+#line 8813 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8824 ""
+#line 8814 ""
if (i_indx("(stmx+Tup._)e:>^bc", dumq, (ftnlen)18, (
ftnlen)1) == 0) {
-#line 8825 ""
+#line 8815 ""
if (i_indx("fg", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8826 ""
+#line 8816 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8826 ""
+#line 8816 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata "\
"or segno not allowed in xtuplet!", (
ftnlen)128, (ftnlen)40);
-#line 8828 ""
+#line 8818 ""
} else {
-#line 8829 ""
+#line 8819 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8829 ""
+#line 8819 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\
"ornament!", (ftnlen)128, (ftnlen)17);
-#line 8831 ""
+#line 8821 ""
}
-#line 8832 ""
+#line 8822 ""
stop1_();
-#line 8833 ""
+#line 8823 ""
}
-#line 8834 ""
+#line 8824 ""
if (*(unsigned char *)dumq == 'T') {
/* Trill. may be followed by 't' and/or number. read 'til blank */
-#line 8838 ""
+#line 8828 ""
L29:
-#line 8838 ""
+#line 8828 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8839 ""
+#line 8829 ""
if (*(unsigned char *)dumq != ' ') {
-#line 8839 ""
+#line 8829 ""
goto L29;
-#line 8839 ""
+#line 8829 ""
}
-#line 8840 ""
+#line 8830 ""
} else if (*(unsigned char *)dumq == 'e') {
-#line 8841 ""
+#line 8831 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8842 ""
+#line 8832 ""
if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 8843 ""
+#line 8833 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8843 ""
+#line 8833 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal "\
"character after \"e\" in edit. accid. sy"\
"mbol!", (ftnlen)128, (ftnlen)51);
-#line 8845 ""
+#line 8835 ""
stop1_();
-#line 8846 ""
+#line 8836 ""
}
-#line 8847 ""
+#line 8837 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8848 ""
+#line 8838 ""
if (*(unsigned char *)dumq == '?') {
-#line 8848 ""
+#line 8838 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
128, (ftnlen)1);
-#line 8848 ""
+#line 8838 ""
}
-#line 8849 ""
+#line 8839 ""
} else if (*(unsigned char *)dumq == ':') {
-#line 8850 ""
+#line 8840 ""
i__4 = a1ll_2.iccount;
-#line 8850 ""
+#line 8840 ""
if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) != 0) {
-#line 8851 ""
+#line 8841 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8851 ""
+#line 8841 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\
"st be followed by blank in \"o: \"!", (
ftnlen)128, (ftnlen)39);
-#line 8853 ""
+#line 8843 ""
stop1_();
-#line 8854 ""
+#line 8844 ""
} else if (! comkeys_1.ornrpt) {
-#line 8855 ""
+#line 8845 ""
i__4 = a1ll_2.iccount - 1;
-#line 8855 ""
+#line 8845 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8855 ""
+#line 8845 ""
errmsg_(lineq, &i__4, &i__5, "Turned off repeate"\
"d ornaments before they were on!", (
ftnlen)128, (ftnlen)50);
-#line 8857 ""
+#line 8847 ""
stop1_();
-#line 8858 ""
+#line 8848 ""
}
-#line 8859 ""
+#line 8849 ""
comkeys_1.ornrpt = FALSE_;
-#line 8860 ""
+#line 8850 ""
} else {
-#line 8861 ""
+#line 8851 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8862 ""
+#line 8852 ""
}
-#line 8863 ""
+#line 8853 ""
if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 8864 ""
+#line 8854 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8864 ""
+#line 8854 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in ornament symbol!", (ftnlen)128, (
ftnlen)37);
-#line 8866 ""
+#line 8856 ""
stop1_();
-#line 8867 ""
+#line 8857 ""
}
-#line 8868 ""
+#line 8858 ""
if (*(unsigned char *)dumq == ':') {
-#line 8869 ""
+#line 8859 ""
i__4 = a1ll_2.iccount;
-#line 8869 ""
+#line 8859 ""
if (s_cmp(lineq + i__4, " ", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) != 0) {
-#line 8870 ""
+#line 8860 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8870 ""
+#line 8860 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu"\
"st be followed by blank in \"o: \"!", (
ftnlen)128, (ftnlen)39);
-#line 8872 ""
+#line 8862 ""
stop1_();
-#line 8873 ""
+#line 8863 ""
} else if (comkeys_1.ornrpt) {
-#line 8874 ""
+#line 8864 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8874 ""
+#line 8864 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o"\
"n repeated ornaments but already on!", (
ftnlen)128, (ftnlen)44);
-#line 8876 ""
+#line 8866 ""
stop1_();
-#line 8877 ""
+#line 8867 ""
}
-#line 8878 ""
+#line 8868 ""
comkeys_1.ornrpt = TRUE_;
-#line 8879 ""
+#line 8869 ""
}
-#line 8880 ""
+#line 8870 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8881 ""
+#line 8871 ""
i__4 = a1ll_2.iccount;
-#line 8881 ""
+#line 8871 ""
if (i_indx("0123456789", lineq + i__4, (ftnlen)10,
a1ll_2.iccount + 1 - i__4) == 0) {
-#line 8883 ""
+#line 8873 ""
i__4 = a1ll_2.iccount + 1;
-#line 8883 ""
+#line 8873 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8883 ""
+#line 8873 ""
errmsg_(lineq, &i__4, &i__5, "There should be an"\
" integer here!", (ftnlen)128, (ftnlen)32);
-#line 8885 ""
+#line 8875 ""
stop1_();
-#line 8886 ""
+#line 8876 ""
}
-#line 8887 ""
+#line 8877 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 8888 ""
+#line 8878 ""
if (*(unsigned char *)durq == ':') {
-#line 8889 ""
+#line 8879 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8889 ""
+#line 8879 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s"\
"hift AND repeat an ornament!", (ftnlen)
128, (ftnlen)36);
-#line 8891 ""
+#line 8881 ""
stop1_();
-#line 8892 ""
+#line 8882 ""
}
/* 12/7/03 Allow horizontal shift on any ornament, not just breath and ceas. */
-#line 8896 ""
+#line 8886 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8897 ""
+#line 8887 ""
i__4 = a1ll_2.iccount;
-#line 8897 ""
+#line 8887 ""
if (i_indx(".0123456789", lineq + i__4, (ftnlen)
11, a1ll_2.iccount + 1 - i__4) == 0) {
-#line 8899 ""
+#line 8889 ""
i__4 = a1ll_2.iccount + 1;
-#line 8899 ""
+#line 8889 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8899 ""
+#line 8889 ""
errmsg_(lineq, &i__4, &i__5, "There should b"\
"e a number here!", (ftnlen)128, (
ftnlen)30);
-#line 8902 ""
+#line 8892 ""
stop1_();
-#line 8903 ""
+#line 8893 ""
}
-#line 8904 ""
+#line 8894 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 8905 ""
+#line 8895 ""
}
-#line 8906 ""
+#line 8896 ""
}
-#line 8907 ""
+#line 8897 ""
goto L110;
-#line 8908 ""
+#line 8898 ""
} else if (i_indx("st(){}", durq, (ftnlen)6, (ftnlen)1) > 0) {
/* Slur in xtup */
-#line 8912 ""
+#line 8902 ""
iposn = 0;
-#line 8913 ""
+#line 8903 ""
numint = 0;
-#line 8914 ""
+#line 8904 ""
L15:
-#line 8914 ""
+#line 8904 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8915 ""
+#line 8905 ""
++iposn;
-#line 8916 ""
+#line 8906 ""
if (i_indx("udlbfnhtv", dumq, (ftnlen)9, (ftnlen)1) > 0) {
-#line 8917 ""
+#line 8907 ""
if (*(unsigned char *)dumq == 't' && *(unsigned char *
)durq == 't') {
-#line 8918 ""
+#line 8908 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8918 ""
+#line 8908 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u"\
"se \"t\" as an option on a tie!", (ftnlen)
128, (ftnlen)37);
-#line 8920 ""
+#line 8910 ""
stop1_();
-#line 8921 ""
+#line 8911 ""
}
-#line 8922 ""
+#line 8912 ""
goto L15;
-#line 8923 ""
+#line 8913 ""
} else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8924 ""
+#line 8914 ""
++numint;
-#line 8925 ""
+#line 8915 ""
++a1ll_2.iccount;
-#line 8926 ""
+#line 8916 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 8927 ""
+#line 8917 ""
if (numint == 1) {
-#line 8928 ""
+#line 8918 ""
if (i_nint(&fnum) > 30) {
-#line 8929 ""
+#line 8919 ""
i__4 = a1ll_2.iccount - 1;
-#line 8929 ""
+#line 8919 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8929 ""
+#line 8919 ""
errmsg_(lineq, &i__4, &i__5, "Magnitude of s"\
"lur height adjustment cannot exceed "\
"30!", (ftnlen)128, (ftnlen)53);
-#line 8931 ""
+#line 8921 ""
stop1_();
-#line 8932 ""
+#line 8922 ""
}
-#line 8933 ""
+#line 8923 ""
} else if (numint == 2) {
-#line 8934 ""
+#line 8924 ""
if (dabs(fnum) > 6.3f) {
-#line 8935 ""
+#line 8925 ""
i__4 = a1ll_2.iccount - 1;
-#line 8935 ""
+#line 8925 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8935 ""
+#line 8925 ""
errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\
"ft must be in the range (-6.3,6.3)!",
(ftnlen)128, (ftnlen)49);
-#line 8937 ""
+#line 8927 ""
stop1_();
-#line 8938 ""
+#line 8928 ""
}
-#line 8939 ""
+#line 8929 ""
} else {
/* Third signed integer, must be a midslur or curve spec. */
-#line 8943 ""
+#line 8933 ""
if (dabs(fnum) > 31.f) {
-#line 8944 ""
+#line 8934 ""
i__4 = a1ll_2.iccount - 1;
-#line 8944 ""
+#line 8934 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8944 ""
+#line 8934 ""
errmsg_(lineq, &i__4, &i__5, "Slur midheight"\
" must be in the range (-31,31)!", (
ftnlen)128, (ftnlen)45);
-#line 8946 ""
+#line 8936 ""
stop1_();
-#line 8947 ""
+#line 8937 ""
}
-#line 8948 ""
+#line 8938 ""
if (*(unsigned char *)durq == ':') {
/* Expecting curve parameters. Get two numbers */
-#line 8952 ""
+#line 8942 ""
for (i__ = 1; i__ <= 2; ++i__) {
-#line 8953 ""
+#line 8943 ""
++a1ll_2.iccount;
-#line 8954 ""
+#line 8944 ""
fnum = (real) (*(unsigned char *)&lineq[
a1ll_2.iccount - 1] - 48);
-#line 8955 ""
+#line 8945 ""
if ((r__1 = fnum - 3.5f, dabs(r__1)) >
3.6f) {
-#line 8956 ""
+#line 8946 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 8956 ""
+#line 8946 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4,
"Slur curve parameter must "\
"be in range (0,7)!", (ftnlen)
128, (ftnlen)44);
-#line 8959 ""
+#line 8949 ""
stop1_();
-#line 8960 ""
+#line 8950 ""
}
-#line 8961 ""
+#line 8951 ""
/* L40: */
-#line 8961 ""
+#line 8951 ""
}
-#line 8962 ""
+#line 8952 ""
++a1ll_2.iccount;
-#line 8963 ""
+#line 8953 ""
}
-#line 8964 ""
+#line 8954 ""
}
-#line 8965 ""
+#line 8955 ""
--a1ll_2.iccount;
-#line 8966 ""
+#line 8956 ""
goto L15;
-#line 8968 ""
+#line 8958 ""
} else if (*(unsigned char *)dumq == 's') {
/* What follows should be one or two signed numbers for adjustment of line break */
/* slur, end of 1st segment or start of second. */
-#line 8973 ""
+#line 8963 ""
if (comslur_1.fontslur) {
-#line 8974 ""
+#line 8964 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8974 ""
+#line 8964 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not "\
"use linebreak slur options with font-bas"\
"ed slurs!", (ftnlen)128, (ftnlen)57);
-#line 8976 ""
+#line 8966 ""
stop1_();
-#line 8977 ""
+#line 8967 ""
}
-#line 8978 ""
+#line 8968 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 8979 ""
+#line 8969 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 8980 ""
+#line 8970 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8980 ""
+#line 8970 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha"\
"racter must be \"+\" or \"-\"!", (ftnlen)
128, (ftnlen)34);
-#line 8982 ""
+#line 8972 ""
stop1_();
-#line 8983 ""
+#line 8973 ""
}
-#line 8984 ""
+#line 8974 ""
++a1ll_2.iccount;
-#line 8985 ""
+#line 8975 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 8986 ""
+#line 8976 ""
if (i_nint(&fnum) > 30) {
-#line 8987 ""
+#line 8977 ""
i__4 = a1ll_2.iccount - 1;
-#line 8987 ""
+#line 8977 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 8987 ""
+#line 8977 ""
errmsg_(lineq, &i__4, &i__5, "Magnitude of slur "\
"height adjustment cannot exceed 30!", (
ftnlen)128, (ftnlen)53);
-#line 8989 ""
+#line 8979 ""
stop1_();
-#line 8990 ""
+#line 8980 ""
}
-#line 8991 ""
+#line 8981 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 8992 ""
+#line 8982 ""
++a1ll_2.iccount;
-#line 8993 ""
+#line 8983 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 8994 ""
+#line 8984 ""
if (dabs(fnum) > 6.3f) {
-#line 8995 ""
+#line 8985 ""
i__4 = a1ll_2.iccount - 1;
-#line 8995 ""
+#line 8985 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 8995 ""
+#line 8985 ""
errmsg_(lineq, &i__4, &i__5, "Slur horiz shi"\
"ft must be in range (-6.3,6.3)!", (
ftnlen)128, (ftnlen)45);
-#line 8997 ""
+#line 8987 ""
stop1_();
-#line 8998 ""
+#line 8988 ""
}
-#line 8999 ""
+#line 8989 ""
}
-#line 9000 ""
+#line 8990 ""
--a1ll_2.iccount;
-#line 9001 ""
+#line 8991 ""
goto L15;
-#line 9002 ""
+#line 8992 ""
} else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
-#line 9003 ""
+#line 8993 ""
i__4 = a1ll_2.iccount;
-#line 9003 ""
+#line 8993 ""
if (s_cmp(lineq + i__4, "H", a1ll_2.iccount + 1 -
i__4, (ftnlen)1) == 0) {
-#line 9003 ""
+#line 8993 ""
++a1ll_2.iccount;
-#line 9003 ""
+#line 8993 ""
}
-#line 9005 ""
+#line 8995 ""
goto L15;
-#line 9006 ""
+#line 8996 ""
} else if (*(unsigned char *)dumq == 'p') {
/* local change in postscript slur/tie adjustment default */
-#line 9010 ""
+#line 9000 ""
if (comslur_1.fontslur) {
-#line 9011 ""
+#line 9001 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9011 ""
+#line 9001 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use"\
" postscript slurs (\"Ap\") to use this o"\
"ption!", (ftnlen)128, (ftnlen)52);
-#line 9013 ""
+#line 9003 ""
stop1_();
-#line 9014 ""
+#line 9004 ""
}
-#line 9015 ""
+#line 9005 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 9016 ""
+#line 9006 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 9017 ""
+#line 9007 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9017 ""
+#line 9007 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\
"ed \"+\" or \"-\" here!", (ftnlen)128, (
ftnlen)25);
-#line 9019 ""
+#line 9009 ""
stop1_();
-#line 9020 ""
+#line 9010 ""
}
-#line 9021 ""
+#line 9011 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
-#line 9022 ""
+#line 9012 ""
if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 9023 ""
+#line 9013 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9023 ""
+#line 9013 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect"\
"ed \"s\" or \"t\" here!", (ftnlen)128, (
ftnlen)25);
-#line 9025 ""
+#line 9015 ""
stop1_();
-#line 9026 ""
+#line 9016 ""
}
-#line 9027 ""
+#line 9017 ""
goto L15;
-#line 9028 ""
+#line 9018 ""
} else if (*(unsigned char *)dumq != ' ') {
-#line 9029 ""
+#line 9019 ""
ic = *(unsigned char *)dumq;
-#line 9030 ""
+#line 9020 ""
if (ic >= 48 && ic <= 57 || ic >= 65 && ic <= 90) {
-#line 9032 ""
+#line 9022 ""
if (iposn == 1) {
-#line 9033 ""
+#line 9023 ""
if (*(unsigned char *)durq == 't' &&
comslur_1.fontslur) {
-#line 9034 ""
+#line 9024 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9034 ""
+#line 9024 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4,
"Slur ID not allowed on non-post"\
"script tie!", (ftnlen)128, (
ftnlen)42);
-#line 9036 ""
+#line 9026 ""
stop1_();
-#line 9037 ""
+#line 9027 ""
}
-#line 9038 ""
+#line 9028 ""
i__4 = a1ll_2.iccount;
-#line 9038 ""
+#line 9028 ""
if (s_cmp(lineq + i__4, "x", a1ll_2.iccount +
1 - i__4, (ftnlen)1) == 0) {
-#line 9038 ""
+#line 9028 ""
++a1ll_2.iccount;
-#line 9038 ""
+#line 9028 ""
}
-#line 9040 ""
+#line 9030 ""
goto L15;
-#line 9041 ""
+#line 9031 ""
}
-#line 9042 ""
+#line 9032 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9042 ""
+#line 9032 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID "\
"must be 2nd character in slur symbol!", (
ftnlen)128, (ftnlen)45);
-#line 9044 ""
+#line 9034 ""
stop1_();
-#line 9045 ""
+#line 9035 ""
}
-#line 9046 ""
+#line 9036 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9046 ""
+#line 9036 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in slur symbol!", (ftnlen)128, (ftnlen)
33);
-#line 9048 ""
+#line 9038 ""
stop1_();
-#line 9049 ""
+#line 9039 ""
}
-#line 9050 ""
+#line 9040 ""
goto L110;
-#line 9051 ""
+#line 9041 ""
} else if (i_indx("0123456789#-nx_", durq, (ftnlen)15, (
ftnlen)1) > 0) {
/* We have a figure. Only allow on 1st note of xtup */
-#line 9055 ""
+#line 9045 ""
if (itup != 2) {
-#line 9056 ""
+#line 9046 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9056 ""
+#line 9046 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt"\
"up only allowed on 1st note!", (ftnlen)128, (
ftnlen)40);
-#line 9058 ""
+#line 9048 ""
stop1_();
-#line 9059 ""
+#line 9049 ""
} else if (*(unsigned char *)durq == 'x') {
-#line 9060 ""
+#line 9050 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9060 ""
+#line 9050 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating "\
"figures in xtuplets!", (ftnlen)128, (ftnlen)
32);
-#line 9062 ""
+#line 9052 ""
stop1_();
-#line 9063 ""
+#line 9053 ""
}
-#line 9064 ""
+#line 9054 ""
if (compage_1.usefig && c1ommvl_1.ivx == 1) {
-#line 9064 ""
+#line 9054 ""
*ifig = 1;
-#line 9064 ""
+#line 9054 ""
}
-#line 9065 ""
+#line 9055 ""
L26:
-#line 9065 ""
+#line 9055 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
/* if (index('0123456789#-n_.:',durq) .gt. 0) then */
-#line 9067 ""
+#line 9057 ""
if (i_indx("0123456789#-n_.:v", durq, (ftnlen)17, (ftnlen)
1) > 0) {
-#line 9068 ""
+#line 9058 ""
goto L26;
-#line 9069 ""
+#line 9059 ""
} else if (*(unsigned char *)durq == 's') {
-#line 9070 ""
+#line 9060 ""
comligfont_1.isligfont = TRUE_;
-#line 9071 ""
+#line 9061 ""
goto L26;
-#line 9072 ""
+#line 9062 ""
} else if (*(unsigned char *)durq == '+') {
/* vertical offset, must be integer then blank */
-#line 9076 ""
+#line 9066 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 9077 ""
+#line 9067 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) !=
0) {
-#line 9078 ""
+#line 9068 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9078 ""
+#line 9068 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer "\
"for vertical offset expected here!", (
ftnlen)128, (ftnlen)42);
-#line 9080 ""
+#line 9070 ""
stop1_();
-#line 9081 ""
+#line 9071 ""
}
-#line 9082 ""
+#line 9072 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 9083 ""
+#line 9073 ""
if (*(unsigned char *)durq != ' ') {
-#line 9084 ""
+#line 9074 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9084 ""
+#line 9074 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical"\
" offset must terminate figure!", (ftnlen)
128, (ftnlen)38);
-#line 9086 ""
+#line 9076 ""
stop1_();
-#line 9087 ""
+#line 9077 ""
}
-#line 9088 ""
+#line 9078 ""
--a1ll_2.iccount;
-#line 9089 ""
+#line 9079 ""
goto L26;
-#line 9090 ""
+#line 9080 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 9091 ""
+#line 9081 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9091 ""
+#line 9081 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char"\
"acter in figure in xtuplet!", (ftnlen)128, (
ftnlen)39);
-#line 9093 ""
+#line 9083 ""
stop1_();
-#line 9094 ""
+#line 9084 ""
}
-#line 9095 ""
+#line 9085 ""
goto L110;
-#line 9096 ""
+#line 9086 ""
} else if (*(unsigned char *)durq == 'G') {
-#line 9097 ""
+#line 9087 ""
ngr = 1;
-#line 9098 ""
+#line 9088 ""
L79:
-#line 9098 ""
+#line 9088 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (
ftnlen)1);
-#line 9099 ""
+#line 9089 ""
if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0)
{
-#line 9100 ""
+#line 9090 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 9101 ""
+#line 9091 ""
ngr = i_nint(&fnum);
-#line 9102 ""
+#line 9092 ""
--a1ll_2.iccount;
-#line 9103 ""
+#line 9093 ""
goto L79;
-#line 9104 ""
+#line 9094 ""
} else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1)
> 0) {
-#line 9105 ""
+#line 9095 ""
goto L79;
-#line 9106 ""
+#line 9096 ""
} else if (*(unsigned char *)charq == 'm') {
-#line 9107 ""
+#line 9097 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
-#line 9108 ""
+#line 9098 ""
if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0)
{
-#line 9109 ""
+#line 9099 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9109 ""
+#line 9099 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit "\
"less than 5 must follow \"m\" in a grace"\
" note!", (ftnlen)128, (ftnlen)52);
-#line 9111 ""
+#line 9101 ""
stop1_();
-#line 9112 ""
+#line 9102 ""
}
-#line 9113 ""
+#line 9103 ""
goto L79;
-#line 9114 ""
+#line 9104 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note */
-#line 9118 ""
+#line 9108 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
-#line 9119 ""
+#line 9109 ""
if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)
1) > 0) {
-#line 9120 ""
+#line 9110 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 9121 ""
+#line 9111 ""
--a1ll_2.iccount;
-#line 9122 ""
+#line 9112 ""
goto L79;
-#line 9123 ""
+#line 9113 ""
} else {
-#line 9124 ""
+#line 9114 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9124 ""
+#line 9114 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number"\
" must follow \"X\" in a grace note!", (
ftnlen)128, (ftnlen)41);
-#line 9126 ""
+#line 9116 ""
stop1_();
-#line 9127 ""
+#line 9117 ""
}
-#line 9128 ""
+#line 9118 ""
}
/* At this point, charq is first note name in rest (grace?) */
-#line 9132 ""
+#line 9122 ""
i__4 = ngr;
-#line 9132 ""
+#line 9122 ""
for (igr = 1; igr <= i__4; ++igr) {
-#line 9133 ""
+#line 9123 ""
numnum = 0;
-#line 9134 ""
+#line 9124 ""
if (igr > 1) {
-#line 9135 ""
+#line 9125 ""
L75:
-#line 9135 ""
+#line 9125 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)
128, (ftnlen)1);
-#line 9136 ""
+#line 9126 ""
if (*(unsigned char *)charq == ' ') {
-#line 9136 ""
+#line 9126 ""
goto L75;
-#line 9136 ""
+#line 9126 ""
}
-#line 9137 ""
+#line 9127 ""
}
-#line 9138 ""
+#line 9128 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) ==
0) {
-#line 9139 ""
+#line 9129 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9139 ""
+#line 9129 ""
errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace"\
", expected \"a\"-\"g\"!", (ftnlen)128, (
ftnlen)27);
-#line 9141 ""
+#line 9131 ""
stop1_();
-#line 9142 ""
+#line 9132 ""
}
-#line 9143 ""
+#line 9133 ""
L78:
-#line 9143 ""
+#line 9133 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128,
(ftnlen)1);
-#line 9144 ""
+#line 9134 ""
if (*(unsigned char *)charq != ' ') {
-#line 9145 ""
+#line 9135 ""
if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1)
> 0) {
-#line 9146 ""
+#line 9136 ""
if (numnum == 1) {
-#line 9147 ""
+#line 9137 ""
i__5 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9147 ""
+#line 9137 ""
errmsg_(lineq, &a1ll_2.iccount, &i__5,
"Only one of \"+-1234567\" allow"\
"ed here in grace!", (ftnlen)128, (
ftnlen)46);
-#line 9149 ""
+#line 9139 ""
stop1_();
-#line 9150 ""
+#line 9140 ""
}
-#line 9151 ""
+#line 9141 ""
numnum = 1;
-#line 9152 ""
+#line 9142 ""
goto L78;
-#line 9153 ""
+#line 9143 ""
} else if (i_indx("+-nfs", charq, (ftnlen)5, (
ftnlen)1) > 0) {
-#line 9154 ""
+#line 9144 ""
goto L78;
-#line 9155 ""
+#line 9145 ""
}
/* Digits are possible octave numbers */
-#line 9159 ""
+#line 9149 ""
i__5 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9159 ""
+#line 9149 ""
errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal "\
"character after note name in grace!", (
ftnlen)128, (ftnlen)43);
-#line 9161 ""
+#line 9151 ""
stop1_();
-#line 9162 ""
+#line 9152 ""
}
-#line 9163 ""
+#line 9153 ""
/* L71: */
-#line 9163 ""
+#line 9153 ""
}
-#line 9164 ""
+#line 9154 ""
goto L110;
-#line 9165 ""
+#line 9155 ""
} else /* if(complicated condition) */ {
-#line 9165 ""
+#line 9155 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 9165 ""
+#line 9155 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0])
{
-#line 9166 ""
+#line 9156 ""
chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
-#line 9167 ""
+#line 9157 ""
if (literr > 0) {
-#line 9168 ""
+#line 9158 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9168 ""
+#line 9158 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, literq + (
literr - 1) * 51, (ftnlen)128, (ftnlen)51)
;
-#line 9170 ""
+#line 9160 ""
stop1_();
-#line 9171 ""
+#line 9161 ""
}
-#line 9172 ""
+#line 9162 ""
goto L110;
-#line 9173 ""
- } else if (*(unsigned char *)durq == '"') {
+#line 9163 ""
+ } else /* if(complicated condition) */ {
+#line 9163 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 9163 ""
+ if (*(unsigned char *)durq == *(unsigned char *)&
+ ch__2[0]) {
/* pmx lyric */
-#line 9177 ""
- chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)
- 128);
+#line 9167 ""
+ chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (
+ ftnlen)128);
+#line 9168 ""
+ if (lyrerr > 0) {
+#line 9169 ""
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 9169 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq
+ + (lyrerr - 1) * 51, (ftnlen)128, (
+ ftnlen)51);
+#line 9171 ""
+ stop1_();
+#line 9172 ""
+ }
+#line 9173 ""
+ goto L110;
+#line 9174 ""
+ } else if (*(unsigned char *)durq == 'M') {
+
+/* Temporary trap until I get around putting this in pmxb */
+
#line 9178 ""
- if (lyrerr > 0) {
-#line 9179 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9179 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, lyrerq + (
- lyrerr - 1) * 51, (ftnlen)128, (ftnlen)51)
- ;
-#line 9181 ""
+#line 9178 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros n"\
+ "ot yet allowed in xtuplets!", (ftnlen)128,
+ (ftnlen)35);
+#line 9180 ""
stop1_();
+#line 9181 ""
+ } else if (*(unsigned char *)durq == 'X') {
#line 9182 ""
- }
-#line 9183 ""
- goto L110;
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9182 ""
+ g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton,
+ &i__4, &c1omnotes_1.udsp[
+ c1omnotes_1.ibarcnt + a1ll_2.nbars], &
+ c1omnotes_1.wheadpt, (ftnlen)128);
#line 9184 ""
- } else if (*(unsigned char *)durq == 'M') {
+ goto L110;
+#line 9185 ""
+ } else if (*(unsigned char *)durq == 'z') {
-/* Temporary trap until I get around putting this in pmxb */
+/* Chord note in xtup. Read past for now. */
-#line 9188 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9188 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y"\
- "et allowed in xtuplets!", (ftnlen)128, (
- ftnlen)35);
+#line 9189 ""
+L33:
+#line 9189 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 9190 ""
- stop1_();
+ if (*(unsigned char *)durq != ' ') {
+#line 9190 ""
+ goto L33;
+#line 9190 ""
+ }
#line 9191 ""
- } else if (*(unsigned char *)durq == 'X') {
-#line 9192 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ goto L110;
#line 9192 ""
- g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &
- i__4, &c1omnotes_1.udsp[c1omnotes_1.ibarcnt +
- a1ll_2.nbars], &c1omnotes_1.wheadpt, (ftnlen)
- 128);
-#line 9194 ""
- goto L110;
-#line 9195 ""
- } else if (*(unsigned char *)durq == 'z') {
+ } else if (*(unsigned char *)durq == 'D') {
-/* Chord note in xtup. Read past for now. */
+/* Dynamic mark */
+#line 9196 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9196 ""
+ checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)
+ 128);
+#line 9197 ""
+ goto L110;
+#line 9198 ""
+ } else if (*(unsigned char *)durq == '%') {
#line 9199 ""
-L33:
-#line 9199 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ if (a1ll_2.iccount != 1) {
#line 9200 ""
- if (*(unsigned char *)durq != ' ') {
-#line 9200 ""
- goto L33;
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
#line 9200 ""
- }
-#line 9201 ""
- goto L110;
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comm"\
+ "ent must have \"%\" in column 1!", (
+ ftnlen)128, (ftnlen)34);
#line 9202 ""
- } else if (*(unsigned char *)durq == 'D') {
-
-/* Dynamic mark */
-
-#line 9206 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
+#line 9203 ""
+ }
+#line 9204 ""
+ a1ll_2.iccount = 128;
+#line 9205 ""
+ goto L110;
#line 9206 ""
- checkdyn_(lineq, &a1ll_2.iccount, &i__4, (ftnlen)128);
+ } else if (*(unsigned char *)durq == '?') {
#line 9207 ""
- goto L110;
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 9208 ""
- } else if (*(unsigned char *)durq == '%') {
+ if (*(unsigned char *)durq == ' ') {
#line 9209 ""
- if (a1ll_2.iccount != 1) {
-#line 9210 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
+ --a1ll_2.iccount;
#line 9210 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment "\
- "must have \"%\" in column 1!", (ftnlen)
- 128, (ftnlen)34);
+ goto L110;
+#line 9211 ""
+ }
#line 9212 ""
- stop1_();
+ if (*(unsigned char *)durq != '-') {
#line 9213 ""
- }
-#line 9214 ""
- a1ll_2.iccount = 128;
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 9213 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\
+ "cting \"-\"", (ftnlen)128, (ftnlen)13)
+ ;
#line 9215 ""
- goto L110;
+ stop1_();
#line 9216 ""
- } else if (*(unsigned char *)durq == '?') {
+ }
#line 9217 ""
- getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 9218 ""
- if (*(unsigned char *)durq == ' ') {
+ if (i_indx("0123456789.", durq, (ftnlen)11, (
+ ftnlen)1) == 0) {
#line 9219 ""
- --a1ll_2.iccount;
-#line 9220 ""
- goto L110;
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 9219 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\
+ "cting number", (ftnlen)128, (ftnlen)
+ 16);
#line 9221 ""
- }
+ stop1_();
#line 9222 ""
- if (*(unsigned char *)durq != '-') {
-#line 9223 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
+ }
#line 9223 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\
- "g \"-\"", (ftnlen)128, (ftnlen)13);
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
+ ftnlen)128, (ftnlen)1);
+#line 9224 ""
+ --a1ll_2.iccount;
#line 9225 ""
- stop1_();
-#line 9226 ""
- }
-#line 9227 ""
- getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 9228 ""
- if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1)
- == 0) {
-#line 9229 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
-#line 9229 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin"\
- "g number", (ftnlen)128, (ftnlen)16);
-#line 9231 ""
- stop1_();
-#line 9232 ""
- }
-#line 9233 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
- 128, (ftnlen)1);
-#line 9234 ""
- --a1ll_2.iccount;
-#line 9235 ""
- goto L110;
+ goto L110;
/* 140215 Allow clef change inside xtup */
-#line 9239 ""
- } else if (*(unsigned char *)durq == 'C') {
-#line 9240 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 9241 ""
- if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1)
- > 0 || *(unsigned char *)durq >= 48 && *(
- unsigned char *)durq <= 56)) {
+#line 9229 ""
+ } else if (*(unsigned char *)durq == 'C') {
+#line 9230 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
+#line 9231 ""
+ if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (
+ ftnlen)1) > 0 || *(unsigned char *)durq >=
+ 48 && *(unsigned char *)durq <= 56)) {
/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */
-#line 9244 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
-#line 9244 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\
- "e t,s,m,a,n,r,b,f or 0-8 after C!", (
- ftnlen)128, (ftnlen)41);
-#line 9246 ""
- stop1_();
-#line 9247 ""
- }
-/* gotclef = .true. */
-#line 9249 ""
- goto L110;
-/* +++ */
-#line 9251 ""
- } else /* if(complicated condition) */ {
-#line 9251 ""
- i__4 = a1ll_2.iccount;
-#line 9251 ""
- i__5 = a1ll_2.iccount + 1;
-#line 9251 ""
- if (*(unsigned char *)durq == ']' && s_cmp(lineq +
- i__4, "[", a1ll_2.iccount + 1 - i__4, (ftnlen)
- 1) == 0 && s_cmp(lineq + i__5, " ",
- a1ll_2.iccount + 2 - i__5, (ftnlen)1) == 0) {
-#line 9253 ""
- a1ll_2.iccount += 2;
-#line 9254 ""
+#line 9234 ""
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 9234 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must"\
+ " have t,s,m,a,n,r,b,f or 0-8 after C!"
+ , (ftnlen)128, (ftnlen)41);
+#line 9236 ""
+ stop1_();
+#line 9237 ""
+ }
+#line 9238 ""
goto L110;
/* +++ */
+#line 9240 ""
+ } else /* if(complicated condition) */ {
+#line 9240 ""
+ i__4 = a1ll_2.iccount;
+#line 9240 ""
+ i__5 = a1ll_2.iccount + 1;
+#line 9240 ""
+ if (*(unsigned char *)durq == ']' && s_cmp(lineq
+ + i__4, "[", a1ll_2.iccount + 1 - i__4, (
+ ftnlen)1) == 0 && s_cmp(lineq + i__5,
+ " ", a1ll_2.iccount + 2 - i__5, (ftnlen)1)
+ == 0) {
+#line 9242 ""
+ a1ll_2.iccount += 2;
+#line 9243 ""
+ goto L110;
+/* +++ */
/* Added 200118 to allow dot to be moved on 2nd note of 2-note tremolo */
-#line 9259 ""
+#line 9248 ""
+ }
+#line 9248 ""
}
-#line 9259 ""
+#line 9248 ""
}
-#line 9259 ""
+#line 9248 ""
}
/* End of xtup options. At this point symbol can only be note or rest */
-#line 9263 ""
+#line 9252 ""
if (i_indx("abcdefgr", durq, (ftnlen)8, (ftnlen)1) == 0) {
-#line 9264 ""
+#line 9253 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9264 ""
+#line 9253 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch"\
"aracter is not allowed!", (ftnlen)128, (ftnlen)39)
;
-#line 9266 ""
+#line 9255 ""
stop1_();
-#line 9267 ""
+#line 9256 ""
}
-#line 9268 ""
+#line 9257 ""
L7:
-#line 9268 ""
+#line 9257 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 9269 ""
+#line 9258 ""
if (i_indx("12345678ulcb", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 9270 ""
+#line 9259 ""
goto L7;
-#line 9271 ""
+#line 9260 ""
} else if (i_indx("sfn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Check for MIDI-only accidental. Cannot coexist with accid. pos'n shift. */
-#line 9275 ""
+#line 9264 ""
i__4 = a1ll_2.iccount;
-#line 9275 ""
+#line 9264 ""
if (s_cmp(lineq + i__4, "i", a1ll_2.iccount + 1 - i__4, (
ftnlen)1) == 0) {
-#line 9275 ""
+#line 9264 ""
++a1ll_2.iccount;
-#line 9275 ""
+#line 9264 ""
}
-#line 9276 ""
+#line 9265 ""
goto L7;
-#line 9277 ""
+#line 9266 ""
} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
/* May have either octave jump or shifted accid. on main xtup note */
-#line 9281 ""
+#line 9270 ""
i__4 = a1ll_2.iccount;
-#line 9281 ""
+#line 9270 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0 &&
i_indx("01234567890", lineq + i__4, (ftnlen)11,
a1ll_2.iccount + 1 - i__4) == 0) {
-#line 9281 ""
+#line 9270 ""
goto L7;
-#line 9281 ""
+#line 9270 ""
}
-#line 9284 ""
+#line 9273 ""
++a1ll_2.iccount;
-#line 9285 ""
+#line 9274 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
(ftnlen)1);
-#line 9286 ""
+#line 9275 ""
--a1ll_2.iccount;
-#line 9287 ""
+#line 9276 ""
goto L7;
-#line 9288 ""
+#line 9277 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double an xtup note to make an unequal xtup */
-#line 9292 ""
+#line 9281 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx -
1] * 24 - 25] = bit_set(c1ommvl_1.nacc[
c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25],18);
-#line 9293 ""
+#line 9282 ""
++ndoub;
-#line 9294 ""
+#line 9283 ""
goto L7;
-#line 9295 ""
+#line 9284 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 9296 ""
+#line 9285 ""
if (twotrem) {
/* 2-note trem, get shift */
-#line 9300 ""
+#line 9289 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 9301 ""
+#line 9290 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 9302 ""
+#line 9291 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9302 ""
+#line 9291 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expected"\
" +/- for shifted dot on end of 2-note tr"\
"em!", (ftnlen)128, (ftnlen)51);
-#line 9304 ""
+#line 9293 ""
stop1_();
-#line 9305 ""
+#line 9294 ""
}
-#line 9306 ""
+#line 9295 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 9307 ""
+#line 9296 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1)
== 0) {
-#line 9308 ""
+#line 9297 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ a1ll_2.nbars + 1;
-#line 9308 ""
+#line 9297 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expected"\
" number here!", (ftnlen)128, (ftnlen)21);
-#line 9310 ""
+#line 9299 ""
stop1_();
-#line 9311 ""
+#line 9300 ""
}
-#line 9312 ""
+#line 9301 ""
readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 9313 ""
+#line 9302 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift also */
-#line 9317 ""
+#line 9306 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
128, (ftnlen)1);
-#line 9318 ""
+#line 9307 ""
if (i_indx("0123456789-.", durq, (ftnlen)12, (
ftnlen)1) == 0) {
-#line 9319 ""
+#line 9308 ""
i__4 = c1omnotes_1.ibarcnt -
c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9319 ""
+#line 9308 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expe"\
"cted number after 2nd +/- (shift dot"\
")!", (ftnlen)128, (ftnlen)42);
-#line 9321 ""
+#line 9310 ""
stop1_();
-#line 9322 ""
+#line 9311 ""
}
-#line 9323 ""
+#line 9312 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 9324 ""
+#line 9313 ""
}
-#line 9325 ""
+#line 9314 ""
--a1ll_2.iccount;
-#line 9326 ""
+#line 9315 ""
goto L7;
-#line 9327 ""
+#line 9316 ""
} else {
-#line 9328 ""
+#line 9317 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25] = bit_set(
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25],27);
-#line 9329 ""
+#line 9318 ""
}
-#line 9330 ""
+#line 9319 ""
goto L7;
-#line 9331 ""
+#line 9320 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 9332 ""
+#line 9321 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9332 ""
+#line 9321 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o"\
"n xtuplet note!", (ftnlen)128, (ftnlen)31);
-#line 9334 ""
+#line 9323 ""
stop1_();
-#line 9335 ""
+#line 9324 ""
}
-#line 9336 ""
+#line 9325 ""
if (itup == ntup - ndoub) {
-#line 9336 ""
+#line 9325 ""
goto L3;
-#line 9336 ""
+#line 9325 ""
}
-#line 9337 ""
+#line 9326 ""
/* L6: */
-#line 9337 ""
+#line 9326 ""
}
-#line 9338 ""
+#line 9327 ""
L3:
/* 6==End of loop for xtuplet input */
-#line 9342 ""
+#line 9331 ""
;
-#line 9342 ""
+#line 9331 ""
} else if (*(unsigned char *)durq == 'm') {
/* Multi-bar rest: next 1 or two digits are # of bars. */
-#line 9346 ""
+#line 9335 ""
if (a1ll_2.itsofar[a1ll_2.iv - 1] % a1ll_2.lenbar != 0) {
-#line 9347 ""
+#line 9336 ""
i__1 = a1ll_2.iccount - 1;
-#line 9347 ""
+#line 9336 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9347 ""
+#line 9336 ""
errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be"\
"ginning of bar!", (ftnlen)128, (ftnlen)45);
-#line 9349 ""
+#line 9338 ""
stop1_();
-#line 9350 ""
+#line 9339 ""
} else if (a1ll_2.iv == 1 && c1omnotes_1.ibarmbr > 0) {
-#line 9351 ""
+#line 9340 ""
i__1 = a1ll_2.iccount - 1;
-#line 9351 ""
+#line 9340 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9351 ""
+#line 9340 ""
errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t"\
"ime per block!", (ftnlen)128, (ftnlen)44);
-#line 9353 ""
+#line 9342 ""
stop1_();
-#line 9354 ""
+#line 9343 ""
}
/* For some purposes, pretend its one bar only */
-#line 9358 ""
+#line 9347 ""
a1ll_2.nodur[a1ll_2.iv + a1ll_2.nnl[a1ll_2.iv - 1] * 24 - 25] =
a1ll_2.lenbar;
-#line 9359 ""
+#line 9348 ""
c1omnotes_1.ibarmbr = a1ll_2.nbars + 1;
-#line 9360 ""
+#line 9349 ""
c1omnotes_1.mbrest = 0;
/* 20 call g1etchar(lineq,iccount,durq) */
-#line 9362 ""
+#line 9351 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9363 ""
+#line 9352 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 9364 ""
+#line 9353 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9364 ""
+#line 9353 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer "\
"after \"rm\"!", (ftnlen)128, (ftnlen)31);
-#line 9366 ""
+#line 9355 ""
stop1_();
-#line 9367 ""
+#line 9356 ""
}
-#line 9368 ""
+#line 9357 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9369 ""
+#line 9358 ""
c1omnotes_1.mbrest = i_nint(&fnum);
/* iccount = iccount-1 */
-#line 9371 ""
+#line 9360 ""
if (a1ll_2.nv > 1) {
-#line 9372 ""
+#line 9361 ""
if (a1ll_2.iv == 1) {
-#line 9373 ""
+#line 9362 ""
comkeys_1.mbrestsav = c1omnotes_1.mbrest;
-#line 9374 ""
+#line 9363 ""
} else {
-#line 9375 ""
+#line 9364 ""
if (c1omnotes_1.mbrest != comkeys_1.mbrestsav) {
-#line 9376 ""
+#line 9365 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9376 ""
+#line 9365 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s"\
"ame multi-bar rest in every voice!", (ftnlen)
128, (ftnlen)46);
-#line 9378 ""
+#line 9367 ""
stop1_();
-#line 9379 ""
+#line 9368 ""
}
-#line 9380 ""
+#line 9369 ""
}
/* Zero out mbrestsav so can check at end of input block whether */
/* all voices have one */
-#line 9385 ""
+#line 9374 ""
if (a1ll_2.iv == a1ll_2.nv) {
-#line 9385 ""
+#line 9374 ""
comkeys_1.mbrestsav = 0;
-#line 9385 ""
+#line 9374 ""
}
-#line 9386 ""
+#line 9375 ""
}
-#line 9387 ""
+#line 9376 ""
if (*(unsigned char *)durq == 'n') {
/* Get new height */
-#line 9391 ""
+#line 9380 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 9392 ""
+#line 9381 ""
if (i_indx("+-123456789", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 9393 ""
+#line 9382 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9393 ""
+#line 9382 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an inte"\
"ger after \"rm[x]n\"!", (ftnlen)128, (ftnlen)35);
-#line 9395 ""
+#line 9384 ""
stop1_();
-#line 9396 ""
+#line 9385 ""
}
-#line 9397 ""
+#line 9386 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) != 0) {
-#line 9397 ""
+#line 9386 ""
++a1ll_2.iccount;
-#line 9397 ""
+#line 9386 ""
}
-#line 9398 ""
+#line 9387 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9399 ""
+#line 9388 ""
}
-#line 9400 ""
+#line 9389 ""
if (*(unsigned char *)durq != ' ') {
-#line 9401 ""
+#line 9390 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9401 ""
+#line 9390 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
"ter \"rm\"!", (ftnlen)128, (ftnlen)29);
-#line 9403 ""
+#line 9392 ""
stop1_();
-#line 9404 ""
+#line 9393 ""
}
-#line 9405 ""
+#line 9394 ""
} else if (*(unsigned char *)durq == '.') {
/* Dotted pattern. Close out note. Mult time by 3/4. */
/* Set time for next note to 1/4. Start the note. */
-#line 9410 ""
+#line 9399 ""
idotform = 1;
-#line 9411 ""
+#line 9400 ""
} else if (*(unsigned char *)durq == ',') {
-#line 9412 ""
+#line 9401 ""
idotform = 3;
/* Now flow to duration setting, as if durq=' ' */
-#line 9416 ""
+#line 9405 ""
} else if (i_indx("oL", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Suppress full bar rest, or look left for height */
-#line 9420 ""
+#line 9409 ""
if (*(unsigned char *)charq != 'r') {
-#line 9421 ""
+#line 9410 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9421 ""
+#line 9410 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options "\
"only legal for rest, not note!", (ftnlen)128, (ftnlen)
46);
-#line 9423 ""
+#line 9412 ""
stop1_();
-#line 9424 ""
+#line 9413 ""
}
-#line 9425 ""
+#line 9414 ""
goto L2;
-#line 9426 ""
+#line 9415 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double note for xtup. Must check here in case "D" or "F" came before "x" or on */
/* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */
-#line 9431 ""
+#line 9420 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24
- 25] = bit_set(c1ommvl_1.nacc[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25],18);
-#line 9432 ""
+#line 9421 ""
goto L2;
-#line 9433 ""
+#line 9422 ""
} else if (*(unsigned char *)durq == 'A') {
/* Main note accidental option */
-#line 9437 ""
+#line 9426 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9438 ""
+#line 9427 ""
if (i_indx("o+-<>", durq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 9439 ""
+#line 9428 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9439 ""
+#line 9428 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\""\
"<\",\">\" are the only legal options here!", (ftnlen)
128, (ftnlen)51);
-#line 9441 ""
+#line 9430 ""
stop1_();
-#line 9442 ""
+#line 9431 ""
}
/* Need more stuff here */
-#line 9446 ""
+#line 9435 ""
if (*(unsigned char *)durq != 'o') {
/* Back up 1, flow out, will get +|-|<|> next loop preceded by "A", and will */
/* proceed to number input checking */
-#line 9451 ""
+#line 9440 ""
--a1ll_2.iccount;
-#line 9452 ""
+#line 9441 ""
}
-#line 9453 ""
+#line 9442 ""
goto L2;
-#line 9454 ""
+#line 9443 ""
} else if (*(unsigned char *)durq == 'T') {
/* Single stem tremolo. Only option (optional) is 1,2,3, or 4. */
-#line 9458 ""
+#line 9447 ""
getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9459 ""
+#line 9448 ""
if (i_indx("1234", durq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 9459 ""
+#line 9448 ""
--a1ll_2.iccount;
-#line 9459 ""
+#line 9448 ""
}
-#line 9460 ""
+#line 9449 ""
goto L2;
-#line 9461 ""
+#line 9450 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 9462 ""
+#line 9451 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9462 ""
+#line 9451 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character!", (
ftnlen)128, (ftnlen)18);
-#line 9464 ""
+#line 9453 ""
s_wsle(&io___659);
-#line 9464 ""
+#line 9453 ""
do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
-#line 9464 ""
+#line 9453 ""
i__1 = *(unsigned char *)durq;
-#line 9464 ""
+#line 9453 ""
do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 9464 ""
+#line 9453 ""
e_wsle();
-#line 9465 ""
+#line 9454 ""
stop1_();
-#line 9466 ""
+#line 9455 ""
}
/* End of block for note options. */
/* Set the duration */
-#line 9472 ""
+#line 9461 ""
if (idotform > 0) {
-#line 9473 ""
+#line 9462 ""
if (idotform == 1) {
-#line 9474 ""
+#line 9463 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (
ftnlen)1) * 3 / 2;
-#line 9475 ""
+#line 9464 ""
} else if (idotform == 2) {
-#line 9476 ""
+#line 9465 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[
c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 3;
-#line 9477 ""
+#line 9466 ""
} else if (idotform == 3) {
-#line 9478 ""
+#line 9467 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (
ftnlen)1);
-#line 9479 ""
+#line 9468 ""
} else if (idotform == 4) {
-#line 9480 ""
+#line 9469 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[
c1ommvl_1.ivx - 1] - 1) * 24 - 25] / 2;
-#line 9481 ""
+#line 9470 ""
}
-#line 9482 ""
+#line 9471 ""
} else if (c1omnotes_1.ibarmbr != a1ll_2.nbars + 1 && ! fulbrp) {
-#line 9483 ""
+#line 9472 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
25] = i1fnodur_(&c1omnotes_1.nnodur, dotq, (ftnlen)1);
/* Check for double dot */
-#line 9487 ""
+#line 9476 ""
if (c1omnotes_1.iddot == 1) {
-#line 9488 ""
+#line 9477 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[
c1ommvl_1.ivx - 1] * 24 - 25] * 7 / 6;
-#line 9489 ""
+#line 9478 ""
c1omnotes_1.iddot = 0;
-#line 9490 ""
+#line 9479 ""
}
-#line 9491 ""
+#line 9480 ""
} else if (fulbrp) {
-#line 9492 ""
+#line 9481 ""
a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
25] = a1ll_2.lenbar;
/* Use a one-line function to set nnodur. It gives inverse of ifnodur. */
-#line 9496 ""
+#line 9485 ""
i__1 = (integer) (log(a1ll_2.lenbar + .1f) / .69315f) + 48;
-#line 9496 ""
+#line 9485 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 9496 ""
+#line 9485 ""
c1omnotes_1.nnodur = i_indx("62514x0x37", ch__2, (ftnlen)10, (
ftnlen)1) - 1;
-#line 9498 ""
+#line 9487 ""
fulbrp = FALSE_;
-#line 9499 ""
+#line 9488 ""
}
-#line 9500 ""
+#line 9489 ""
a1ll_2.rest[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] =
*(unsigned char *)charq == 'r';
/* If inside forced beam, check if note is beamable */
-#line 9504 ""
+#line 9493 ""
if (c1omget_1.fbon) {
-#line 9505 ""
+#line 9494 ""
if (a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
24 - 25] < 16) {
-#line 9505 ""
+#line 9494 ""
goto L120;
-#line 9505 ""
+#line 9494 ""
}
-#line 9506 ""
+#line 9495 ""
if (a1ll_2.nnl[c1ommvl_1.ivx - 1] > 1) {
-#line 9507 ""
+#line 9496 ""
if (a1ll_2.nodur[c1ommvl_1.ivx + (a1ll_2.nnl[c1ommvl_1.ivx -
1] - 1) * 24 - 25] == 0) {
-#line 9507 ""
+#line 9496 ""
goto L120;
-#line 9507 ""
+#line 9496 ""
}
-#line 9508 ""
+#line 9497 ""
}
-#line 9509 ""
+#line 9498 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9509 ""
+#line 9498 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc"\
"ed beam!", (ftnlen)128, (ftnlen)32);
-#line 9511 ""
+#line 9500 ""
stop1_();
-#line 9512 ""
+#line 9501 ""
}
-#line 9513 ""
+#line 9502 ""
L120:
/* Get number of prior bars for later check on whether note spans bar line */
-#line 9517 ""
+#line 9506 ""
nbb4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
-#line 9518 ""
+#line 9507 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[c1ommvl_1.ivx +
a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25];
-#line 9519 ""
+#line 9508 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar == 0) {
-#line 9520 ""
+#line 9509 ""
++a1ll_2.nbars;
-#line 9521 ""
+#line 9510 ""
if (comkeys_1.shifton) {
-#line 9521 ""
+#line 9510 ""
comkeys_1.barend = TRUE_;
-#line 9521 ""
+#line 9510 ""
}
/* Will check barend when 1st note of next bar is entered. */
-#line 9525 ""
+#line 9514 ""
if (a1ll_2.nbars > 15) {
-#line 9526 ""
+#line 9515 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9526 ""
+#line 9515 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha"\
"n 15 bars in an input block!", (ftnlen)128, (ftnlen)
48);
-#line 9528 ""
+#line 9517 ""
stop1_();
-#line 9529 ""
+#line 9518 ""
}
-#line 9530 ""
+#line 9519 ""
a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.nbars * 24 - 25] = a1ll_2.nnl[
c1ommvl_1.ivx - 1];
-#line 9531 ""
+#line 9520 ""
if (a1ll_2.firstline && a1ll_2.lenbar != a1ll_2.lenbr1) {
/* Just finished the pickup bar for this voice. */
-#line 9535 ""
+#line 9524 ""
if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] != a1ll_2.lenbr0) {
-#line 9536 ""
+#line 9525 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9536 ""
+#line 9525 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt"\
"h disagrees with mtrnum0!", (ftnlen)128, (ftnlen)
41);
-#line 9538 ""
+#line 9527 ""
stop1_();
-#line 9539 ""
+#line 9528 ""
}
-#line 9540 ""
+#line 9529 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
-#line 9541 ""
+#line 9530 ""
a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
-#line 9542 ""
+#line 9531 ""
}
-#line 9543 ""
+#line 9532 ""
} else if (comkeys_1.barend) {
-#line 9544 ""
+#line 9533 ""
if (comkeys_1.shifton) {
-#line 9545 ""
+#line 9534 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9545 ""
+#line 9534 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
"defined shift still on!", (ftnlen)128, (ftnlen)43);
-#line 9547 ""
+#line 9536 ""
stop1_();
-#line 9548 ""
+#line 9537 ""
}
-#line 9549 ""
+#line 9538 ""
comkeys_1.barend = FALSE_;
-#line 9550 ""
+#line 9539 ""
} else if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar > nbb4) {
-#line 9551 ""
+#line 9540 ""
i__1 = a1ll_2.iccount - 1;
-#line 9551 ""
+#line 9540 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9551 ""
+#line 9540 ""
errmsg_(lineq, &i__1, &i__4, "This note spans a bar line!", (
ftnlen)128, (ftnlen)27);
-#line 9553 ""
+#line 9542 ""
stop1_();
-#line 9554 ""
+#line 9543 ""
}
-#line 9555 ""
+#line 9544 ""
if (idotform == 1 || idotform == 3) {
-#line 9556 ""
+#line 9545 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9557 ""
+#line 9546 ""
if (i_indx("abcedfgr", charq, (ftnlen)8, (ftnlen)1) == 0) {
-#line 9558 ""
+#line 9547 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9558 ""
+#line 9547 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o"\
"r \"r\" here!", (ftnlen)128, (ftnlen)31);
-#line 9560 ""
+#line 9549 ""
stop1_();
-#line 9561 ""
+#line 9550 ""
}
-#line 9562 ""
+#line 9551 ""
++idotform;
-#line 9563 ""
+#line 9552 ""
numnum = 1;
-#line 9564 ""
+#line 9553 ""
goto L28;
-#line 9565 ""
+#line 9554 ""
}
/* End of sub block for note-rest */
-#line 9569 ""
+#line 9558 ""
} else if (*(unsigned char *)charq == 'z') {
-#line 9570 ""
+#line 9559 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9571 ""
+#line 9560 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
-#line 9572 ""
+#line 9561 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9572 ""
+#line 9561 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name"\
" here!", (ftnlen)128, (ftnlen)30);
-#line 9574 ""
+#line 9563 ""
stop1_();
-#line 9575 ""
+#line 9564 ""
}
-#line 9576 ""
+#line 9565 ""
L25:
-#line 9576 ""
+#line 9565 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
/* if (index('dre12345678',durq) .gt. 0) then */
-#line 9578 ""
+#line 9567 ""
if (i_indx("dre12345678c", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 9579 ""
+#line 9568 ""
goto L25;
-#line 9580 ""
+#line 9569 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Check for midi-only accid. CANNOT coesist with accidental position tweaks, so */
/* MUST come right after "f,s,n" */
-#line 9585 ""
+#line 9574 ""
i__1 = a1ll_2.iccount;
-#line 9585 ""
+#line 9574 ""
if (s_cmp(lineq + i__1, "i", a1ll_2.iccount + 1 - i__1, (ftnlen)1)
== 0) {
-#line 9585 ""
+#line 9574 ""
++a1ll_2.iccount;
-#line 9585 ""
+#line 9574 ""
}
-#line 9586 ""
+#line 9575 ""
goto L25;
-#line 9587 ""
+#line 9576 ""
} else if (*(unsigned char *)durq == 'A') {
-#line 9588 ""
+#line 9577 ""
i__1 = a1ll_2.iccount - 2;
-#line 9588 ""
+#line 9577 ""
if (i_indx("fsn", lineq + i__1, (ftnlen)3, a1ll_2.iccount - 1 -
i__1) == 0) {
-#line 9589 ""
+#line 9578 ""
i__1 = a1ll_2.iccount - 1;
-#line 9589 ""
+#line 9578 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9589 ""
+#line 9578 ""
errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \""\
"A\" in chord note!", (ftnlen)128, (ftnlen)43);
-#line 9591 ""
+#line 9580 ""
stop1_();
-#line 9592 ""
+#line 9581 ""
}
-#line 9593 ""
+#line 9582 ""
goto L25;
-#line 9594 ""
+#line 9583 ""
} else if (i_indx("<>", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 9595 ""
+#line 9584 ""
i__1 = a1ll_2.iccount - 2;
-#line 9595 ""
+#line 9584 ""
if (i_indx("fsnA", lineq + i__1, (ftnlen)4, a1ll_2.iccount - 1 -
i__1) == 0) {
/* if (index('fsncA',lineq(iccount-1:iccount-1)) .eq. 0) then ! Causes problems */
-#line 9597 ""
+#line 9586 ""
i__1 = a1ll_2.iccount - 1;
-#line 9597 ""
+#line 9586 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9597 ""
+#line 9586 ""
errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before"\
" \"<\" or \">\"!", (ftnlen)128, (ftnlen)38);
-#line 9599 ""
+#line 9588 ""
stop1_();
-#line 9600 ""
+#line 9589 ""
}
-#line 9601 ""
+#line 9590 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9602 ""
+#line 9591 ""
if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 9603 ""
+#line 9592 ""
i__1 = a1ll_2.iccount - 1;
-#line 9603 ""
+#line 9592 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9603 ""
+#line 9592 ""
errmsg_(lineq, &i__1, &i__4, "Expected a number to start her"\
"e for accidental shift!", (ftnlen)128, (ftnlen)53);
-#line 9605 ""
+#line 9594 ""
stop1_();
-#line 9606 ""
+#line 9595 ""
}
-#line 9607 ""
+#line 9596 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9608 ""
+#line 9597 ""
--a1ll_2.iccount;
-#line 9609 ""
+#line 9598 ""
goto L25;
-#line 9610 ""
+#line 9599 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 9611 ""
+#line 9600 ""
i__1 = a1ll_2.iccount;
-#line 9611 ""
+#line 9600 ""
if (i_indx("1234567890.", lineq + i__1, (ftnlen)11,
a1ll_2.iccount + 1 - i__1) == 0) {
-#line 9611 ""
+#line 9600 ""
goto L25;
-#line 9611 ""
+#line 9600 ""
}
/* Number or '.' (durq) follows +/- . Get it. */
-#line 9616 ""
+#line 9605 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9617 ""
+#line 9606 ""
i__1 = a1ll_2.iccount;
-#line 9617 ""
+#line 9606 ""
if (*(unsigned char *)durq == '.' && i_indx("1234567890", lineq +
i__1, (ftnlen)10, a1ll_2.iccount + 1 - i__1) == 0) {
-#line 9619 ""
+#line 9608 ""
i__1 = a1ll_2.iccount - 1;
-#line 9619 ""
+#line 9608 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9619 ""
+#line 9608 ""
errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by"\
" a digit!", (ftnlen)128, (ftnlen)37);
-#line 9621 ""
+#line 9610 ""
stop1_();
-#line 9622 ""
+#line 9611 ""
} else /* if(complicated condition) */ {
-#line 9622 ""
+#line 9611 ""
i__1 = a1ll_2.iccount - 3;
-#line 9622 ""
+#line 9611 ""
if (i_indx("sfndA", lineq + i__1, (ftnlen)5, a1ll_2.iccount -
2 - i__1) == 0) {
-#line 9623 ""
+#line 9612 ""
i__1 = a1ll_2.iccount - 1;
-#line 9623 ""
+#line 9612 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9623 ""
+#line 9612 ""
errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll"\
"ow \"d,s,f,n,A\"!", (ftnlen)128, (ftnlen)41);
-#line 9625 ""
+#line 9614 ""
stop1_();
-#line 9626 ""
+#line 9615 ""
}
-#line 9626 ""
+#line 9615 ""
}
-#line 9627 ""
+#line 9616 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9628 ""
+#line 9617 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 9629 ""
+#line 9618 ""
--a1ll_2.iccount;
-#line 9630 ""
+#line 9619 ""
goto L25;
-#line 9631 ""
+#line 9620 ""
}
/* 2nd +/- */
-#line 9635 ""
+#line 9624 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 9636 ""
+#line 9625 ""
if (*(unsigned char *)durq == '.') {
-#line 9636 ""
+#line 9625 ""
g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
1);
-#line 9636 ""
+#line 9625 ""
}
-#line 9637 ""
+#line 9626 ""
if (i_indx("1234567890", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 9638 ""
+#line 9627 ""
i__1 = a1ll_2.iccount - 1;
-#line 9638 ""
+#line 9627 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9638 ""
+#line 9627 ""
errmsg_(lineq, &i__1, &i__4, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
-#line 9640 ""
+#line 9629 ""
stop1_();
-#line 9641 ""
+#line 9630 ""
}
-#line 9642 ""
+#line 9631 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9643 ""
+#line 9632 ""
--a1ll_2.iccount;
-#line 9644 ""
+#line 9633 ""
goto L25;
-#line 9645 ""
+#line 9634 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 9646 ""
+#line 9635 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
1;
-#line 9646 ""
+#line 9635 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho"\
"rd note!", (ftnlen)128, (ftnlen)32);
-#line 9648 ""
+#line 9637 ""
stop1_();
-#line 9649 ""
+#line 9638 ""
}
-#line 9650 ""
+#line 9639 ""
} else if (*(unsigned char *)charq == 'G') {
-#line 9651 ""
+#line 9640 ""
ngr = 1;
-#line 9652 ""
+#line 9641 ""
L9:
-#line 9652 ""
+#line 9641 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9653 ""
+#line 9642 ""
if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
-#line 9654 ""
+#line 9643 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9655 ""
+#line 9644 ""
ngr = i_nint(&fnum);
-#line 9656 ""
+#line 9645 ""
--a1ll_2.iccount;
-#line 9657 ""
+#line 9646 ""
goto L9;
-#line 9658 ""
+#line 9647 ""
} else if (i_indx("AWulxs", charq, (ftnlen)6, (ftnlen)1) > 0) {
-#line 9659 ""
+#line 9648 ""
goto L9;
-#line 9660 ""
+#line 9649 ""
} else if (*(unsigned char *)charq == 'm') {
-#line 9661 ""
+#line 9650 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9662 ""
+#line 9651 ""
if (i_indx("01234", charq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 9663 ""
+#line 9652 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9663 ""
+#line 9652 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 "\
"must follow \"m\" in a grace note!", (ftnlen)128, (
ftnlen)52);
-#line 9665 ""
+#line 9654 ""
stop1_();
-#line 9666 ""
+#line 9655 ""
}
-#line 9667 ""
+#line 9656 ""
goto L9;
-#line 9668 ""
+#line 9657 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note */
-#line 9672 ""
+#line 9661 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9673 ""
+#line 9662 ""
if (i_indx("0123456789.", charq, (ftnlen)11, (ftnlen)1) > 0) {
-#line 9674 ""
+#line 9663 ""
readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 9675 ""
+#line 9664 ""
--a1ll_2.iccount;
-#line 9676 ""
+#line 9665 ""
goto L9;
-#line 9677 ""
+#line 9666 ""
} else {
-#line 9678 ""
+#line 9667 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9678 ""
+#line 9667 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll"\
"ow \"X\" in a grace note!", (ftnlen)128, (ftnlen)41);
-#line 9680 ""
+#line 9669 ""
stop1_();
-#line 9681 ""
+#line 9670 ""
}
-#line 9682 ""
+#line 9671 ""
}
/* At this point, charq is first note name in rest (grace?) */
-#line 9686 ""
+#line 9675 ""
i__1 = ngr;
-#line 9686 ""
+#line 9675 ""
for (igr = 1; igr <= i__1; ++igr) {
-#line 9687 ""
+#line 9676 ""
numnum = 0;
-#line 9688 ""
+#line 9677 ""
if (igr > 1) {
-#line 9689 ""
+#line 9678 ""
L55:
-#line 9689 ""
+#line 9678 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
1);
-#line 9690 ""
+#line 9679 ""
if (*(unsigned char *)charq == ' ') {
-#line 9690 ""
+#line 9679 ""
goto L55;
-#line 9690 ""
+#line 9679 ""
}
-#line 9691 ""
+#line 9680 ""
}
-#line 9692 ""
+#line 9681 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
-#line 9693 ""
+#line 9682 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9693 ""
+#line 9682 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected"\
" \"a\"-\"g\"!", (ftnlen)128, (ftnlen)27);
-#line 9695 ""
+#line 9684 ""
stop1_();
-#line 9696 ""
+#line 9685 ""
}
-#line 9697 ""
+#line 9686 ""
L18:
-#line 9697 ""
+#line 9686 ""
g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 9698 ""
+#line 9687 ""
if (*(unsigned char *)charq != ' ') {
-#line 9699 ""
+#line 9688 ""
if (i_indx("1234567", charq, (ftnlen)7, (ftnlen)1) > 0) {
-#line 9700 ""
+#line 9689 ""
if (numnum == 1) {
-#line 9701 ""
+#line 9690 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9701 ""
+#line 9690 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of"\
" \"+-1234567\" allowed here in grace!", (
ftnlen)128, (ftnlen)46);
-#line 9703 ""
+#line 9692 ""
stop1_();
-#line 9704 ""
+#line 9693 ""
}
-#line 9705 ""
+#line 9694 ""
numnum = 1;
-#line 9706 ""
+#line 9695 ""
goto L18;
/* else if (index('nfs',charq) .gt. 0) then */
-#line 9708 ""
+#line 9697 ""
} else if (i_indx("+-nfs", charq, (ftnlen)5, (ftnlen)1) > 0) {
-#line 9709 ""
+#line 9698 ""
goto L18;
-#line 9710 ""
+#line 9699 ""
}
/* Digits are possible octave numbers */
-#line 9714 ""
+#line 9703 ""
i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9714 ""
+#line 9703 ""
errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af"\
"ter note name in grace!", (ftnlen)128, (ftnlen)43);
-#line 9716 ""
+#line 9705 ""
stop1_();
-#line 9717 ""
+#line 9706 ""
}
-#line 9718 ""
+#line 9707 ""
/* L19: */
-#line 9718 ""
+#line 9707 ""
}
-#line 9719 ""
+#line 9708 ""
} else /* if(complicated condition) */ {
-#line 9719 ""
+#line 9708 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 9719 ""
+#line 9708 ""
if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) {
-#line 9720 ""
+#line 9709 ""
chklit_(lineq, &a1ll_2.iccount, &literr, (ftnlen)128);
-#line 9721 ""
+#line 9710 ""
if (literr > 0) {
-#line 9722 ""
+#line 9711 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9722 ""
+#line 9711 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, literq + (literr - 1) *
51, (ftnlen)128, (ftnlen)51);
-#line 9724 ""
+#line 9713 ""
stop1_();
-#line 9725 ""
+#line 9714 ""
}
-#line 9726 ""
- } else if (*(unsigned char *)charq == '"') {
+#line 9715 ""
+ } else /* if(complicated condition) */ {
+#line 9715 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 9715 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) {
/* pmx lyric */
+#line 9719 ""
+ chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128);
+#line 9720 ""
+ if (lyrerr > 0) {
+#line 9721 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9721 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr -
+ 1) * 51, (ftnlen)128, (ftnlen)51);
+#line 9723 ""
+ stop1_();
+#line 9724 ""
+ }
+#line 9725 ""
+ } else if (*(unsigned char *)charq == 'o') {
+
+/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */
+
+#line 9729 ""
+ if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
#line 9730 ""
- chkpmxlyr_(lineq, &a1ll_2.iccount, &lyrerr, (ftnlen)128);
-#line 9731 ""
- if (lyrerr > 0) {
-#line 9732 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9730 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in"\
+ " same input block, after affected note!", (ftnlen)
+ 128, (ftnlen)53);
#line 9732 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, lyrerq + (lyrerr - 1) *
- 51, (ftnlen)128, (ftnlen)51);
+ stop1_();
+#line 9733 ""
+ }
#line 9734 ""
- stop1_();
-#line 9735 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
+ 1);
+/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */
#line 9736 ""
- } else if (*(unsigned char *)charq == 'o') {
-
-/* Ornament on non-xtup note. "o" symbol must come AFTER the affected note */
-
+ if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (
+ ftnlen)1) == 0) {
+#line 9737 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9737 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!"
+ , (ftnlen)128, (ftnlen)17);
+#line 9739 ""
+ stop1_();
#line 9740 ""
- if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
-#line 9741 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 9741 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam"\
- "e input block, after affected note!", (ftnlen)128, (
- ftnlen)53);
+ if (*(unsigned char *)dumq == ':') {
+#line 9742 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9743 ""
- stop1_();
+ if (*(unsigned char *)dumq != ' ') {
#line 9744 ""
- }
-#line 9745 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
-/* if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then */
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9744 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\
+ "nk after \"o:\"!", (ftnlen)128, (ftnlen)26);
+#line 9746 ""
+ stop1_();
#line 9747 ""
- if (i_indx("(stmgx+Tupf._)e:>^bcCG", dumq, (ftnlen)22, (ftnlen)1)
- == 0) {
+ } else if (! comkeys_1.ornrpt) {
#line 9748 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = a1ll_2.iccount - 1;
+#line 9748 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 9748 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal ornament!", (
- ftnlen)128, (ftnlen)17);
+ errmsg_(lineq, &i__1, &i__4, "Turned off repeated or"\
+ "naments before they were on!", (ftnlen)128, (
+ ftnlen)50);
#line 9750 ""
- stop1_();
+ stop1_();
#line 9751 ""
- }
+ }
#line 9752 ""
- if (*(unsigned char *)dumq == ':') {
+ comkeys_1.ornrpt = FALSE_;
#line 9753 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ } else if (*(unsigned char *)dumq == 'g') {
#line 9754 ""
- if (*(unsigned char *)dumq != ' ') {
+ if (c1omget_1.issegno) {
#line 9755 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 9755 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a"\
- "fter \"o:\"!", (ftnlen)128, (ftnlen)26);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only "\
+ "one \"segno\" per input block!", (ftnlen)128,
+ (ftnlen)40);
#line 9757 ""
- stop1_();
+ stop1_();
#line 9758 ""
- } else if (! comkeys_1.ornrpt) {
-#line 9759 ""
- i__1 = a1ll_2.iccount - 1;
+ } else if (c1ommvl_1.ivx != 1) {
#line 9759 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 9759 ""
- errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname"\
- "nts before they were on!", (ftnlen)128, (ftnlen)
- 50);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can on"\
+ "ly be in voice 1!", (ftnlen)128, (ftnlen)29);
#line 9761 ""
- stop1_();
+ stop1_();
#line 9762 ""
- }
+ }
#line 9763 ""
- comkeys_1.ornrpt = FALSE_;
+ c1omget_1.issegno = TRUE_;
#line 9764 ""
- } else if (*(unsigned char *)dumq == 'g') {
+L12:
+#line 9764 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9765 ""
- if (c1omget_1.issegno) {
-#line 9766 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9766 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one"\
- " \"segno\" per input block!", (ftnlen)128, (
- ftnlen)40);
+ if (*(unsigned char *)dumq == '-' || *(unsigned char *)
+ dumq >= 48 && *(unsigned char *)dumq <= 58) {
+#line 9765 ""
+ goto L12;
+#line 9765 ""
+ }
+#line 9767 ""
+ if (*(unsigned char *)dumq != ' ') {
#line 9768 ""
- stop1_();
-#line 9769 ""
- } else if (c1ommvl_1.ivx != 1) {
-#line 9770 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9768 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter in segno ornament symbol!", (ftnlen)128,
+ (ftnlen)43);
#line 9770 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b"\
- "e in voice 1!", (ftnlen)128, (ftnlen)29);
+ stop1_();
+#line 9771 ""
+ }
#line 9772 ""
- stop1_();
-#line 9773 ""
- }
-#line 9774 ""
- c1omget_1.issegno = TRUE_;
-#line 9775 ""
-L12:
-#line 9775 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
-#line 9776 ""
- if (*(unsigned char *)dumq == '-' || *(unsigned char *)dumq >=
- 48 && *(unsigned char *)dumq <= 58) {
+ } else if (*(unsigned char *)dumq == 'T') {
+
+/* Trill. may be followed by 't' and/or number. read 'til blank */
+
#line 9776 ""
- goto L12;
+L22:
#line 9776 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
+#line 9777 ""
+ if (*(unsigned char *)dumq == ':') {
#line 9778 ""
- if (*(unsigned char *)dumq != ' ') {
+ i__1 = a1ll_2.iccount;
+#line 9778 ""
+ if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 -
+ i__1, (ftnlen)1) != 0) {
#line 9779 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 9779 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r in segno ornament symbol!", (ftnlen)128, (
- ftnlen)43);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected"\
+ " blank after \":\"!", (ftnlen)128, (
+ ftnlen)25);
#line 9781 ""
- stop1_();
+ stop1_();
#line 9782 ""
- }
+ }
#line 9783 ""
- } else if (*(unsigned char *)dumq == 'T') {
-
-/* Trill. may be followed by 't' and/or number. read 'til blank */
-
-#line 9787 ""
-L22:
+ goto L32;
+#line 9784 ""
+ } else if (*(unsigned char *)dumq != ' ') {
+#line 9785 ""
+ goto L22;
+#line 9786 ""
+ }
#line 9787 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ } else if (*(unsigned char *)dumq == 'f') {
#line 9788 ""
- if (*(unsigned char *)dumq == ':') {
-#line 9789 ""
- i__1 = a1ll_2.iccount;
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9789 ""
- if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) != 0) {
+ if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) {
#line 9790 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
#line 9790 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla"\
- "nk after \":\"!", (ftnlen)128, (ftnlen)25);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter after \"f\" in fermata ornament symbol!"
+ , (ftnlen)128, (ftnlen)55);
#line 9792 ""
stop1_();
#line 9793 ""
}
#line 9794 ""
- goto L32;
+ if (*(unsigned char *)dumq == 'd') {
+#line 9794 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
+#line 9794 ""
+ }
+#line 9795 ""
+ if (*(unsigned char *)dumq == ':') {
+#line 9795 ""
+ goto L32;
#line 9795 ""
- } else if (*(unsigned char *)dumq != ' ') {
+ }
#line 9796 ""
- goto L22;
+ } else if (*(unsigned char *)dumq == 'e') {
#line 9797 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9798 ""
- } else if (*(unsigned char *)dumq == 'f') {
+ if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
#line 9799 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
-#line 9800 ""
- if (i_indx(" d+-:", dumq, (ftnlen)5, (ftnlen)1) == 0) {
-#line 9801 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9799 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter after \"e\" in edit. accid. symbol!", (
+ ftnlen)128, (ftnlen)51);
#line 9801 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r after \"f\" in fermata ornament symbol!", (
- ftnlen)128, (ftnlen)55);
+ stop1_();
+#line 9802 ""
+ }
#line 9803 ""
- stop1_();
-#line 9804 ""
- }
-#line 9805 ""
- if (*(unsigned char *)dumq == 'd') {
-#line 9805 ""
g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
ftnlen)1);
+#line 9804 ""
+ if (*(unsigned char *)dumq == '?') {
+#line 9804 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
+#line 9804 ""
+ }
#line 9805 ""
- }
-#line 9806 ""
- if (*(unsigned char *)dumq == ':') {
-#line 9806 ""
- goto L32;
+ } else {
#line 9806 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9807 ""
- } else if (*(unsigned char *)dumq == 'e') {
+ }
#line 9808 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
#line 9809 ""
- if (i_indx("sfn?", dumq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 9810 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9810 ""
+#line 9809 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r after \"e\" in edit. accid. symbol!", (ftnlen)
- 128, (ftnlen)51);
-#line 9812 ""
+ "r in ornament symbol!", (ftnlen)128, (ftnlen)37);
+#line 9811 ""
stop1_();
-#line 9813 ""
+#line 9812 ""
}
+#line 9813 ""
+ if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
#line 9814 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ i__1 = a1ll_2.iccount;
+#line 9814 ""
+ if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
+ a1ll_2.iccount + 1 - i__1) == 0) {
#line 9815 ""
- if (*(unsigned char *)dumq == '?') {
+ i__1 = a1ll_2.iccount + 1;
#line 9815 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
- ftnlen)1);
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 9815 ""
- }
-#line 9816 ""
- } else {
+ errmsg_(lineq, &i__1, &i__4, "There should be an int"\
+ "eger here!", (ftnlen)128, (ftnlen)32);
#line 9817 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ stop1_();
#line 9818 ""
- }
+ }
#line 9819 ""
- if (i_indx("+- :", dumq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 9820 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 9820 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
- " ornament symbol!", (ftnlen)128, (ftnlen)37);
-#line 9822 ""
- stop1_();
+ if (*(unsigned char *)durq == ':') {
+#line 9821 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9821 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift"\
+ " AND repeat an ornament!", (ftnlen)128, (
+ ftnlen)36);
#line 9823 ""
- }
+ stop1_();
#line 9824 ""
- if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 9825 ""
- i__1 = a1ll_2.iccount;
-#line 9825 ""
- if (i_indx("0123456789", lineq + i__1, (ftnlen)10,
- a1ll_2.iccount + 1 - i__1) == 0) {
-#line 9826 ""
- i__1 = a1ll_2.iccount + 1;
-#line 9826 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9826 ""
- errmsg_(lineq, &i__1, &i__4, "There should be an integer"\
- " here!", (ftnlen)128, (ftnlen)32);
+ }
+
+/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */
+
#line 9828 ""
- stop1_();
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
#line 9829 ""
- }
-#line 9830 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ i__1 = a1ll_2.iccount;
+#line 9829 ""
+ if (i_indx(".0123456789", lineq + i__1, (ftnlen)11,
+ a1ll_2.iccount + 1 - i__1) == 0) {
#line 9831 ""
- if (*(unsigned char *)durq == ':') {
-#line 9832 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9832 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND"\
- " repeat an ornament!", (ftnlen)128, (ftnlen)36);
+ i__1 = a1ll_2.iccount + 1;
+#line 9831 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9831 ""
+ errmsg_(lineq, &i__1, &i__4, "There should be a "\
+ "number here!", (ftnlen)128, (ftnlen)30);
+#line 9833 ""
+ stop1_();
#line 9834 ""
- stop1_();
+ }
#line 9835 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
+ 128, (ftnlen)1);
+#line 9836 ""
+ }
+#line 9837 ""
}
-
-/* 12/7/03 Allow horizontal shift on any ornament, not just breath and caes. */
-
+#line 9838 ""
+L32:
#line 9839 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+ if (*(unsigned char *)dumq == ':') {
#line 9840 ""
i__1 = a1ll_2.iccount;
#line 9840 ""
- if (i_indx(".0123456789", lineq + i__1, (ftnlen)11,
- a1ll_2.iccount + 1 - i__1) == 0) {
-#line 9842 ""
- i__1 = a1ll_2.iccount + 1;
-#line 9842 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
+ ftnlen)1) != 0) {
+#line 9841 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9842 ""
- errmsg_(lineq, &i__1, &i__4, "There should be a numb"\
- "er here!", (ftnlen)128, (ftnlen)30);
-#line 9844 ""
+#line 9841 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must b"\
+ "e followed by blank in \"o: \"!", (ftnlen)128,
+ (ftnlen)39);
+#line 9843 ""
stop1_();
+#line 9844 ""
+ } else if (comkeys_1.ornrpt) {
#line 9845 ""
- }
-#line 9846 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
- (ftnlen)1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9845 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on re"\
+ "peated ornaments but already on!", (ftnlen)
+ 128, (ftnlen)44);
#line 9847 ""
- }
+ stop1_();
#line 9848 ""
- }
+ }
#line 9849 ""
-L32:
+ comkeys_1.ornrpt = TRUE_;
#line 9850 ""
- if (*(unsigned char *)dumq == ':') {
-#line 9851 ""
- i__1 = a1ll_2.iccount;
+ }
#line 9851 ""
- if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) != 0) {
-#line 9852 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
#line 9852 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo"\
- "llowed by blank in \"o: \"!", (ftnlen)128, (
- ftnlen)39);
+ numint = 0;
+#line 9853 ""
+ iposn = 0;
#line 9854 ""
- stop1_();
+L8:
+#line 9854 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
+ 1);
#line 9855 ""
- } else if (comkeys_1.ornrpt) {
+ ++iposn;
#line 9856 ""
+ if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq
+ == 't') {
+#line 9857 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9856 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat"\
- "ed ornaments but already on!", (ftnlen)128, (
- ftnlen)44);
-#line 9858 ""
- stop1_();
+#line 9857 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\""\
+ " as an option on a tie!", (ftnlen)128, (ftnlen)37)
+ ;
#line 9859 ""
- }
+ stop1_();
#line 9860 ""
- comkeys_1.ornrpt = TRUE_;
+ }
#line 9861 ""
- }
-#line 9862 ""
- } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
-#line 9863 ""
- numint = 0;
-#line 9864 ""
- iposn = 0;
-#line 9865 ""
-L8:
+ if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) ==
+ 0) {
+
+/* Check for explicit ID code. */
+
#line 9865 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
+ ic = *(unsigned char *)dumq;
#line 9866 ""
- ++iposn;
-#line 9867 ""
- if (*(unsigned char *)charq == 't' && *(unsigned char *)dumq ==
- 't') {
-#line 9868 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9868 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as "\
- "an option on a tie!", (ftnlen)128, (ftnlen)37);
-#line 9870 ""
- stop1_();
+ if (ic < 48 || ic > 57 && ic < 65 || ic > 90) {
+
+/* Not 0-9 or A-Z, so exit */
+
#line 9871 ""
- }
-#line 9872 ""
- if (i_indx("udltb+-fnhHpsv ", dumq, (ftnlen)15, (ftnlen)1) == 0) {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9871 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter in slur symbol!", (ftnlen)128, (ftnlen)
+ 33);
+#line 9873 ""
+ stop1_();
+#line 9874 ""
+ } else {
-/* Check for explicit ID code. */
+/* It is a possible ID code. Right place? */
-#line 9876 ""
- ic = *(unsigned char *)dumq;
-#line 9877 ""
- if (ic < 48 || ic > 57 && ic < 65 || ic > 90) {
+#line 9878 ""
+ if (iposn != 1) {
-/* Not 0-9 or A-Z, so exit */
+/* Slur ID is not 2nd! */
#line 9882 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 9882 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r in slur symbol!", (ftnlen)128, (ftnlen)33);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID "\
+ "must be second character in slur symbol!",
+ (ftnlen)128, (ftnlen)48);
#line 9884 ""
- stop1_();
+ stop1_();
#line 9885 ""
- } else {
-
-/* It is a possible ID code. Right place? */
-
+ } else if (*(unsigned char *)charq == 't' &&
+ comslur_1.fontslur) {
+#line 9886 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9886 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID "\
+ "not allowed on non-postscript tie!", (
+ ftnlen)128, (ftnlen)42);
+#line 9888 ""
+ stop1_();
+#line 9889 ""
+ } else /* if(complicated condition) */ {
#line 9889 ""
- if (iposn != 1) {
+ i__1 = a1ll_2.iccount;
+#line 9889 ""
+ if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 -
+ i__1, (ftnlen)1) == 0) {
+#line 9890 ""
+ ++a1ll_2.iccount;
+#line 9891 ""
+ }
+#line 9891 ""
+ }
+#line 9892 ""
+ }
-/* Slur ID is not 2nd! */
+/* Slur ID is OK. Note it cannot be "H" at this point.. */
-#line 9893 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9893 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must"\
- " be second character in slur symbol!", (
- ftnlen)128, (ftnlen)48);
-#line 9895 ""
- stop1_();
#line 9896 ""
- } else if (*(unsigned char *)charq == 't' &&
- comslur_1.fontslur) {
+ goto L8;
#line 9897 ""
+ } else if (*(unsigned char *)dumq == 'H') {
+#line 9898 ""
+ if (iposn == 1) {
+#line 9898 ""
+ goto L8;
+#line 9898 ""
+ }
+
+/* "H" is NOT an ID code. */
+
+#line 9902 ""
+ if (! comslur_1.fontslur && *(unsigned char *)charq ==
+ 't') {
+#line 9903 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9897 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not "\
- "allowed on non-postscript tie!", (ftnlen)128,
- (ftnlen)42);
-#line 9899 ""
+#line 9903 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot resha"\
+ "pe postscript ties this way!", (ftnlen)128, (
+ ftnlen)40);
+#line 9905 ""
stop1_();
-#line 9900 ""
- } else /* if(complicated condition) */ {
-#line 9900 ""
- i__1 = a1ll_2.iccount;
-#line 9900 ""
- if (s_cmp(lineq + i__1, "x", a1ll_2.iccount + 1 -
- i__1, (ftnlen)1) == 0) {
-#line 9901 ""
- ++a1ll_2.iccount;
-#line 9902 ""
- }
-#line 9902 ""
+#line 9906 ""
}
-#line 9903 ""
- }
-
-/* Slur ID is OK. Note it cannot be "H" at this point.. */
-
#line 9907 ""
- goto L8;
+ i__1 = a1ll_2.iccount;
+#line 9907 ""
+ if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
+ ftnlen)1) == 0) {
#line 9908 ""
- } else if (*(unsigned char *)dumq == 'H') {
-#line 9909 ""
- if (iposn == 1) {
+ ++a1ll_2.iccount;
#line 9909 ""
+ ++iposn;
+#line 9910 ""
+ }
+#line 9911 ""
goto L8;
-#line 9909 ""
- }
+#line 9912 ""
+ } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && !
+ comslur_1.fontslur && *(unsigned char *)charq == 't')
+ {
-/* "H" is NOT an ID code. */
+/* 3/9/03 Can't reshape postscript tie. */
-#line 9913 ""
- if (! comslur_1.fontslur && *(unsigned char *)charq == 't') {
-#line 9914 ""
+#line 9917 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 9914 ""
+#line 9917 ""
errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p"\
"ostscript ties this way!", (ftnlen)128, (ftnlen)
40);
-#line 9916 ""
- stop1_();
-#line 9917 ""
- }
-#line 9918 ""
- i__1 = a1ll_2.iccount;
-#line 9918 ""
- if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) == 0) {
#line 9919 ""
- ++a1ll_2.iccount;
+ stop1_();
#line 9920 ""
- ++iposn;
-#line 9921 ""
- }
-#line 9922 ""
- goto L8;
-#line 9923 ""
- } else if (i_indx("fh", dumq, (ftnlen)2, (ftnlen)1) > 0 && !
- comslur_1.fontslur && *(unsigned char *)charq == 't') {
+ } else if (*(unsigned char *)dumq == 'p') {
-/* 3/9/03 Can't reshape postscript tie. */
+/* local change in postscript slur/tie adjustment default */
+#line 9924 ""
+ if (comslur_1.fontslur) {
+#line 9925 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9925 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use pos"\
+ "tscript slurs (\"Ap\") to use this option!", (
+ ftnlen)128, (ftnlen)52);
+#line 9927 ""
+ stop1_();
#line 9928 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9928 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts"\
- "cript ties this way!", (ftnlen)128, (ftnlen)40);
+ }
+#line 9929 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9930 ""
- stop1_();
+ if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
#line 9931 ""
- } else if (*(unsigned char *)dumq == 'p') {
-
-/* local change in postscript slur/tie adjustment default */
-
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9931 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \""\
+ "+\" or \"-\" here!", (ftnlen)128, (ftnlen)25);
+#line 9933 ""
+ stop1_();
+#line 9934 ""
+ }
#line 9935 ""
- if (comslur_1.fontslur) {
-#line 9936 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 9936 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr"\
- "ipt slurs (\"Ap\") to use this option!", (ftnlen)
- 128, (ftnlen)52);
-#line 9938 ""
- stop1_();
+ if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 9937 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9937 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \""\
+ "s\" or \"t\" here!", (ftnlen)128, (ftnlen)25);
#line 9939 ""
- }
+ stop1_();
#line 9940 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ }
#line 9941 ""
- if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 9942 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ iposn += 2;
#line 9942 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o"\
- "r \"-\" here!", (ftnlen)128, (ftnlen)25);
+ goto L8;
+#line 9943 ""
+ }
#line 9944 ""
- stop1_();
+ if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) {
#line 9945 ""
- }
+ goto L8;
#line 9946 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
#line 9947 ""
- if (i_indx("st", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+ ++numint;
#line 9948 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9948 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o"\
- "r \"t\" here!", (ftnlen)128, (ftnlen)25);
-#line 9950 ""
- stop1_();
+ if (comslur_1.fontslur && *(unsigned char *)charq == 't')
+ {
+#line 9949 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9949 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for "\
+ "slur height only allowed in \"s\"-slurs!", (
+ ftnlen)128, (ftnlen)48);
#line 9951 ""
- }
+ stop1_();
#line 9952 ""
- iposn += 2;
+ }
#line 9953 ""
- goto L8;
+ ++a1ll_2.iccount;
#line 9954 ""
- }
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 9955 ""
- if (i_indx("udltbfnh", dumq, (ftnlen)8, (ftnlen)1) > 0) {
+ if (numint == 1) {
#line 9956 ""
- goto L8;
+ if (i_nint(&fnum) > 30) {
+#line 9957 ""
+ i__1 = a1ll_2.iccount - 1;
+#line 9957 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 9957 ""
- } else if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 9958 ""
- ++numint;
+ errmsg_(lineq, &i__1, &i__4, "Magnitude of slur "\
+ "height adjustment cannot exceed 30!", (
+ ftnlen)128, (ftnlen)53);
#line 9959 ""
- if (comslur_1.fontslur && *(unsigned char *)charq == 't') {
-#line 9960 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 9960 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur"\
- " height only allowed in \"s\"-slurs!", (ftnlen)
- 128, (ftnlen)48);
+ }
+#line 9961 ""
+ } else if (numint == 2) {
#line 9962 ""
- stop1_();
+ if (dabs(fnum) > 6.3f) {
#line 9963 ""
- }
-#line 9964 ""
- ++a1ll_2.iccount;
+ i__1 = a1ll_2.iccount - 1;
+#line 9963 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9963 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur horiz shift m"\
+ "ust be in range (-6.3,6.3)!", (ftnlen)128,
+ (ftnlen)45);
#line 9965 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ stop1_();
#line 9966 ""
- if (numint == 1) {
+ }
#line 9967 ""
- if (i_nint(&fnum) > 30) {
-#line 9968 ""
- i__1 = a1ll_2.iccount - 1;
-#line 9968 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9968 ""
- errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\
- "ht adjustment cannot exceed 30!", (ftnlen)128,
- (ftnlen)53);
-#line 9970 ""
- stop1_();
+ } else {
+
+/* Third signed integer, must be a midslur or curve spec. */
+
#line 9971 ""
- }
+ if (dabs(fnum) > 31.f) {
#line 9972 ""
- } else if (numint == 2) {
-#line 9973 ""
- if (dabs(fnum) > 6.3f) {
-#line 9974 ""
- i__1 = a1ll_2.iccount - 1;
-#line 9974 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = a1ll_2.iccount - 1;
+#line 9972 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 9972 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur midheight mus"\
+ "t be in the range (-31,31)!", (ftnlen)128,
+ (ftnlen)45);
#line 9974 ""
- errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\
- "be in range (-6.3,6.3)!", (ftnlen)128, (
- ftnlen)45);
+ stop1_();
+#line 9975 ""
+ }
#line 9976 ""
- stop1_();
-#line 9977 ""
- }
-#line 9978 ""
- } else {
+ if (*(unsigned char *)durq == ':') {
-/* Third signed integer, must be a midslur or curve spec. */
+/* Expecting curve parameters. Get two numbers */
+#line 9980 ""
+ for (i__ = 1; i__ <= 2; ++i__) {
+#line 9981 ""
+ ++a1ll_2.iccount;
#line 9982 ""
- if (dabs(fnum) > 31.f) {
+ fnum = (real) (*(unsigned char *)&lineq[
+ a1ll_2.iccount - 1] - 48);
#line 9983 ""
- i__1 = a1ll_2.iccount - 1;
-#line 9983 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 9983 ""
- errmsg_(lineq, &i__1, &i__4, "Slur midheight must be"\
- " in the range (-31,31)!", (ftnlen)128, (
- ftnlen)45);
-#line 9985 ""
- stop1_();
+ if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) {
+#line 9984 ""
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 9984 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1,
+ "Slur curve parameter must be in"\
+ " range (0,7)!", (ftnlen)128, (
+ ftnlen)44);
#line 9986 ""
- }
+ stop1_();
#line 9987 ""
- if (*(unsigned char *)durq == ':') {
-
-/* Expecting curve parameters. Get two numbers */
-
+ }
+#line 9988 ""
+/* L41: */
+#line 9988 ""
+ }
+#line 9989 ""
+ ++a1ll_2.iccount;
+#line 9990 ""
+ }
#line 9991 ""
- for (i__ = 1; i__ <= 2; ++i__) {
+ }
#line 9992 ""
- ++a1ll_2.iccount;
+ --a1ll_2.iccount;
#line 9993 ""
- fnum = (real) (*(unsigned char *)&lineq[
- a1ll_2.iccount - 1] - 48);
+ goto L8;
#line 9994 ""
- if ((r__1 = fnum - 3.5f, dabs(r__1)) > 3.6f) {
-#line 9995 ""
- i__1 = c1omnotes_1.ibarcnt -
- c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
-#line 9995 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur"\
- " curve parameter must be in range (0"\
- ",7)!", (ftnlen)128, (ftnlen)44);
-#line 9997 ""
- stop1_();
-#line 9998 ""
- }
-#line 9999 ""
-/* L41: */
+ } else if (*(unsigned char *)dumq == 's') {
+
+/* What follows should be one or two signed numbers for adjustment of line break */
+/* slur, end of 1st segment or start of second. */
+
#line 9999 ""
- }
+ if (comslur_1.fontslur) {
#line 10000 ""
- ++a1ll_2.iccount;
-#line 10001 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10000 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use "\
+ "linebreak slur options with font-based slurs!"
+ , (ftnlen)128, (ftnlen)57);
#line 10002 ""
- }
+ stop1_();
#line 10003 ""
- --a1ll_2.iccount;
+ }
#line 10004 ""
- goto L8;
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
+ ftnlen)1);
#line 10005 ""
- } else if (*(unsigned char *)dumq == 's') {
-
-/* What follows should be one or two signed numbers for adjustment of line break */
-/* slur, end of 1st segment or start of second. */
-
+ if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
+#line 10006 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10006 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact"\
+ "er must be \"+\" or \"-\"!", (ftnlen)128, (
+ ftnlen)34);
+#line 10008 ""
+ stop1_();
+#line 10009 ""
+ }
#line 10010 ""
- if (comslur_1.fontslur) {
-#line 10011 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ ++a1ll_2.iccount;
#line 10011 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line"\
- "break slur options with font-based slurs!", (
- ftnlen)128, (ftnlen)57);
+ readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128,
+ (ftnlen)1);
+#line 10012 ""
+ if (i_nint(&fnum) > 30) {
#line 10013 ""
- stop1_();
-#line 10014 ""
- }
+ i__1 = a1ll_2.iccount - 1;
+#line 10013 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10013 ""
+ errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig"\
+ "ht adjustment cannot exceed 30!", (ftnlen)128,
+ (ftnlen)53);
#line 10015 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
- 1);
+ stop1_();
#line 10016 ""
- if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 10017 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10017 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m"\
- "ust be \"+\" or \"-\"!", (ftnlen)128, (ftnlen)34);
+ if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 10018 ""
+ ++a1ll_2.iccount;
#line 10019 ""
- stop1_();
+ readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)
+ 128, (ftnlen)1);
#line 10020 ""
- }
+ if (dabs(fnum) > 6.3f) {
#line 10021 ""
- ++a1ll_2.iccount;
-#line 10022 ""
- readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ i__1 = a1ll_2.iccount - 1;
+#line 10021 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10021 ""
+ errmsg_(lineq, &i__1, &i__4, "Slur horiz shift m"\
+ "ust be in range (-6.3,6.3)!", (ftnlen)128,
+ (ftnlen)45);
#line 10023 ""
- if (i_nint(&fnum) > 30) {
-#line 10024 ""
- i__1 = a1ll_2.iccount - 1;
-#line 10024 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10024 ""
- errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a"\
- "djustment cannot exceed 30!", (ftnlen)128, (
- ftnlen)53);
+ }
+#line 10025 ""
+ }
#line 10026 ""
- stop1_();
+ --a1ll_2.iccount;
#line 10027 ""
- }
+ goto L8;
#line 10028 ""
- if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
+ } else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
#line 10029 ""
- ++a1ll_2.iccount;
+ i__1 = a1ll_2.iccount;
+#line 10029 ""
+ if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
+ ftnlen)1) == 0) {
+#line 10029 ""
+ ++a1ll_2.iccount;
+#line 10029 ""
+ }
#line 10030 ""
- readnum_(lineq, &a1ll_2.iccount, dumq, &fnum, (ftnlen)128,
- (ftnlen)1);
+ goto L8;
#line 10031 ""
- if (dabs(fnum) > 6.3f) {
-#line 10032 ""
- i__1 = a1ll_2.iccount - 1;
-#line 10032 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10032 ""
- errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must "\
- "be in range (-6.3,6.3)!", (ftnlen)128, (
- ftnlen)45);
+ } else if (*(unsigned char *)charq == '?') {
+#line 10033 ""
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
#line 10034 ""
- stop1_();
+ if (*(unsigned char *)durq == ' ') {
#line 10035 ""
- }
+ --a1ll_2.iccount;
#line 10036 ""
- }
+ } else {
#line 10037 ""
- --a1ll_2.iccount;
+ if (*(unsigned char *)durq != '-') {
#line 10038 ""
- goto L8;
-#line 10039 ""
- } else if (*(unsigned char *)dumq == 'H' && iposn > 1) {
-#line 10040 ""
- i__1 = a1ll_2.iccount;
-#line 10040 ""
- if (s_cmp(lineq + i__1, "H", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) == 0) {
-#line 10040 ""
- ++a1ll_2.iccount;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10038 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting"\
+ " \"-\"!", (ftnlen)128, (ftnlen)14);
#line 10040 ""
- }
+ stop1_();
#line 10041 ""
- goto L8;
+ }
#line 10042 ""
- }
+ getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10043 ""
- } else if (*(unsigned char *)charq == '?') {
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
+ 0) {
#line 10044 ""
- getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 10045 ""
- if (*(unsigned char *)durq == ' ') {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10044 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting nu"\
+ "mber!", (ftnlen)128, (ftnlen)17);
#line 10046 ""
- --a1ll_2.iccount;
+ stop1_();
#line 10047 ""
- } else {
+ }
#line 10048 ""
- if (*(unsigned char *)durq != '-') {
-#line 10049 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 10049 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting \"-\"!",
- (ftnlen)128, (ftnlen)14);
-#line 10051 ""
- stop1_();
-#line 10052 ""
- }
-#line 10053 ""
- getchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1)
- ;
-#line 10054 ""
- if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 10055 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10055 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expecting number!"
- , (ftnlen)128, (ftnlen)17);
-#line 10057 ""
- stop1_();
-#line 10058 ""
+ --a1ll_2.iccount;
+#line 10050 ""
}
-#line 10059 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 10060 ""
- --a1ll_2.iccount;
-#line 10061 ""
- }
-#line 10062 ""
- } else if (*(unsigned char *)charq >= 48 && *(unsigned char *)charq <=
- 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen)1) > 0) {
+#line 10051 ""
+ } else if (*(unsigned char *)charq >= 48 && *(unsigned char *)
+ charq <= 57 || i_indx("#-nx_", charq, (ftnlen)5, (ftnlen)
+ 1) > 0) {
/* We have a figure. Must come AFTER the note it goes under */
-#line 10067 ""
- if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (! a1ll_2.firstline
- || a1ll_2.lenbr0 == 0 || a1ll_2.lenbar == a1ll_2.lenbr0))
- {
+#line 10056 ""
+ if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] == 0 && (!
+ a1ll_2.firstline || a1ll_2.lenbr0 == 0 ||
+ a1ll_2.lenbar == a1ll_2.lenbr0)) {
/* Figure before first note in block */
+#line 10061 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10061 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figur"\
+ "e before first note in block!", (ftnlen)128, (
+ ftnlen)45);
+#line 10063 ""
+ stop1_();
+#line 10064 ""
+ }
+#line 10065 ""
+ if (*(unsigned char *)charq == 'x') {
+#line 10066 ""
+ indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - (
+ a1ll_2.iccount - 1), (ftnlen)1);
+#line 10067 ""
+ if (indxb < 5) {
+#line 10068 ""
+ i__1 = a1ll_2.iccount + indxb - 1;
+#line 10068 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10068 ""
+ errmsg_(lineq, &i__1, &i__4, "Cannot have a blank he"\
+ "re in floating figure!", (ftnlen)128, (ftnlen)
+ 44);
+#line 10070 ""
+ stop1_();
+#line 10071 ""
+ }
#line 10072 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10072 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be"\
- "fore first note in block!", (ftnlen)128, (ftnlen)45);
+ }
+#line 10073 ""
+ if (compage_1.usefig) {
+#line 10073 ""
+ *ifig = 1;
+#line 10073 ""
+ }
#line 10074 ""
- stop1_();
+L5:
+#line 10074 ""
+ g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
+ 1);
#line 10075 ""
- }
+ if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (
+ ftnlen)1) == 0) {
#line 10076 ""
- if (*(unsigned char *)charq == 'x') {
-#line 10077 ""
- indxb = i_indx(lineq + (a1ll_2.iccount - 1), " ", 128 - (
- a1ll_2.iccount - 1), (ftnlen)1);
-#line 10078 ""
- if (indxb < 5) {
-#line 10079 ""
- i__1 = a1ll_2.iccount + indxb - 1;
-#line 10079 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10079 ""
- errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i"\
- "n floating figure!", (ftnlen)128, (ftnlen)44);
-#line 10081 ""
+#line 10076 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
+ "r in figure!", (ftnlen)128, (ftnlen)28);
+#line 10078 ""
stop1_();
-#line 10082 ""
- }
+#line 10079 ""
+ } else if (*(unsigned char *)charq == '+') {
+
+/* vertical offset, must be integer, then blank */
+
#line 10083 ""
- }
-#line 10084 ""
- if (compage_1.usefig) {
-#line 10084 ""
- *ifig = 1;
+ g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (
+ ftnlen)1);
#line 10084 ""
- }
+ if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0)
+ {
#line 10085 ""
-L5:
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10085 ""
- g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 10086 ""
- if (i_indx(" 0123456789#-nx_.:+sv", charq, (ftnlen)21, (ftnlen)1)
- == 0) {
-#line 10087 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for "\
+ "vertical offset expected here!", (ftnlen)128,
+ (ftnlen)42);
#line 10087 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
- " figure!", (ftnlen)128, (ftnlen)28);
+ stop1_();
+#line 10088 ""
+ }
#line 10089 ""
- stop1_();
+ readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)
+ 128, (ftnlen)1);
#line 10090 ""
- } else if (*(unsigned char *)charq == '+') {
-
-/* vertical offset, must be integer, then blank */
-
+ if (*(unsigned char *)charq != ' ') {
+#line 10091 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10091 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical off"\
+ "set must terminate figure!", (ftnlen)128, (
+ ftnlen)38);
+#line 10093 ""
+ stop1_();
#line 10094 ""
- g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
- 1);
+ }
#line 10095 ""
- if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 10096 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ --a1ll_2.iccount;
#line 10096 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert"\
- "ical offset expected here!", (ftnlen)128, (ftnlen)
- 42);
+ goto L5;
+#line 10097 ""
+ } else if (*(unsigned char *)charq == 's') {
#line 10098 ""
- stop1_();
+ comligfont_1.isligfont = TRUE_;
#line 10099 ""
}
#line 10100 ""
- readnum_(lineq, &a1ll_2.iccount, charq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 10101 ""
if (*(unsigned char *)charq != ' ') {
+#line 10100 ""
+ goto L5;
+#line 10100 ""
+ }
+#line 10101 ""
+ } else if (*(unsigned char *)charq == '[') {
#line 10102 ""
+ if (c1omget_1.fbon) {
+#line 10103 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10102 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset "\
- "must terminate figure!", (ftnlen)128, (ftnlen)38);
-#line 10104 ""
- stop1_();
+#line 10103 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced b"\
+ "eam while another was open!", (ftnlen)128, (
+ ftnlen)43);
#line 10105 ""
- }
+ stop1_();
#line 10106 ""
- --a1ll_2.iccount;
+ }
#line 10107 ""
- goto L5;
+ c1omget_1.fbon = TRUE_;
+#line 10108 ""
+L17:
#line 10108 ""
- } else if (*(unsigned char *)charq == 's') {
+ g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
+ 1);
#line 10109 ""
- comligfont_1.isligfont = TRUE_;
+ if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) {
#line 10110 ""
- }
-#line 10111 ""
- if (*(unsigned char *)charq != ' ') {
-#line 10111 ""
- goto L5;
+ goto L17;
#line 10111 ""
- }
+ } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
#line 10112 ""
- } else if (*(unsigned char *)charq == '[') {
+ ++a1ll_2.iccount;
#line 10113 ""
- if (c1omget_1.fbon) {
-#line 10114 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 10114 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam "\
- "while another was open!", (ftnlen)128, (ftnlen)43);
+ --a1ll_2.iccount;
+#line 10115 ""
+ goto L17;
#line 10116 ""
- stop1_();
-#line 10117 ""
- }
-#line 10118 ""
- c1omget_1.fbon = TRUE_;
-#line 10119 ""
-L17:
-#line 10119 ""
- g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
+ } else if (*(unsigned char *)charq == 'm') {
+
+/* Forced multiplicity, next char should be 1-4 */
+
#line 10120 ""
- if (i_indx("uljhf:", charq, (ftnlen)6, (ftnlen)1) > 0) {
+ g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (
+ ftnlen)1);
#line 10121 ""
- goto L17;
+ if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) {
#line 10122 ""
- } else if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 10123 ""
- ++a1ll_2.iccount;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10122 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multi"\
+ "plicity for a beam must be 1, 2, 3, or 4!", (
+ ftnlen)128, (ftnlen)53);
#line 10124 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ stop1_();
#line 10125 ""
- --a1ll_2.iccount;
+ }
#line 10126 ""
- goto L17;
+ goto L17;
#line 10127 ""
- } else if (*(unsigned char *)charq == 'm') {
-
-/* Forced multiplicity, next char should be 1-4 */
-
+ } else if (*(unsigned char *)charq != ' ') {
+#line 10128 ""
+ if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) >
+ 0) {
+#line 10129 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10129 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\","\
+ " digits must now be preceeded by \"+\" or \"-"\
+ "\"!", (ftnlen)128, (ftnlen)54);
#line 10131 ""
- g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
- 1);
+ s_wsle(&io___662);
+#line 10131 ""
+ do_lio(&c__9, &c__1, "You will have to edit older so"\
+ "urces to meet this rqmt,", (ftnlen)54);
+#line 10131 ""
+ e_wsle();
+#line 10132 ""
+ s_wsle(&io___663);
+#line 10132 ""
+ do_lio(&c__9, &c__1, "but it was needed to allow 2-d"\
+ "igit height adjustments.", (ftnlen)54);
#line 10132 ""
- if (i_indx("1234", charq, (ftnlen)4, (ftnlen)1) == 0) {
+ e_wsle();
#line 10133 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ s_wsle(&io___664);
#line 10133 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic"\
- "ity for a beam must be 1, 2, 3, or 4!", (ftnlen)
- 128, (ftnlen)53);
+ do_lio(&c__9, &c__1, "Sorry for the inconvenience. "\
+ "--The Management", (ftnlen)46);
+#line 10133 ""
+ e_wsle();
+#line 10134 ""
+ } else {
#line 10135 ""
- stop1_();
-#line 10136 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10135 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter after [!", (ftnlen)128, (ftnlen)26);
#line 10137 ""
- goto L17;
+ }
#line 10138 ""
- } else if (*(unsigned char *)charq != ' ') {
+ stop1_();
#line 10139 ""
- if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) > 0) {
+ }
#line 10140 ""
+ } else if (*(unsigned char *)charq == ']') {
+#line 10141 ""
+ if (! c1omget_1.fbon) {
+#line 10142 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10140 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\
- "its must now be preceeded by \"+\" or \"-\"!", (
- ftnlen)128, (ftnlen)54);
#line 10142 ""
- s_wsle(&io___662);
-#line 10142 ""
- do_lio(&c__9, &c__1, "You will have to edit older source"\
- "s to meet this rqmt,", (ftnlen)54);
-#line 10142 ""
- e_wsle();
-#line 10143 ""
- s_wsle(&io___663);
-#line 10143 ""
- do_lio(&c__9, &c__1, "but it was needed to allow 2-digit"\
- " height adjustments.", (ftnlen)54);
-#line 10143 ""
- e_wsle();
-#line 10144 ""
- s_wsle(&io___664);
-#line 10144 ""
- do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th"\
- "e Management", (ftnlen)46);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop"\
+ " with no corresponding start!", (ftnlen)128, (
+ ftnlen)45);
#line 10144 ""
- e_wsle();
+ stop1_();
#line 10145 ""
- } else {
-#line 10146 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10146 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r after [!", (ftnlen)128, (ftnlen)26);
+ g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10147 ""
+ if (*(unsigned char *)charq == '-') {
#line 10148 ""
- }
+ i__1 = a1ll_2.iccount;
+#line 10148 ""
+ if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, (
+ ftnlen)2) != 0) {
#line 10149 ""
- stop1_();
-#line 10150 ""
- }
+ i__1 = a1ll_2.iccount + 1;
+#line 10149 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10149 ""
+ errmsg_(lineq, &i__1, &i__4, "Only sequence allowed "\
+ "here is \"[ \"!", (ftnlen)128, (ftnlen)35);
#line 10151 ""
- } else if (*(unsigned char *)charq == ']') {
+ stop1_();
#line 10152 ""
- if (! c1omget_1.fbon) {
-#line 10153 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ } else {
#line 10153 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit"\
- "h no corresponding start!", (ftnlen)128, (ftnlen)45);
+ a1ll_2.iccount += 2;
+#line 10154 ""
+ }
#line 10155 ""
- stop1_();
+ } else if (*(unsigned char *)charq == '[') {
#line 10156 ""
- }
+ i__1 = a1ll_2.iccount;
+#line 10156 ""
+ if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
+ ftnlen)1) != 0) {
#line 10157 ""
- g1etchar_(lineq, &a1ll_2.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 10158 ""
- if (*(unsigned char *)charq == '-') {
-#line 10159 ""
- i__1 = a1ll_2.iccount;
+ i__1 = a1ll_2.iccount + 1;
+#line 10157 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10157 ""
+ errmsg_(lineq, &i__1, &i__4, "This character must be"\
+ " a blank!", (ftnlen)128, (ftnlen)31);
#line 10159 ""
- if (s_cmp(lineq + i__1, "[ ", a1ll_2.iccount + 2 - i__1, (
- ftnlen)2) != 0) {
-#line 10160 ""
- i__1 = a1ll_2.iccount + 1;
-#line 10160 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10160 ""
- errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here"\
- " is \"[ \"!", (ftnlen)128, (ftnlen)35);
-#line 10162 ""
- stop1_();
-#line 10163 ""
+ }
+#line 10161 ""
} else {
-#line 10164 ""
- a1ll_2.iccount += 2;
+
+/* Forced beam is really ending */
+
#line 10165 ""
- }
+ c1omget_1.fbon = FALSE_;
#line 10166 ""
- } else if (*(unsigned char *)charq == '[') {
+ if (*(unsigned char *)charq == 'j') {
#line 10167 ""
- i__1 = a1ll_2.iccount;
+ i__1 = a1ll_2.iccount;
#line 10167 ""
- if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) != 0) {
+ if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 -
+ i__1, (ftnlen)1) != 0) {
#line 10168 ""
- i__1 = a1ll_2.iccount + 1;
+ i__1 = a1ll_2.iccount + 1;
#line 10168 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10168 ""
- errmsg_(lineq, &i__1, &i__4, "This character must be a b"\
- "lank!", (ftnlen)128, (ftnlen)31);
+ errmsg_(lineq, &i__1, &i__4, "This character mus"\
+ "t be a blank!", (ftnlen)128, (ftnlen)31);
#line 10170 ""
- stop1_();
+ stop1_();
#line 10171 ""
- }
+ }
#line 10172 ""
- } else {
-
-/* Forced beam is really ending */
-
+ } else if (*(unsigned char *)charq != ' ') {
+#line 10173 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10173 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must b"\
+ "e followed by blank, \"j\", \"-\", or \"[\"!",
+ (ftnlen)128, (ftnlen)48);
+#line 10175 ""
+ stop1_();
#line 10176 ""
- c1omget_1.fbon = FALSE_;
+ }
#line 10177 ""
- if (*(unsigned char *)charq == 'j') {
-#line 10178 ""
- i__1 = a1ll_2.iccount;
+ }
#line 10178 ""
- if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) != 0) {
-#line 10179 ""
- i__1 = a1ll_2.iccount + 1;
-#line 10179 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10179 ""
- errmsg_(lineq, &i__1, &i__4, "This character must be"\
- " a blank!", (ftnlen)128, (ftnlen)31);
-#line 10181 ""
- stop1_();
+ } else if (*(unsigned char *)charq == 'D') {
+
+/* Dynamic mark */
+
#line 10182 ""
- }
+ if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
#line 10183 ""
- } else if (*(unsigned char *)charq != ' ') {
-#line 10184 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10184 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo"\
- "llowed by blank, \"j\", \"-\", or \"[\"!", (
- ftnlen)128, (ftnlen)48);
-#line 10186 ""
+#line 10183 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not c"\
+ "ome before any notes have been entered!", (ftnlen)
+ 128, (ftnlen)53);
+#line 10185 ""
stop1_();
-#line 10187 ""
+#line 10186 ""
}
+#line 10187 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10187 ""
+ checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128);
#line 10188 ""
- }
-#line 10189 ""
- } else if (*(unsigned char *)charq == 'D') {
+ } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) {
-/* Dynamic mark */
+/* Save position for later check */
+#line 10192 ""
+ icclhw = a1ll_2.iccount;
#line 10193 ""
- if (a1ll_2.nnl[c1ommvl_1.ivx - 1] == 0) {
-#line 10194 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10194 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come "\
- "before any notes have been entered!", (ftnlen)128, (
- ftnlen)53);
-#line 10196 ""
- stop1_();
+ if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) ==
+ 0) {
+#line 10195 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10195 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
+ "r after \"l\", \"w\", or \"h\"!", (ftnlen)128, (
+ ftnlen)41);
#line 10197 ""
- }
-#line 10198 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
+ stop1_();
#line 10198 ""
- checkdyn_(lineq, &a1ll_2.iccount, &i__1, (ftnlen)128);
+ }
#line 10199 ""
- } else if (i_indx("lhw", charq, (ftnlen)3, (ftnlen)1) > 0) {
-
-/* Save position for later check */
-
-#line 10203 ""
- icclhw = a1ll_2.iccount;
-#line 10204 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 10205 ""
- if (i_indx("0123456789.+- ", durq, (ftnlen)14, (ftnlen)1) == 0) {
-#line 10206 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10206 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
- "ter \"l\", \"w\", or \"h\"!", (ftnlen)128, (ftnlen)41)
- ;
-#line 10208 ""
- stop1_();
-#line 10209 ""
- }
-#line 10210 ""
- c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)charq
- == 'h';
-#line 10211 ""
- if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) {
+ c1omget_1.isheadr = c1omget_1.isheadr || *(unsigned char *)
+ charq == 'h';
+#line 10200 ""
+ if (i_indx(" +-", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* There is a header (or lower string?) */
-#line 10215 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 10204 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* User-defined vert offset (\internote). */
-#line 10219 ""
- if (*(unsigned char *)charq != 'h') {
-#line 10220 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10220 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \""\
- "-\" not permitted here!", (ftnlen)128, (
- ftnlen)30);
-#line 10222 ""
- stop1_();
-#line 10223 ""
- }
+#line 10208 ""
+ if (*(unsigned char *)charq != 'h') {
+#line 10209 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10209 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" "\
+ "or \"-\" not permitted here!", (ftnlen)
+ 128, (ftnlen)30);
+#line 10211 ""
+ stop1_();
+#line 10212 ""
+ }
/* Have "h" followed by +/- . Check for digit. */
/* Can blow durq since not using fnum for now, but... */
-#line 10228 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 10229 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
- {
-#line 10230 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10230 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b"\
- "e a digit here!", (ftnlen)128, (ftnlen)27);
-#line 10232 ""
- stop1_();
-#line 10233 ""
- }
+#line 10217 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10218 ""
+ if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) ==
+ 0) {
+#line 10219 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10219 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "There mu"\
+ "st be a digit here!", (ftnlen)128, (
+ ftnlen)27);
+#line 10221 ""
+ stop1_();
+#line 10222 ""
+ }
/* Have "h" followed by +/- followed by a digit. No need to get the number. */
/* call readnum(lineq,iccount,durq,fnum) */
-#line 10238 ""
- }
-#line 10239 ""
- if (*(unsigned char *)charq != 'w') {
+#line 10227 ""
+ }
+#line 10228 ""
+ if (*(unsigned char *)charq != 'w') {
/* Header or lower string. */
+#line 10232 ""
+ if (icclhw != 1) {
+#line 10233 ""
+ i__1 = a1ll_2.iccount - 1;
+#line 10233 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10233 ""
+ errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" mus"\
+ "t be first character in line!", (ftnlen)
+ 128, (ftnlen)43);
+#line 10235 ""
+ stop1_();
+#line 10236 ""
+ }
+
+/* Read past the next line, which has the string. */
+
+#line 10240 ""
+ read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
+#line 10241 ""
+ ++c1omget_1.nline;
+#line 10242 ""
+ a1ll_2.iccount = 128;
#line 10243 ""
- if (icclhw != 1) {
-#line 10244 ""
- i__1 = a1ll_2.iccount - 1;
+ } else {
#line 10244 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
#line 10244 ""
- errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be"\
- " first character in line!", (ftnlen)128, (
- ftnlen)43);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\""\
+ " (width) must be followed by a digit!", (
+ ftnlen)128, (ftnlen)47);
#line 10246 ""
stop1_();
#line 10247 ""
}
+#line 10248 ""
+ } else {
-/* Read past the next line, which has the string. */
+/* Height or width change spec. Check if at start of piece. */
-#line 10251 ""
- read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
#line 10252 ""
- ++c1omget_1.nline;
+ if (c1omnotes_1.ibarcnt > 0) {
#line 10253 ""
- a1ll_2.iccount = 128;
-#line 10254 ""
- } else {
-#line 10255 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10253 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must "\
+ "go at top of first input block!", (ftnlen)128,
+ (ftnlen)43);
#line 10255 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi"\
- "dth) must be followed by a digit!", (ftnlen)128, (
- ftnlen)47);
+ stop1_();
+#line 10256 ""
+ }
#line 10257 ""
- stop1_();
-#line 10258 ""
- }
-#line 10259 ""
- } else {
+ readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)
+ 128, (ftnlen)1);
-/* Height or width change spec. Check if at start of piece. */
+/* Check units. Convert to points */
+#line 10261 ""
+ if (*(unsigned char *)durq == ' ' || *(unsigned char *)
+ durq == 'p') {
+#line 10262 ""
+ dimen += .5f;
#line 10263 ""
- if (c1omnotes_1.ibarcnt > 0) {
-#line 10264 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ } else if (*(unsigned char *)durq == 'i') {
#line 10264 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a"\
- "t top of first input block!", (ftnlen)128, (
- ftnlen)43);
+ dimen = dimen * 72 + .5f;
+#line 10265 ""
+ } else if (*(unsigned char *)durq == 'm') {
#line 10266 ""
- stop1_();
+ dimen = dimen / 25.4f * 72 + .5f;
#line 10267 ""
- }
+ } else {
#line 10268 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &dimen, (ftnlen)128, (
- ftnlen)1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10268 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit"\
+ "; must be \"p\",\"i\",or\"m\"!", (ftnlen)128,
+ (ftnlen)36);
+#line 10270 ""
+ stop1_();
+#line 10271 ""
+ }
-/* Check units. Convert to points */
+/* 151211 fix. May have extra character. */
-#line 10272 ""
- if (*(unsigned char *)durq == ' ' || *(unsigned char *)durq ==
- 'p') {
-#line 10273 ""
- dimen += .5f;
-#line 10274 ""
- } else if (*(unsigned char *)durq == 'i') {
#line 10275 ""
- dimen = dimen * 72 + .5f;
-#line 10276 ""
- } else if (*(unsigned char *)durq == 'm') {
-#line 10277 ""
- dimen = dimen / 25.4f * 72 + .5f;
-#line 10278 ""
- } else {
+ if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) {
+
+/* Get another character, see if it's blank */
+
#line 10279 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = a1ll_2.iccount;
#line 10279 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu"\
- "st be \"p\",\"i\",or\"m\"!", (ftnlen)128, (ftnlen)
- 36);
-#line 10281 ""
- stop1_();
+ if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 -
+ i__1, (ftnlen)1) != 0) {
+#line 10280 ""
+ i__1 = a1ll_2.iccount + 1;
+#line 10280 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10280 ""
+ errmsg_(lineq, &i__1, &i__4, "This character sho"\
+ "uld be a blank!", (ftnlen)128, (ftnlen)33)
+ ;
#line 10282 ""
- }
-
-/* 151211 fix. May have extra character. */
-
+ stop1_();
+#line 10283 ""
+ }
+#line 10284 ""
+ }
+#line 10285 ""
+ if (*(unsigned char *)charq == 'h') {
#line 10286 ""
- if (i_indx("pim", durq, (ftnlen)3, (ftnlen)1) > 0) {
-
-/* Get another character, see if it's blank */
-
-#line 10290 ""
- i__1 = a1ll_2.iccount;
-#line 10290 ""
- if (s_cmp(lineq + i__1, " ", a1ll_2.iccount + 1 - i__1, (
- ftnlen)1) != 0) {
-#line 10291 ""
- i__1 = a1ll_2.iccount + 1;
-#line 10291 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10291 ""
- errmsg_(lineq, &i__1, &i__4, "This character should "\
- "be a blank!", (ftnlen)128, (ftnlen)33);
-#line 10293 ""
- stop1_();
-#line 10294 ""
+ compage_1.ptheight = (real) ((integer) dimen);
+#line 10287 ""
+ } else {
+#line 10288 ""
+ compage_1.widthpt = (real) ((integer) dimen);
+#line 10289 ""
}
-#line 10295 ""
- }
-#line 10296 ""
- if (*(unsigned char *)charq == 'h') {
-#line 10297 ""
- compage_1.ptheight = (real) ((integer) dimen);
-#line 10298 ""
- } else {
-#line 10299 ""
- compage_1.widthpt = (real) ((integer) dimen);
-#line 10300 ""
+#line 10290 ""
}
-#line 10301 ""
- }
-#line 10302 ""
- } else if (*(unsigned char *)charq == 'm') {
+#line 10291 ""
+ } else if (*(unsigned char *)charq == 'm') {
/* Time signature change. Only allow at beginning of block. */
/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */
@@ -25072,117 +25118,121 @@ L17:
/* Check whether at beginning of a block */
+#line 10299 ""
+ if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
+#line 10300 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10300 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change onl"\
+ "y OK in voice 1, at start of block!", (ftnlen)128,
+ (ftnlen)51);
+#line 10302 ""
+ s_wsle(&io___667);
+#line 10302 ""
+ do_lio(&c__9, &c__1, "voice number is", (ftnlen)15);
+#line 10302 ""
+ do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)
+ sizeof(integer));
+#line 10302 ""
+ e_wsle();
+#line 10303 ""
+ stop1_();
+#line 10304 ""
+ }
+#line 10305 ""
+ a1ll_2.newmeter = TRUE_;
+#line 10306 ""
+ i__1 = a1ll_2.iccount;
+#line 10306 ""
+ if (i_indx("o0123456789", lineq + i__1, (ftnlen)11,
+ a1ll_2.iccount + 1 - i__1) == 0) {
+#line 10307 ""
+ i__1 = a1ll_2.iccount + 1;
+#line 10307 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10307 ""
+ errmsg_(lineq, &i__1, &i__4, "Illegal character in \"m\""\
+ " command for meter change!", (ftnlen)128, (ftnlen)
+ 50);
+#line 10309 ""
+ stop1_();
#line 10310 ""
- if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
-#line 10311 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10311 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\
- " in voice 1, at start of block!", (ftnlen)128, (
- ftnlen)51);
-#line 10313 ""
- s_wsle(&io___667);
+ readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl,
+ (ftnlen)128);
+#line 10312 ""
+ if (a1ll_2.mtrnuml == 0) {
#line 10313 ""
- do_lio(&c__9, &c__1, "voice number is", (ftnlen)15);
+ i__1 = a1ll_2.iccount - 1;
#line 10313 ""
- do_lio(&c__3, &c__1, (char *)&c1ommvl_1.ivx, (ftnlen)sizeof(
- integer));
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10313 ""
- e_wsle();
-#line 10314 ""
- stop1_();
+ errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!",
+ (ftnlen)128, (ftnlen)25);
#line 10315 ""
- }
+ stop1_();
#line 10316 ""
- a1ll_2.newmeter = TRUE_;
-#line 10317 ""
- i__1 = a1ll_2.iccount;
+ }
#line 10317 ""
- if (i_indx("o0123456789", lineq + i__1, (ftnlen)11,
- a1ll_2.iccount + 1 - i__1) == 0) {
-#line 10318 ""
- i__1 = a1ll_2.iccount + 1;
-#line 10318 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10318 ""
- errmsg_(lineq, &i__1, &i__4, "Illegal character in \"m\" com"\
- "mand for meter change!", (ftnlen)128, (ftnlen)50);
-#line 10320 ""
- stop1_();
+ readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)
+ 128);
+
+/* Read past printed time signature; not used in pmxa. */
+
#line 10321 ""
- }
+ lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
#line 10322 ""
- readmeter_(lineq, &a1ll_2.iccount, &a1ll_2.mtrnuml, &mtrdenl, (
- ftnlen)128);
+ lenmult = 1;
#line 10323 ""
- if (a1ll_2.mtrnuml == 0) {
-#line 10324 ""
- i__1 = a1ll_2.iccount - 1;
-#line 10324 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ if (mtrdenl == 2) {
#line 10324 ""
- errmsg_(lineq, &i__1, &i__4, "Digit 0 not allowed here!", (
- ftnlen)128, (ftnlen)25);
+ lenbeat = 16;
+#line 10325 ""
+ lenmult = 2;
#line 10326 ""
- stop1_();
+ }
#line 10327 ""
- }
+ a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat;
#line 10328 ""
- readmeter_(lineq, &a1ll_2.iccount, &mtrnmp, &mtrdnp, (ftnlen)128);
-
-/* Read past printed time signature; not used in pmxa. */
-
-#line 10332 ""
- lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
+ a1ll_2.mtrnuml = 0;
+#line 10329 ""
+ } else if (*(unsigned char *)charq == 'C') {
+#line 10330 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10331 ""
+ if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *
+ (unsigned char *)durq >= 48 && *(unsigned char *)durq
+ <= 56)) {
#line 10333 ""
- lenmult = 1;
-#line 10334 ""
- if (mtrdenl == 2) {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10333 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,"\
+ "a,n,r,b,f or 0-8 after C!", (ftnlen)128, (ftnlen)
+ 41);
#line 10335 ""
- lenbeat = 16;
+ stop1_();
#line 10336 ""
- lenmult = 2;
+ }
#line 10337 ""
- }
+ } else if (*(unsigned char *)charq == 'R') {
#line 10338 ""
- a1ll_2.lenbar = lenmult * a1ll_2.mtrnuml * lenbeat;
+ if (c1ommvl_1.ivx != 1) {
#line 10339 ""
- a1ll_2.mtrnuml = 0;
-#line 10340 ""
- } else if (*(unsigned char *)charq == 'C') {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10339 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only"\
+ " go in voice 1!", (ftnlen)128, (ftnlen)31);
#line 10341 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ stop1_();
#line 10342 ""
- if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1) > 0 || *(
- unsigned char *)durq >= 48 && *(unsigned char *)durq <=
- 56)) {
-#line 10344 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10344 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n,"\
- "r,b,f or 0-8 after C!", (ftnlen)128, (ftnlen)41);
-#line 10346 ""
- stop1_();
-#line 10347 ""
- }
-#line 10348 ""
- } else if (*(unsigned char *)charq == 'R') {
-#line 10349 ""
- if (c1ommvl_1.ivx != 1) {
-#line 10350 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10350 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go "\
- "in voice 1!", (ftnlen)128, (ftnlen)31);
-#line 10352 ""
- stop1_();
-#line 10353 ""
- }
+ }
/* 10 call g1etchar(lineq,iccount,durq) */
/* if (index('lrdDbz',durq) .gt. 0) go to 10 */
/* if (durq .ne. ' ') then */
@@ -25190,704 +25240,730 @@ L17:
/* * 'Illegal character after "R" (repeat/double bar)!') */
/* call stop1() */
/* end if */
-#line 10361 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 10362 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)1);
+#line 10350 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
+#line 10351 ""
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (ftnlen)
+ 1);
/* Writing concatenation */
+#line 10352 ""
+ i__3[0] = 1, a__2[0] = durq;
+#line 10352 ""
+ i__3[1] = 1, a__2[1] = dumq;
+#line 10352 ""
+ s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2);
+#line 10352 ""
+ if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, (
+ ftnlen)2) == 0) {
+#line 10353 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10353 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
+ "r after \"R*\" (repeat/double bar)!", (ftnlen)128,
+ (ftnlen)49);
+#line 10355 ""
+ stop1_();
+#line 10356 ""
+ }
+#line 10357 ""
+ if (*(unsigned char *)dumq != ' ') {
+#line 10358 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10359 ""
+ if (*(unsigned char *)durq != ' ') {
+#line 10360 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10360 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have bl"\
+ "ank after \"R**\" (repeat/double bar)!", (
+ ftnlen)128, (ftnlen)48);
+#line 10362 ""
+ stop1_();
#line 10363 ""
- i__3[0] = 1, a__2[0] = durq;
-#line 10363 ""
- i__3[1] = 1, a__2[1] = dumq;
-#line 10363 ""
- s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)2);
-#line 10363 ""
- if (i_indx("l Xr Xd XD Xb Xz XlrXdlX", ch__3, (ftnlen)24, (ftnlen)
- 2) == 0) {
-#line 10364 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10364 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af"\
- "ter \"R*\" (repeat/double bar)!", (ftnlen)128, (
- ftnlen)49);
-#line 10366 ""
- stop1_();
-#line 10367 ""
- }
-#line 10368 ""
- if (*(unsigned char *)dumq != ' ') {
+ }
+#line 10365 ""
+ } else if (*(unsigned char *)charq == 'V') {
+
+/* Ending */
+
#line 10369 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ if (a1ll_2.iv != 1) {
#line 10370 ""
- if (*(unsigned char *)durq != ' ') {
-#line 10371 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10371 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have blank "\
- "after \"R**\" (repeat/double bar)!", (ftnlen)128,
- (ftnlen)48);
-#line 10373 ""
+#line 10370 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only "\
+ "allowed in voice #1!", (ftnlen)128, (ftnlen)36);
+#line 10372 ""
stop1_();
+#line 10373 ""
+ } else if (c1omget_1.isvolt) {
#line 10374 ""
- }
+ s_wsle(&io___673);
+#line 10374 ""
+ e_wsle();
#line 10375 ""
- }
+ s_wsle(&io___674);
+#line 10375 ""
+ do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22)
+ ;
+#line 10375 ""
+ e_wsle();
#line 10376 ""
- } else if (*(unsigned char *)charq == 'V') {
-
-/* Ending */
-
+ s_wsfe(&io___675);
+#line 10376 ""
+ do_fio(&c__1, "*******WARNING********", (ftnlen)22);
+#line 10376 ""
+ e_wsfe();
+#line 10377 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10377 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more th"\
+ "an one volta in this input block.!", (ftnlen)128,
+ (ftnlen)50);
+#line 10379 ""
+ s_wsle(&io___676);
+#line 10379 ""
+ do_lio(&c__9, &c__1, "This may work in a score, but WILL"\
+ " NOT work in parts.", (ftnlen)53);
+#line 10379 ""
+ e_wsle();
#line 10380 ""
- if (a1ll_2.iv != 1) {
-#line 10381 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10381 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo"\
- "wed in voice #1!", (ftnlen)128, (ftnlen)36);
-#line 10383 ""
- stop1_();
+ s_wsle(&io___677);
+#line 10380 ""
+ do_lio(&c__9, &c__1, "Safest to have only 1 volta per bl"\
+ "ock, at the start of the block", (ftnlen)64);
+#line 10380 ""
+ e_wsle();
+#line 10382 ""
+ s_wsfe(&io___678);
+#line 10382 ""
+ do_fio(&c__1, "This may work in a score, but WILL NOT wo"\
+ "rk in parts.", (ftnlen)53);
+#line 10382 ""
+ e_wsfe();
#line 10384 ""
- } else if (c1omget_1.isvolt) {
-#line 10385 ""
- s_wsle(&io___673);
-#line 10385 ""
- e_wsle();
-#line 10386 ""
- s_wsle(&io___674);
-#line 10386 ""
- do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22);
+ s_wsfe(&io___679);
+#line 10384 ""
+ do_fio(&c__1, "Safest to have only 1 volta per block, at"\
+ " the start of the block", (ftnlen)64);
+#line 10384 ""
+ e_wsfe();
#line 10386 ""
- e_wsle();
-#line 10387 ""
- s_wsfe(&io___675);
-#line 10387 ""
- do_fio(&c__1, "*******WARNING********", (ftnlen)22);
+ }
#line 10387 ""
- e_wsfe();
+ c1omget_1.isvolt = TRUE_;
#line 10388 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10388 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\
- "ne volta in this input block.!", (ftnlen)128, (ftnlen)
- 50);
-#line 10390 ""
- s_wsle(&io___676);
-#line 10390 ""
- do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT"\
- " work in parts.", (ftnlen)53);
+ lvoltxt = 0;
+#line 10389 ""
+L11:
+#line 10389 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10390 ""
- e_wsle();
-#line 10391 ""
- s_wsle(&io___677);
-#line 10391 ""
- do_lio(&c__9, &c__1, "Safest to have only 1 volta per block,"\
- " at the start of the block", (ftnlen)64);
+ if (*(unsigned char *)durq != ' ') {
#line 10391 ""
- e_wsle();
-#line 10393 ""
- s_wsfe(&io___678);
-#line 10393 ""
- do_fio(&c__1, "This may work in a score, but WILL NOT work i"\
- "n parts.", (ftnlen)53);
+ goto L11;
+#line 10392 ""
+ }
#line 10393 ""
- e_wsfe();
-#line 10395 ""
- s_wsfe(&io___679);
-#line 10395 ""
- do_fio(&c__1, "Safest to have only 1 volta per block, at the"\
- " start of the block", (ftnlen)64);
+ } else if (*(unsigned char *)charq == 'B') {
#line 10395 ""
- e_wsfe();
+ } else if (*(unsigned char *)charq == 'P') {
+#line 10396 ""
+ if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
#line 10397 ""
- }
-#line 10398 ""
- c1omget_1.isvolt = TRUE_;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10397 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at "\
+ "beginning of block!", (ftnlen)128, (ftnlen)35);
#line 10399 ""
- lvoltxt = 0;
-#line 10400 ""
-L11:
+ stop1_();
#line 10400 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ }
#line 10401 ""
- if (*(unsigned char *)durq != ' ') {
+L16:
+#line 10401 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10402 ""
- goto L11;
-#line 10403 ""
- }
+ if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq ==
+ 'r' || *(unsigned char *)durq >= 48 && *(unsigned
+ char *)durq <= 57) {
+#line 10402 ""
+ goto L16;
+#line 10402 ""
+ }
#line 10404 ""
- } else if (*(unsigned char *)charq == 'B') {
-#line 10406 ""
- } else if (*(unsigned char *)charq == 'P') {
-#line 10407 ""
- if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
-#line 10408 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10408 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi"\
- "nning of block!", (ftnlen)128, (ftnlen)35);
-#line 10410 ""
- stop1_();
-#line 10411 ""
- }
-#line 10412 ""
-L16:
-#line 10412 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 10413 ""
- if (*(unsigned char *)durq == 'l' || *(unsigned char *)durq ==
- 'r' || *(unsigned char *)durq >= 48 && *(unsigned char *)
- durq <= 57) {
-#line 10413 ""
- goto L16;
-#line 10413 ""
- }
-#line 10415 ""
- if (*(unsigned char *)durq == 'c') {
+ if (*(unsigned char *)durq == 'c') {
/* Expect a centered name, and it has to be last option */
+#line 10408 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10409 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 10409 ""
+ if (*(unsigned char *)durq == *(unsigned char *)&ch__2[0])
+ {
+
+/* Quoted name, go to next quote mark */
+
+#line 10413 ""
+ for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
+ ++a1ll_2.iccount) {
+#line 10414 ""
+ i__1 = a1ll_2.iccount - 2;
+#line 10414 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 10414 ""
+ chax_(ch__4, (ftnlen)1, &c__92);
+#line 10414 ""
+ if (*(unsigned char *)&lineq[a1ll_2.iccount - 1]
+ == *(unsigned char *)&ch__2[0] && s_cmp(
+ lineq + i__1, ch__4, a1ll_2.iccount - 1 -
+ i__1, (ftnlen)1) != 0) {
+#line 10414 ""
+ goto L36;
+#line 10414 ""
+ }
+#line 10416 ""
+/* L35: */
+#line 10416 ""
+ }
+#line 10417 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10417 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing clos"\
+ "e quote after page number command (P)!", (
+ ftnlen)128, (ftnlen)50);
#line 10419 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ stop1_();
#line 10420 ""
- if (*(unsigned char *)durq == '"') {
+L36:
+#line 10421 ""
+ ;
+#line 10421 ""
+ } else if (*(unsigned char *)durq != ' ') {
-/* Quoted name, go to next quote mark */
+/* Space-delimited name, look for next blank */
-#line 10424 ""
- for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
- ++a1ll_2.iccount) {
-#line 10425 ""
- i__1 = a1ll_2.iccount - 2;
#line 10425 ""
- if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
- '"' && s_cmp(lineq + i__1, "\\",
- a1ll_2.iccount - 1 - i__1, (ftnlen)1) != 0) {
-#line 10425 ""
- goto L36;
-#line 10425 ""
- }
+ for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
+ ++a1ll_2.iccount) {
+#line 10426 ""
+ if (*(unsigned char *)&lineq[a1ll_2.iccount - 1]
+ == ' ') {
+#line 10426 ""
+ goto L38;
+#line 10426 ""
+ }
#line 10427 ""
-/* L35: */
+/* L37: */
#line 10427 ""
- }
+ }
#line 10428 ""
+L38:
+#line 10429 ""
+ ;
+#line 10429 ""
+ }
+#line 10430 ""
+ } else if (*(unsigned char *)durq != ' ') {
+#line 10431 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10428 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu"\
- "ote after page number command (P)!", (ftnlen)128,
- (ftnlen)50);
-#line 10430 ""
- stop1_();
#line 10431 ""
-L36:
-#line 10432 ""
- ;
-#line 10432 ""
- } else if (*(unsigned char *)durq != ' ') {
-
-/* Space-delimited name, look for next blank */
-
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\""\
+ "r\",\"c\" or digit allowed after \"P\"!", (ftnlen)
+ 128, (ftnlen)44);
+#line 10433 ""
+ stop1_();
+#line 10434 ""
+ }
+#line 10435 ""
+ } else if (*(unsigned char *)charq == 'W') {
#line 10436 ""
- for (++a1ll_2.iccount; a1ll_2.iccount <= 127;
- ++a1ll_2.iccount) {
-#line 10437 ""
- if (*(unsigned char *)&lineq[a1ll_2.iccount - 1] ==
- ' ') {
-#line 10437 ""
- goto L38;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10437 ""
- }
+ if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) {
#line 10438 ""
-/* L37: */
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10438 ""
- }
-#line 10439 ""
-L38:
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a numbe"\
+ "r to start here!", (ftnlen)128, (ftnlen)32);
#line 10440 ""
- ;
-#line 10440 ""
- }
+ stop1_();
#line 10441 ""
- } else if (*(unsigned char *)durq != ' ') {
-#line 10442 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 10442 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\""\
- "c\" or digit allowed after \"P\"!", (ftnlen)128, (
- ftnlen)44);
-#line 10444 ""
- stop1_();
-#line 10445 ""
- }
-#line 10446 ""
- } else if (*(unsigned char *)charq == 'W') {
+ readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[
+ c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (
+ ftnlen)1);
+#line 10443 ""
+ } else if (*(unsigned char *)charq == 'T') {
+
+/* Titles */
+
#line 10447 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10448 ""
- if (i_indx(".0123456789", durq, (ftnlen)11, (ftnlen)1) == 0) {
+ if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) {
#line 10449 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10449 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to"\
- " start here!", (ftnlen)128, (ftnlen)32);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\","\
+ " \"t\", or \"c\" after \"T\"!", (ftnlen)128, (
+ ftnlen)36);
#line 10451 ""
- stop1_();
+ stop1_();
#line 10452 ""
- }
+ }
#line 10453 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &c1omnotes_1.wminnh[
- c1omnotes_1.ibarcnt + a1ll_2.nbars], (ftnlen)128, (ftnlen)
- 1);
-#line 10454 ""
- } else if (*(unsigned char *)charq == 'T') {
+ i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1;
+#line 10453 ""
+ c1omget_1.ihead += pow_ii(&c__2, &i__1);
-/* Titles */
+/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */
+#line 10457 ""
+ read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
#line 10458 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ ++c1omget_1.nline;
#line 10459 ""
- if (i_indx("itc", durq, (ftnlen)3, (ftnlen)1) == 0) {
-#line 10460 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ a1ll_2.iccount = 128;
#line 10460 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \""\
- "t\", or \"c\" after \"T\"!", (ftnlen)128, (ftnlen)36);
+ } else if (*(unsigned char *)charq == 'A') {
+#line 10461 ""
+L27:
+#line 10461 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
#line 10462 ""
- stop1_();
+ if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) {
#line 10463 ""
- }
-#line 10464 ""
- i__1 = i_indx("itc", durq, (ftnlen)3, (ftnlen)1) - 1;
+ goto L27;
#line 10464 ""
- c1omget_1.ihead += pow_ii(&c__2, &i__1);
+ } else if (*(unsigned char *)durq == 'e') {
-/* Maybe a number after 'Tt', but ignore here. Read past string on next line. */
+/* Check for is4bignv. Must do here to catch first \internote, written in topfile */
+/* before ever calling getnote. Initialize as .false. in pmxa. Make it true only */
+/* if nv>7, AI not set, Ai not set. */
-#line 10468 ""
- read10_(charq, &c1omget_1.lastchar, (ftnlen)1);
-#line 10469 ""
- ++c1omget_1.nline;
#line 10470 ""
- a1ll_2.iccount = 128;
+ comis4bignv_1.is4bignv = a1ll_2.nv > 7 && !
+ comis4bignv_1.aiset;
#line 10471 ""
- } else if (*(unsigned char *)charq == 'A') {
+ goto L27;
#line 10472 ""
-L27:
-#line 10472 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-/* if (index('rbsdeK',durq) .gt. 0) then */
+ } else if (*(unsigned char *)durq == 'v') {
+#line 10473 ""
+ if (c1omnotes_1.ibarcnt == 0) {
+#line 10473 ""
+ comnvst_1.novshrinktop = TRUE_;
+#line 10473 ""
+ }
#line 10474 ""
- if (i_indx("rbsdK", durq, (ftnlen)5, (ftnlen)1) > 0) {
+ goto L27;
#line 10475 ""
- goto L27;
+ } else if (*(unsigned char *)durq == 'a') {
#line 10476 ""
- } else if (*(unsigned char *)durq == 'e') {
-
-/* Check for is4bignv. Must do here to catch first \internote, written in topfile */
-/* before ever calling getnote. Initialize as .false. in pmxa. Make it true only */
-/* if nv>7, AI not set, Ai not set. */
-
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10477 ""
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
+ 0) {
+#line 10478 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10478 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\""\
+ ", need decimal number!", (ftnlen)128, (ftnlen)
+ 32);
+#line 10480 ""
+ stop1_();
+#line 10481 ""
+ }
#line 10482 ""
- comis4bignv_1.is4bignv = a1ll_2.nv > 7 && !
- comis4bignv_1.aiset;
+ readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, (
+ ftnlen)128, (ftnlen)1);
#line 10483 ""
- goto L27;
+ --a1ll_2.iccount;
#line 10484 ""
- } else if (*(unsigned char *)durq == 'v') {
-#line 10485 ""
- if (c1omnotes_1.ibarcnt == 0) {
+ goto L27;
#line 10485 ""
- comnvst_1.novshrinktop = TRUE_;
-#line 10485 ""
- }
+ } else if (*(unsigned char *)durq == 'i') {
#line 10486 ""
- goto L27;
+ comis4bignv_1.is4bignv = FALSE_;
#line 10487 ""
- } else if (*(unsigned char *)durq == 'a') {
+ comis4bignv_1.aiset = TRUE_;
#line 10488 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
-#line 10489 ""
- if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 10490 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10490 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne"\
- "ed decimal number!", (ftnlen)128, (ftnlen)32);
-#line 10492 ""
- stop1_();
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+
+/* Local interstaff correction. Set to -1. if not specifiec, or after use, */
+/* or anytime except at top, since pmxb handles all times except at top. */
+
#line 10493 ""
- }
+ readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)
+ 128, (ftnlen)1);
#line 10494 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &c1ommvl_1.fbar, (
- ftnlen)128, (ftnlen)1);
+ if (c1omnotes_1.ibarcnt == 0) {
+#line 10494 ""
+ compage_1.fintstf = tintstf;
+#line 10494 ""
+ }
#line 10495 ""
- --a1ll_2.iccount;
+ --a1ll_2.iccount;
#line 10496 ""
- goto L27;
+ goto L27;
#line 10497 ""
- } else if (*(unsigned char *)durq == 'i') {
-#line 10498 ""
- comis4bignv_1.is4bignv = FALSE_;
-#line 10499 ""
- comis4bignv_1.aiset = TRUE_;
-#line 10500 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ } else if (*(unsigned char *)durq == 'I') {
-/* Local interstaff correction. Set to -1. if not specifiec, or after use, */
-/* or anytime except at top, since pmxb handles all times except at top. */
+/* Global interstaff correction. Use in place of fintstf if fintstf<0 */
+#line 10501 ""
+ comis4bignv_1.is4bignv = FALSE_;
+#line 10502 ""
+ comis4bignv_1.aiset = TRUE_;
+#line 10503 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10504 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf,
+ (ftnlen)128, (ftnlen)1);
#line 10505 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &tintstf, (ftnlen)128,
- (ftnlen)1);
-#line 10506 ""
- if (c1omnotes_1.ibarcnt == 0) {
-#line 10506 ""
- compage_1.fintstf = tintstf;
+ --a1ll_2.iccount;
#line 10506 ""
- }
+ goto L27;
#line 10507 ""
- --a1ll_2.iccount;
+ } else if (*(unsigned char *)durq == 'o') {
#line 10508 ""
- goto L27;
+ *optimize = TRUE_;
#line 10509 ""
- } else if (*(unsigned char *)durq == 'I') {
-
-/* Global interstaff correction. Use in place of fintstf if fintstf<0 */
-
+ goto L27;
+#line 10510 ""
+ } else if (*(unsigned char *)durq == 'S') {
+#line 10511 ""
+ i__1 = comkeys_1.noinst;
+#line 10511 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 10512 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10513 ""
- comis4bignv_1.is4bignv = FALSE_;
+ if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) {
#line 10514 ""
- comis4bignv_1.aiset = TRUE_;
-#line 10515 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10514 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \""\
+ "AS\", need nv instances of \"s,t,-,0\"!",
+ (ftnlen)128, (ftnlen)43);
#line 10516 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.gintstf, (
- ftnlen)128, (ftnlen)1);
+ stop1_();
#line 10517 ""
- --a1ll_2.iccount;
+ }
#line 10518 ""
- goto L27;
+ if (*(unsigned char *)durq == '-' || *(unsigned char *
+ )durq == 's') {
#line 10519 ""
- } else if (*(unsigned char *)durq == 'o') {
+ comsize_1.isize[iiv - 1] = 1;
#line 10520 ""
- *optimize = TRUE_;
+ } else if (*(unsigned char *)durq == 't') {
#line 10521 ""
- goto L27;
+ comsize_1.isize[iiv - 1] = 2;
#line 10522 ""
- } else if (*(unsigned char *)durq == 'S') {
+ }
#line 10523 ""
- i__1 = comkeys_1.noinst;
+/* L50: */
#line 10523 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
+ }
#line 10524 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ goto L27;
#line 10525 ""
- if (i_indx("-0st", durq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 10526 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ } else if (*(unsigned char *)durq == 'p') {
#line 10526 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\""\
- ", need nv instances of \"s,t,-,0\"!", (ftnlen)
- 128, (ftnlen)43);
+ comslur_1.fontslur = FALSE_;
+#line 10527 ""
+L42:
#line 10528 ""
- stop1_();
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10529 ""
- }
-#line 10530 ""
- if (*(unsigned char *)durq == '-' || *(unsigned char *)
- durq == 's') {
-#line 10531 ""
- comsize_1.isize[iiv - 1] = 1;
-#line 10532 ""
- } else if (*(unsigned char *)durq == 't') {
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+
+/* Characters to change defaults for ps slurs */
+
#line 10533 ""
- comsize_1.isize[iiv - 1] = 2;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10534 ""
- }
+ if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) {
#line 10535 ""
-/* L50: */
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10535 ""
- }
-#line 10536 ""
- goto L27;
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only let"\
+ "ters allowed here are \"s\",\"h\",\"t\""\
+ ",\"c\"!", (ftnlen)128, (ftnlen)46);
#line 10537 ""
- } else if (*(unsigned char *)durq == 'p') {
+ stop1_();
#line 10538 ""
- comslur_1.fontslur = FALSE_;
-#line 10539 ""
-L42:
-#line 10540 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
-#line 10541 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+ }
-/* Characters to change defaults for ps slurs */
+/* Now check for another default modifier */
+
+#line 10542 ""
+ goto L42;
+#line 10543 ""
+ } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) {
+
+/* Flags for optional linebreak ties or header specials */
-#line 10545 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 10546 ""
- if (i_indx("shtc", durq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 10547 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
#line 10547 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters"\
- " allowed here are \"s\",\"h\",\"t\",\"c\"!", (
- ftnlen)128, (ftnlen)46);
+ goto L42;
+#line 10548 ""
+ } else {
#line 10549 ""
- stop1_();
+ --a1ll_2.iccount;
#line 10550 ""
}
+#line 10551 ""
+ goto L27;
+#line 10552 ""
+ } else if (*(unsigned char *)durq == 'N') {
-/* Now check for another default modifier */
-
-#line 10554 ""
- goto L42;
-#line 10555 ""
- } else if (i_indx("lh", durq, (ftnlen)2, (ftnlen)1) > 0) {
-
-/* Flags for optional linebreak ties or header specials */
+/* Override default name for a part file. Must have part number, then */
+/* partname in quotes. Must be on line by itself, and start in column 1. */
+/* Will only be passed thru to scor2prt. */
+#line 10558 ""
+ if (a1ll_2.iccount != 2) {
#line 10559 ""
- goto L42;
-#line 10560 ""
- } else {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10559 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must "\
+ "start in column 1!", (ftnlen)128, (ftnlen)28);
#line 10561 ""
- --a1ll_2.iccount;
+ stop1_();
#line 10562 ""
- }
+ }
#line 10563 ""
- goto L27;
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 10563 ""
+ ndxquote = i_indx(lineq, ch__2, (ftnlen)128, (ftnlen)1);
#line 10564 ""
- } else if (*(unsigned char *)durq == 'N') {
-
-/* Override default name for a part file. Must have part number, then */
-/* partname in quotes. Must be on line by itself, and start in column 1. */
-/* Will only be passed thru to scor2prt. */
-
+ if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789",
+ lineq + 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote
+ == 5 && i_indx("012", lineq + 3, (ftnlen)3, (
+ ftnlen)1) == 0) {
+#line 10567 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10567 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must "\
+ "be followed by inst. #, then quote!", (ftnlen)
+ 128, (ftnlen)45);
+#line 10569 ""
+ stop1_();
#line 10570 ""
- if (a1ll_2.iccount != 2) {
+ }
#line 10571 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = ndxquote;
+#line 10571 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
#line 10571 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star"\
- "t in column 1!", (ftnlen)128, (ftnlen)28);
+ ndxquote = i_indx(lineq + i__1, ch__2, 128 - i__1, (
+ ftnlen)1);
+#line 10572 ""
+ if (ndxquote == 0) {
#line 10573 ""
- stop1_();
-#line 10574 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10573 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", f"\
+ "ile name must be in quotes!", (ftnlen)128, (
+ ftnlen)37);
#line 10575 ""
- ndxquote = i_indx(lineq, "\"", (ftnlen)128, (ftnlen)1);
+ stop1_();
#line 10576 ""
- if (ndxquote < 4 || ndxquote > 5 || i_indx("123456789", lineq
- + 2, (ftnlen)9, (ftnlen)1) == 0 || ndxquote == 5 &&
- i_indx("012", lineq + 3, (ftnlen)3, (ftnlen)1) == 0) {
-#line 10579 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
+#line 10577 ""
+ a1ll_2.iccount = 128;
+#line 10578 ""
+ } else if (*(unsigned char *)durq == 'T') {
#line 10579 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f"\
- "ollowed by inst. #, then quote!", (ftnlen)128, (
- ftnlen)45);
-#line 10581 ""
- stop1_();
-#line 10582 ""
- }
-#line 10583 ""
- i__1 = ndxquote;
-#line 10583 ""
- ndxquote = i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
+ comnvst_1.cstuplet = TRUE_;
+#line 10580 ""
+ } else if (*(unsigned char *)durq == 'R') {
+
+/* Get full name of normal include file; must occupy remainder of line */
+
#line 10584 ""
- if (ndxquote == 0) {
-#line 10585 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = a1ll_2.iccount;
+#line 10584 ""
+ getpmxmod_(&c_false, lineq + i__1, 128 - i__1);
#line 10585 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file "\
- "name must be in quotes!", (ftnlen)128, (ftnlen)37)
- ;
+ a1ll_2.iccount = 128;
+#line 10586 ""
+ } else if (*(unsigned char *)durq == 'c') {
#line 10587 ""
- stop1_();
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10588 ""
- }
+ if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 10589 ""
- a1ll_2.iccount = 128;
-#line 10590 ""
- } else if (*(unsigned char *)durq == 'T') {
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10589 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" o"\
+ "r \"4\" is allowed here!", (ftnlen)128, (
+ ftnlen)32);
#line 10591 ""
- comnvst_1.cstuplet = TRUE_;
+ stop1_();
#line 10592 ""
- } else if (*(unsigned char *)durq == 'R') {
-
-/* Get full name of normal include file; must occupy remainder of line */
-
-#line 10596 ""
- i__1 = a1ll_2.iccount;
+ }
+#line 10593 ""
+ if (*(unsigned char *)durq == 'l') {
+#line 10594 ""
+ compage_1.hoffpt = -25.f;
+#line 10595 ""
+ compage_1.voffpt = -45.f;
#line 10596 ""
- getpmxmod_(&c_false, lineq + i__1, 128 - i__1);
+ } else if (*(unsigned char *)durq == '4') {
#line 10597 ""
- a1ll_2.iccount = 128;
+ compage_1.ptheight = 745.f;
#line 10598 ""
- } else if (*(unsigned char *)durq == 'c') {
+ compage_1.widthpt = 499.f;
#line 10599 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ compage_1.hoffpt = -24.f;
#line 10600 ""
- if (i_indx("l4", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 10601 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ compage_1.voffpt = -24.f;
#line 10601 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or"\
- " \"4\" is allowed here!", (ftnlen)128, (ftnlen)32)
- ;
+ }
+#line 10602 ""
+ goto L27;
#line 10603 ""
- stop1_();
+ } else if (*(unsigned char *)durq == 'V') {
#line 10604 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10605 ""
- if (*(unsigned char *)durq == 'l') {
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 10606 ""
- compage_1.hoffpt = -25.f;
-#line 10607 ""
- compage_1.voffpt = -45.f;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10606 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" o"\
+ "r \"-\" is allowed here!", (ftnlen)128, (
+ ftnlen)32);
#line 10608 ""
- } else if (*(unsigned char *)durq == '4') {
+ stop1_();
#line 10609 ""
- compage_1.ptheight = 745.f;
+ }
#line 10610 ""
- compage_1.widthpt = 499.f;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10611 ""
- compage_1.hoffpt = -24.f;
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
+ 0) {
#line 10612 ""
- compage_1.voffpt = -24.f;
-#line 10613 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10612 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for"\
+ " vert shift before \\eject must start here!",
+ (ftnlen)128, (ftnlen)54);
#line 10614 ""
- goto L27;
+ stop1_();
#line 10615 ""
- } else if (*(unsigned char *)durq == 'V') {
+ }
#line 10616 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 10617 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 10618 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10618 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\
- " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32)
- ;
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" o"\
+ "r \"-\" is allowed here!", (ftnlen)128, (
+ ftnlen)32);
#line 10620 ""
- stop1_();
+ stop1_();
#line 10621 ""
- }
+ }
#line 10622 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10623 ""
- if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+ if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) ==
+ 0) {
#line 10624 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10624 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\
- "t shift before \\eject must start here!", (ftnlen)
- 128, (ftnlen)54);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for"\
+ " vert shift after \\eject must start here!", (
+ ftnlen)128, (ftnlen)53);
#line 10626 ""
- stop1_();
+ stop1_();
#line 10627 ""
- }
+ }
#line 10628 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 10629 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
+ --a1ll_2.iccount;
#line 10630 ""
+ goto L27;
+#line 10631 ""
+ } else if (*(unsigned char *)durq != ' ') {
+#line 10632 ""
i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
a1ll_2.nbars + 1;
-#line 10630 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"+\" or"\
- " \"-\" is allowed here!", (ftnlen)128, (ftnlen)32)
- ;
#line 10632 ""
- stop1_();
-#line 10633 ""
- }
-#line 10634 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must"\
+ " follow one of abcdeiILNprRsSTvV!", (ftnlen)128, (
+ ftnlen)47);
+/* * 'After "A" must follow one of the letters abcdeiINprRsST!') */
+#line 10635 ""
+ s_wsle(&io___684);
+#line 10635 ""
+ do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only "\
+ "have noinst args.", (ftnlen)51);
#line 10635 ""
- if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
+ e_wsle();
#line 10636 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ s_wsfe(&io___685);
#line 10636 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number for ver"\
- "t shift after \\eject must start here!", (ftnlen)
- 128, (ftnlen)53);
+ do_fio(&c__1, "For AS, since ver. 2.7, must only have no"\
+ "inst args.", (ftnlen)51);
+#line 10636 ""
+ e_wsfe();
#line 10638 ""
stop1_();
#line 10639 ""
}
#line 10640 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 10641 ""
- --a1ll_2.iccount;
-#line 10642 ""
- goto L27;
-#line 10643 ""
- } else if (*(unsigned char *)durq != ' ') {
-#line 10644 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10644 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol"\
- "low one of abcdeiILNprRsSTvV!", (ftnlen)128, (ftnlen)
- 47);
-/* * 'After "A" must follow one of the letters abcdeiINprRsST!') */
-#line 10647 ""
- s_wsle(&io___684);
-#line 10647 ""
- do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have"\
- " noinst args.", (ftnlen)51);
-#line 10647 ""
- e_wsle();
-#line 10648 ""
- s_wsfe(&io___685);
-#line 10648 ""
- do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst"\
- " args.", (ftnlen)51);
-#line 10648 ""
- e_wsfe();
-#line 10650 ""
- stop1_();
-#line 10651 ""
- }
-#line 10652 ""
- } else if (*(unsigned char *)charq == 'K') {
+ } else if (*(unsigned char *)charq == 'K') {
/* Rules and function of K command */
@@ -25898,166 +25974,171 @@ L42:
/* then adjust fbar to make poenom much more accurate. */
/* Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. */
-#line 10663 ""
+#line 10651 ""
L77:
-#line 10664 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 10652 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
+ 1);
/* if (index('+-i',durq) .eq. 0) then */
-#line 10666 ""
- if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 10667 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10667 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or "\
- "key change) must be followed by \"+,-,i,n\"!", (
- ftnlen)128, (ftnlen)60);
-#line 10669 ""
- stop1_();
-#line 10670 ""
- }
-#line 10671 ""
- if (*(unsigned char *)durq == 'n') {
-#line 10671 ""
- goto L77;
-#line 10671 ""
- }
-#line 10672 ""
- if (*(unsigned char *)durq != 'i') {
+#line 10654 ""
+ if (i_indx("+-in", durq, (ftnlen)4, (ftnlen)1) == 0) {
+#line 10655 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10655 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose"\
+ " or key change) must be followed by \"+,-,i,n\"!",
+ (ftnlen)128, (ftnlen)60);
+#line 10657 ""
+ stop1_();
+#line 10658 ""
+ }
+#line 10659 ""
+ if (*(unsigned char *)durq == 'n') {
+#line 10659 ""
+ goto L77;
+#line 10659 ""
+ }
+#line 10660 ""
+ if (*(unsigned char *)durq != 'i') {
/* Normal key change and/or transposition) */
/* iccount = iccount+1 */
-#line 10677 ""
- num1 = 44 - *(unsigned char *)durq;
+#line 10665 ""
+ num1 = 44 - *(unsigned char *)durq;
/* num1= +1 or -1 */
+#line 10669 ""
+ ztrans = num1 == -1;
+#line 10670 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10671 ""
+ if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) ==
+ 0) {
+#line 10672 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10672 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must"\
+ " be followed by a number!", (ftnlen)128, (
+ ftnlen)37);
+#line 10674 ""
+ stop1_();
+#line 10675 ""
+ }
+/* iccount = iccount+1 */
+#line 10677 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
+#line 10678 ""
+ num1 = i_nint(&fnum) * num1;
+#line 10679 ""
+ ztrans = ztrans && num1 == 0;
+#line 10680 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 10681 ""
- ztrans = num1 == -1;
-#line 10682 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10681 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number a"\
+ "fter \"K\" must be followed by \"+,-\"!", (
+ ftnlen)128, (ftnlen)47);
#line 10683 ""
- if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 10684 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10684 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be "\
- "followed by a number!", (ftnlen)128, (ftnlen)37);
+ }
+#line 10685 ""
+ ++a1ll_2.iccount;
#line 10686 ""
- stop1_();
+ num2 = 44 - *(unsigned char *)durq;
#line 10687 ""
- }
-/* iccount = iccount+1 */
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
+#line 10688 ""
+ num2 *= (integer) (fnum + .1f);
#line 10689 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 10690 ""
- num1 = i_nint(&fnum) * num1;
-#line 10691 ""
- ztrans = ztrans && num1 == 0;
-#line 10692 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 10693 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ if (num1 == 0 && ! ztrans) {
+
+/* Key change, only one per block allowed */
+
#line 10693 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft"\
- "er \"K\" must be followed by \"+,-\"!", (ftnlen)
- 128, (ftnlen)47);
-#line 10695 ""
- stop1_();
+ if (comkeys_1.iskchb) {
+#line 10694 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10694 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one"\
+ " key change allowed per input block!", (
+ ftnlen)128, (ftnlen)44);
#line 10696 ""
- }
+ stop1_();
#line 10697 ""
- ++a1ll_2.iccount;
+ }
#line 10698 ""
- num2 = 44 - *(unsigned char *)durq;
+ comkeys_1.iskchb = TRUE_;
#line 10699 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ ++comkeys_1.nkeys;
#line 10700 ""
- num2 *= (integer) (fnum + .1f);
-#line 10701 ""
- if (num1 == 0 && ! ztrans) {
+ comkeys_1.kchmid[comkeys_1.nkeys - 1] =
+ a1ll_2.itsofar[c1ommvl_1.ivx - 1] %
+ a1ll_2.lenbar != 0;
-/* Key change, only one per block allowed */
+/* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */
+#line 10704 ""
+ comkeys_1.ibrkch[comkeys_1.nkeys - 1] =
+ c1omnotes_1.ibarcnt + a1ll_2.nbars;
#line 10705 ""
- if (comkeys_1.iskchb) {
-#line 10706 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) {
+#line 10705 ""
+ ++comkeys_1.ibrkch[comkeys_1.nkeys - 1];
+#line 10705 ""
+ }
#line 10706 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key"\
- " change allowed per input block!", (ftnlen)
- 128, (ftnlen)44);
-#line 10708 ""
- stop1_();
+ comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 +
+ comkeys_1.idsig;
+/* 130316 */
+/* do 43 iinst = 1 , noinst */
#line 10709 ""
- }
-#line 10710 ""
- comkeys_1.iskchb = TRUE_;
+ commidisig_1.midisig = comkeys_1.newkey[
+ comkeys_1.nkeys - 1];
+/* 43 continue */
#line 10711 ""
- ++comkeys_1.nkeys;
-#line 10712 ""
- comkeys_1.kchmid[comkeys_1.nkeys - 1] = a1ll_2.itsofar[
- c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0;
+ } else {
-/* Make ibrkch = barnum-1 if at start of bar, so fsyst advances ok at linebreak. */
+/* Transposition */
+#line 10715 ""
+ *fulltrans = TRUE_;
#line 10716 ""
- comkeys_1.ibrkch[comkeys_1.nkeys - 1] =
- c1omnotes_1.ibarcnt + a1ll_2.nbars;
+ if (c1omnotes_1.ibarcnt > 0) {
#line 10717 ""
- if (comkeys_1.kchmid[comkeys_1.nkeys - 1]) {
-#line 10717 ""
- ++comkeys_1.ibrkch[comkeys_1.nkeys - 1];
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10717 ""
- }
-#line 10718 ""
- comkeys_1.newkey[comkeys_1.nkeys - 1] = num2 +
- comkeys_1.idsig;
-/* 130316 */
-/* do 43 iinst = 1 , noinst */
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpos"\
+ "ition must be at top of first input bloc"\
+ "k!", (ftnlen)128, (ftnlen)50);
+#line 10719 ""
+ stop1_();
+#line 10720 ""
+ }
#line 10721 ""
- commidisig_1.midisig = comkeys_1.newkey[comkeys_1.nkeys -
- 1];
-/* 43 continue */
-#line 10723 ""
- } else {
-
-/* Transposition */
-
-#line 10727 ""
- *fulltrans = TRUE_;
-#line 10728 ""
- if (c1omnotes_1.ibarcnt > 0) {
-#line 10729 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10729 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio"\
- "n must be at top of first input block!", (
- ftnlen)128, (ftnlen)50);
-#line 10731 ""
- stop1_();
-#line 10732 ""
- }
-#line 10733 ""
- comkeys_1.isig1 = num2;
-#line 10734 ""
- comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[0];
+ comkeys_1.isig1 = num2;
+#line 10722 ""
+ comkeys_1.idsig = comkeys_1.isig1 - comkeys_1.newkey[
+ 0];
/* idsig is the difference between sig after transposition, and sig in setup. */
/* It may alter # of accid's in key changes if there is transposition. */
-#line 10739 ""
- }
-#line 10740 ""
- } else {
+#line 10727 ""
+ }
+#line 10728 ""
+ } else {
/* 110522/110529 */
/* Instrument-wise transposition Ki[iInstTrans][+/-][iTransAmt][+/-][iTransKey] */
@@ -26071,1212 +26152,1279 @@ L77:
/* each staff. */
/* durq='i' */
-#line 10753 ""
- getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, &
- a1ll_2.iccount, &c1omnotes_1.ibaroff, &a1ll_2.nbars, &
- comkeys_1.noinst, (ftnlen)128);
-#line 10755 ""
- }
-#line 10756 ""
- } else if (*(unsigned char *)charq == '|') {
+#line 10741 ""
+ getitransinfo_(&c_true, &c1omnotes_1.ibarcnt, lineq, &
+ a1ll_2.iccount, &c1omnotes_1.ibaroff, &
+ a1ll_2.nbars, &comkeys_1.noinst, (ftnlen)128);
+#line 10743 ""
+ }
+#line 10744 ""
+ } else if (*(unsigned char *)charq == '|') {
/* Optional bar symbol */
-#line 10760 ""
- if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
-#line 10761 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+#line 10748 ""
+ if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
+#line 10749 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10749 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker "\
+ "out of place!", (ftnlen)128, (ftnlen)29);
+#line 10751 ""
+ stop1_();
+#line 10752 ""
+ } else if (comkeys_1.shifton) {
+#line 10753 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10753 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with u"\
+ "ser-defined shift still on!", (ftnlen)128, (
+ ftnlen)43);
+#line 10755 ""
+ stop1_();
+#line 10756 ""
+ }
+#line 10757 ""
+ } else /* if(complicated condition) */ {
+#line 10757 ""
+ chax_(ch__2, (ftnlen)1, &c__47);
+#line 10757 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__2[0]) {
+#line 10758 ""
+ if (comkeys_1.ornrpt) {
+#line 10759 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10759 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Blo"\
+ "ck ended with repeated ornament still on!", (
+ ftnlen)128, (ftnlen)53);
#line 10761 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out "\
- "of place!", (ftnlen)128, (ftnlen)29);
+ comkeys_1.ornrpt = FALSE_;
+#line 10762 ""
+ }
#line 10763 ""
- stop1_();
+ if (comkeys_1.stickys) {
#line 10764 ""
- } else if (comkeys_1.shifton) {
-#line 10765 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10765 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
- "defined shift still on!", (ftnlen)128, (ftnlen)43);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10764 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Blo"\
+ "ck ended with sticky stemshrink still on!", (
+ ftnlen)128, (ftnlen)53);
+#line 10766 ""
+ comkeys_1.stickys = FALSE_;
#line 10767 ""
- stop1_();
+ }
#line 10768 ""
- }
+ if (c1omget_1.fbon) {
#line 10769 ""
- } else if (*(unsigned char *)charq == '/') {
-#line 10770 ""
- if (comkeys_1.ornrpt) {
-#line 10771 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10769 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended "\
+ "with forced beam open!", (ftnlen)128, (ftnlen)
+ 34);
#line 10771 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\
- " with repeated ornament still on!", (ftnlen)128, (
- ftnlen)53);
+ stop1_();
+#line 10772 ""
+ } else if (comkeys_1.shifton) {
#line 10773 ""
- comkeys_1.ornrpt = FALSE_;
-#line 10774 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10773 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended wi"\
+ "th user-defined shift still on!", (ftnlen)128,
+ (ftnlen)43);
#line 10775 ""
- if (comkeys_1.stickys) {
-#line 10776 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10776 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended"\
- " with sticky stemshrink still on!", (ftnlen)128, (
- ftnlen)53);
-#line 10778 ""
- comkeys_1.stickys = FALSE_;
-#line 10779 ""
- }
-#line 10780 ""
- if (c1omget_1.fbon) {
-#line 10781 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
+#line 10777 ""
+ comkeys_1.barend = FALSE_;
+
+/* Perform time checks */
+
#line 10781 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for"\
- "ced beam open!", (ftnlen)128, (ftnlen)34);
-#line 10783 ""
- stop1_();
+ if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar !=
+ 0) {
+#line 10782 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10782 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block durati"\
+ "on not divisible by lenbar!", (ftnlen)128, (
+ ftnlen)39);
#line 10784 ""
- } else if (comkeys_1.shifton) {
-#line 10785 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ s_wsle(&io___689);
+#line 10784 ""
+ do_lio(&c__9, &c__1, "lenbar, timesofar are ", (
+ ftnlen)22);
+#line 10784 ""
+ do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)
+ sizeof(integer));
+#line 10784 ""
+ do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[
+ c1ommvl_1.ivx - 1], (ftnlen)sizeof(integer));
+#line 10784 ""
+ e_wsle();
#line 10785 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\
- "defined shift still on!", (ftnlen)128, (ftnlen)43);
+ stop1_();
+#line 10786 ""
+ } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[
+ c1ommvl_1.ivx - 1] != a1ll_2.itsofar[0]) {
#line 10787 ""
- stop1_();
-
-/* 140215 Temporary to allow clef change in stup */
-
-/* else if (gotclef) then */
-/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
-/* * 'May not enter clef at end of input block!') */
-/* call stop1() */
+ s_wsle(&io___690);
+#line 10787 ""
+ e_wsle();
+#line 10788 ""
+ s_wsle(&io___691);
+#line 10788 ""
+ do_lio(&c__9, &c__1, "No of bars in voice 1, current"\
+ " voice:", (ftnlen)37);
+#line 10788 ""
+ i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar;
+#line 10788 ""
+ do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(
+ integer));
+#line 10788 ""
+ i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] /
+ a1ll_2.lenbar;
+#line 10788 ""
+ do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(
+ integer));
+#line 10788 ""
+ e_wsle();
+#line 10790 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10790 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block durati"\
+ "on not equal to voice 1!", (ftnlen)128, (
+ ftnlen)36);
+#line 10792 ""
+ stop1_();
+#line 10793 ""
+ }
+#line 10794 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10795 ""
- }
-#line 10796 ""
- comkeys_1.barend = FALSE_;
+ if (*(unsigned char *)durq == ' ' && a1ll_2.iv ==
+ a1ll_2.nv) {
-/* Perform time checks */
+/* End of input block */
+#line 10799 ""
+ *loop = FALSE_;
#line 10800 ""
- if (a1ll_2.itsofar[c1ommvl_1.ivx - 1] % a1ll_2.lenbar != 0) {
-#line 10801 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10801 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\
- "ivisible by lenbar!", (ftnlen)128, (ftnlen)39);
-#line 10803 ""
- s_wsle(&io___689);
-#line 10803 ""
- do_lio(&c__9, &c__1, "lenbar, timesofar are ", (ftnlen)22);
-#line 10803 ""
- do_lio(&c__3, &c__1, (char *)&a1ll_2.lenbar, (ftnlen)sizeof(
- integer));
-#line 10803 ""
- do_lio(&c__3, &c__1, (char *)&a1ll_2.itsofar[c1ommvl_1.ivx -
- 1], (ftnlen)sizeof(integer));
-#line 10803 ""
- e_wsle();
+ } else {
+
+/* Start a new voice */
+
#line 10804 ""
- stop1_();
+ if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) {
+#line 10804 ""
+ a1ll_2.lenbar = a1ll_2.lenbr0;
+#line 10804 ""
+ }
#line 10805 ""
- } else if (c1ommvl_1.ivx > 1 && a1ll_2.itsofar[c1ommvl_1.ivx - 1]
- != a1ll_2.itsofar[0]) {
-#line 10806 ""
- s_wsle(&io___690);
+ a1ll_2.nbars = 0;
#line 10806 ""
- e_wsle();
-#line 10807 ""
- s_wsle(&io___691);
-#line 10807 ""
- do_lio(&c__9, &c__1, "No of bars in voice 1, current voice:",
- (ftnlen)37);
-#line 10807 ""
- i__1 = a1ll_2.itsofar[0] / a1ll_2.lenbar;
-#line 10807 ""
- do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 10807 ""
- i__4 = a1ll_2.itsofar[c1ommvl_1.ivx - 1] / a1ll_2.lenbar;
-#line 10807 ""
- do_lio(&c__3, &c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 10807 ""
- e_wsle();
-#line 10809 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10809 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e"\
- "qual to voice 1!", (ftnlen)128, (ftnlen)36);
+ if (*(unsigned char *)durq == ' ') {
+
+/* New voice is on next staff */
+
+#line 10810 ""
+ ++a1ll_2.iv;
#line 10811 ""
- stop1_();
+ c1ommvl_1.ivx = a1ll_2.iv;
#line 10812 ""
- }
-#line 10813 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 10814 ""
- if (*(unsigned char *)durq == ' ' && a1ll_2.iv == a1ll_2.nv) {
+ } else {
-/* End of input block */
+/* New voice is on same staff. Set up for it */
+#line 10816 ""
+ c1ommvl_1.ivx = a1ll_2.nv + 1;
+#line 10817 ""
+ i__1 = a1ll_2.nv;
+#line 10817 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
#line 10818 ""
- *loop = FALSE_;
+ if (c1ommvl_1.nvmx[iiv - 1] == 2) {
+#line 10818 ""
+ ++c1ommvl_1.ivx;
+#line 10818 ""
+ }
#line 10819 ""
- } else {
-
-/* Start a new voice */
-
-#line 10823 ""
- if (a1ll_2.lenbr0 != 0 && a1ll_2.firstline) {
-#line 10823 ""
- a1ll_2.lenbar = a1ll_2.lenbr0;
+/* L23: */
+#line 10819 ""
+ }
+#line 10820 ""
+ if (c1ommvl_1.ivx > 24) {
+#line 10821 ""
+ s_wsfe(&io___692);
+#line 10821 ""
+ do_fio(&c__1, "Cannot have more than", (
+ ftnlen)21);
+#line 10821 ""
+ do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(
+ integer));
+#line 10821 ""
+ do_fio(&c__1, " lines of music at once", (
+ ftnlen)23);
+#line 10821 ""
+ e_wsfe();
#line 10823 ""
- }
+ stop1_();
#line 10824 ""
- a1ll_2.nbars = 0;
+ }
#line 10825 ""
- if (*(unsigned char *)durq == ' ') {
-
-/* New voice is on next staff */
-
+ c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2;
+#line 10826 ""
+ c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx;
+#line 10827 ""
+ a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
+#line 10828 ""
+ a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0;
#line 10829 ""
- ++a1ll_2.iv;
+ for (j = 1; j <= 200; ++j) {
#line 10830 ""
- c1ommvl_1.ivx = a1ll_2.iv;
+ a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] =
+ FALSE_;
#line 10831 ""
- } else {
+ c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] =
+ 0;
+#line 10832 ""
+/* L24: */
+#line 10832 ""
+ }
-/* New voice is on same staff. Set up for it */
+/* For midi stuff, record that there is a 2nd line of music in this voice */
-#line 10835 ""
- c1ommvl_1.ivx = a1ll_2.nv + 1;
#line 10836 ""
- i__1 = a1ll_2.nv;
+ if (commidi_1.ismidi) {
#line 10836 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
-#line 10837 ""
- if (c1ommvl_1.nvmx[iiv - 1] == 2) {
-#line 10837 ""
- ++c1ommvl_1.ivx;
+ commidi_1.twoline[a1ll_2.iv - 1] = TRUE_;
+#line 10836 ""
+ }
#line 10837 ""
}
#line 10838 ""
-/* L23: */
-#line 10838 ""
}
#line 10839 ""
- if (c1ommvl_1.ivx > 24) {
-#line 10840 ""
- s_wsfe(&io___692);
-#line 10840 ""
- do_fio(&c__1, "Cannot have more than", (ftnlen)21);
-#line 10840 ""
- do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer))
- ;
-#line 10840 ""
- do_fio(&c__1, " lines of music at once", (ftnlen)23);
+ a1ll_2.iccount = 128;
#line 10840 ""
- e_wsfe();
-#line 10842 ""
- stop1_();
-#line 10843 ""
- }
+ } else if (*(unsigned char *)charq == 'S') {
+
+/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */
+
#line 10844 ""
- c1ommvl_1.nvmx[a1ll_2.iv - 1] = 2;
+ if (c1omnotes_1.ibarcnt > 0) {
#line 10845 ""
- c1ommvl_1.ivmx[a1ll_2.iv + 23] = c1ommvl_1.ivx;
-#line 10846 ""
- a1ll_2.itsofar[c1ommvl_1.ivx - 1] = 0;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10845 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can on"\
+ "ly be in first input block!", (ftnlen)128, (
+ ftnlen)37);
#line 10847 ""
- a1ll_2.nnl[c1ommvl_1.ivx - 1] = 0;
+ stop1_();
#line 10848 ""
- for (j = 1; j <= 200; ++j) {
+ }
#line 10849 ""
- a1ll_2.rest[c1ommvl_1.ivx + j * 24 - 25] = FALSE_;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10850 ""
- c1ommvl_1.nacc[c1ommvl_1.ivx + j * 24 - 25] = 0;
+ if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) ==
+ 0) {
#line 10851 ""
-/* L24: */
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 10851 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must"\
+ " follow \"S\"!", (ftnlen)128, (ftnlen)24);
+#line 10853 ""
+ stop1_();
+#line 10854 ""
}
-
-/* For midi stuff, record that there is a 2nd line of music in this voice */
-
#line 10855 ""
- if (commidi_1.ismidi) {
-#line 10855 ""
- commidi_1.twoline[a1ll_2.iv - 1] = TRUE_;
-#line 10855 ""
- }
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)
+ 128, (ftnlen)1);
#line 10856 ""
- }
+ compage_1.nsyst = i_nint(&fnsyst);
#line 10857 ""
- }
+L14:
#line 10858 ""
- a1ll_2.iccount = 128;
-#line 10859 ""
- } else if (*(unsigned char *)charq == 'S') {
+ if (*(unsigned char *)durq == 'P') {
-/* New nsyst: for use with partmaker scor2prt, for parts w/ diff # of systs. */
+/* New npages for parts. */
+#line 10862 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10863 ""
- if (c1omnotes_1.ibarcnt > 0) {
+ if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1)
+ == 0) {
#line 10864 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10864 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in"\
- " first input block!", (ftnlen)128, (ftnlen)37);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must hav"\
+ "e a number here!", (ftnlen)128, (ftnlen)
+ 24);
#line 10866 ""
- stop1_();
+ stop1_();
#line 10867 ""
- }
+ }
#line 10868 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (
+ ftnlen)128, (ftnlen)1);
#line 10869 ""
- if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 10870 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ compage_1.npages = i_nint(&fnsyst);
#line 10870 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow"\
- " \"S\"!", (ftnlen)128, (ftnlen)24);
-#line 10872 ""
- stop1_();
-#line 10873 ""
- }
-#line 10874 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
- ftnlen)1);
+ goto L14;
+#line 10871 ""
+ } else if (*(unsigned char *)durq == 'm') {
+
+/* Reset musize (musicsize). */
+
#line 10875 ""
- compage_1.nsyst = i_nint(&fnsyst);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10876 ""
-L14:
+ if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1)
+ == 0) {
#line 10877 ""
- if (*(unsigned char *)durq == 'P') {
-
-/* New npages for parts. */
-
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10877 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must hav"\
+ "e a number here!", (ftnlen)128, (ftnlen)
+ 24);
+#line 10879 ""
+ stop1_();
+#line 10880 ""
+ }
#line 10881 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (
+ ftnlen)128, (ftnlen)1);
#line 10882 ""
- if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
+ commus_1.musize = i_nint(&fnsyst);
#line 10883 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10883 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\
- "er here!", (ftnlen)128, (ftnlen)24);
+ c1omnotes_1.wheadpt = commus_1.whead20 *
+ commus_1.musize;
+#line 10884 ""
+ goto L14;
#line 10885 ""
- stop1_();
+ } else if (*(unsigned char *)durq != ' ') {
#line 10886 ""
- }
-#line 10887 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
- ftnlen)1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10886 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter in \"S\" symbol!", (ftnlen)128, (ftnlen)
+ 32);
#line 10888 ""
- compage_1.npages = i_nint(&fnsyst);
+ stop1_();
#line 10889 ""
- goto L14;
+ }
#line 10890 ""
- } else if (*(unsigned char *)durq == 'm') {
+ } else if (*(unsigned char *)charq == 'L') {
-/* Reset musize (musicsize). */
+/* Force line break */
#line 10894 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10895 ""
- if (i_indx("123456789 ", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 10896 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10896 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb"\
- "er here!", (ftnlen)128, (ftnlen)24);
-#line 10898 ""
- stop1_();
+ if (*(unsigned char *)durq == 'C') {
+
+/* Coda, no real line break, just get coda length */
+
#line 10899 ""
- }
+ if (comshort_1.ishort != 1) {
#line 10900 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnsyst, (ftnlen)128, (
- ftnlen)1);
-#line 10901 ""
- commus_1.musize = i_nint(&fnsyst);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10900 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot u"\
+ "se \"LC\" without first using \"L[n]S\"!",
+ (ftnlen)128, (ftnlen)44);
#line 10902 ""
- c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
+ stop1_();
#line 10903 ""
- goto L14;
+ }
#line 10904 ""
- } else if (*(unsigned char *)durq != ' ') {
-#line 10905 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ comshort_1.ishort = 0;
#line 10905 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character "\
- "in \"S\" symbol!", (ftnlen)128, (ftnlen)32);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10906 ""
+ if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1)
+ == 0) {
#line 10907 ""
- stop1_();
-#line 10908 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10907 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need num"\
+ "ber to define coda length!", (ftnlen)128,
+ (ftnlen)34);
#line 10909 ""
- } else if (*(unsigned char *)charq == 'L') {
-
-/* Force line break */
-
+ stop1_();
+#line 10910 ""
+ }
+#line 10911 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &
+ comshort_1.codafrac, (ftnlen)128, (ftnlen)1);
+#line 10912 ""
+ comshort_1.poefa[compage_1.isysflb[compage_1.nflb] -
+ 1] += comshort_1.codafrac;
#line 10913 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (i_indx(" n", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 10914 ""
- if (*(unsigned char *)durq == 'C') {
-
-/* Coda, no real line break, just get coda length */
-
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10914 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need bla"\
+ "nk or \"n\" here!", (ftnlen)128, (ftnlen)
+ 23);
+#line 10916 ""
+ stop1_();
+#line 10917 ""
+ }
#line 10918 ""
- if (comshort_1.ishort != 1) {
+ return 0;
#line 10919 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10919 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"L"\
- "C\" without first using \"L[n]S\"!", (ftnlen)128,
- (ftnlen)44);
+ }
+#line 10920 ""
+ ++compage_1.nflb;
#line 10921 ""
- stop1_();
+ compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt +
+ a1ll_2.nbars + 1;
#line 10922 ""
- }
+ if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
+ {
#line 10923 ""
- comshort_1.ishort = 0;
-#line 10924 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10923 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer"\
+ " to define forced line break!", (ftnlen)128, (
+ ftnlen)41);
#line 10925 ""
- if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 10926 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10926 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need number to d"\
- "efine coda length!", (ftnlen)128, (ftnlen)34);
+ }
+#line 10927 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)
+ 128, (ftnlen)1);
#line 10928 ""
- stop1_();
+ compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb);
#line 10929 ""
- }
+ if (compage_1.isysflb[compage_1.nflb] == 1) {
#line 10930 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &comshort_1.codafrac, (
- ftnlen)128, (ftnlen)1);
-#line 10931 ""
- comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - 1] +=
- comshort_1.codafrac;
+ i__1 = a1ll_2.iccount - 1;
+#line 10930 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10930 ""
+ errmsg_(lineq, &i__1, &i__4, "For now, \"L1\" not al"\
+ "lowed!", (ftnlen)128, (ftnlen)26);
#line 10932 ""
- if (i_indx(" n", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 10933 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10933 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need blank or"\
- " \"n\" here!", (ftnlen)128, (ftnlen)23);
-#line 10935 ""
- stop1_();
-#line 10936 ""
- }
-#line 10937 ""
- return 0;
+ }
+#line 10934 ""
+ if (compage_1.nflb > 1) {
+
+/* Check if new number is > prior one */
+
#line 10938 ""
- }
+ if (compage_1.isysflb[compage_1.nflb] <=
+ compage_1.isysflb[compage_1.nflb - 1]) {
+#line 10939 ""
+ i__1 = a1ll_2.iccount - 1;
+#line 10939 ""
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10939 ""
- ++compage_1.nflb;
-#line 10940 ""
- compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt +
- a1ll_2.nbars + 1;
+ errmsg_(lineq, &i__1, &i__4, "You already forced"\
+ " a line break at a later line!", (ftnlen)
+ 128, (ftnlen)48);
#line 10941 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 10942 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10942 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi"\
- "ne forced line break!", (ftnlen)128, (ftnlen)41);
+ }
+#line 10943 ""
+ }
#line 10944 ""
- stop1_();
+ if (compage_1.npages == 0) {
#line 10945 ""
- }
+ s_wsle(&io___696);
+#line 10945 ""
+ e_wsle();
#line 10946 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &sysflb, (ftnlen)128, (
- ftnlen)1);
-#line 10947 ""
- compage_1.isysflb[compage_1.nflb] = i_nint(&sysflb);
-#line 10948 ""
- if (compage_1.isysflb[compage_1.nflb] == 1) {
-#line 10949 ""
- i__1 = a1ll_2.iccount - 1;
-#line 10949 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 10949 ""
- errmsg_(lineq, &i__1, &i__4, "For now, \"L1\" not allowed!", (
- ftnlen)128, (ftnlen)26);
+ s_wsle(&io___697);
+#line 10946 ""
+ do_lio(&c__9, &c__1, "WARNING! You forced a line bre"\
+ "ak at line ", (ftnlen)41);
+#line 10946 ""
+ do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[
+ compage_1.nflb], (ftnlen)sizeof(integer));
+#line 10946 ""
+ do_lio(&c__9, &c__1, " but npage = 0. Continue?", (
+ ftnlen)26);
+#line 10946 ""
+ e_wsle();
+/* read(*,'(a)') charq */
+/* if (index('yY',charq) .eq. 0) call stop1() */
+#line 10950 ""
+ } else if (compage_1.isysflb[compage_1.nflb] >
+ compage_1.nsyst) {
#line 10951 ""
- stop1_();
-#line 10952 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10951 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line "\
+ "break at line num > nsyst!", (ftnlen)128, (
+ ftnlen)38);
#line 10953 ""
- if (compage_1.nflb > 1) {
-
-/* Check if new number is > prior one */
-
+ stop1_();
+#line 10954 ""
+ } else if (i_indx(" PMS", durq, (ftnlen)4, (ftnlen)1) ==
+ 0) {
+#line 10955 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 10955 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\
+ " \" \", \"P\", \"M\", or \"S\" here!", (
+ ftnlen)128, (ftnlen)37);
#line 10957 ""
- if (compage_1.isysflb[compage_1.nflb] <= compage_1.isysflb[
- compage_1.nflb - 1]) {
-#line 10958 ""
- i__1 = a1ll_2.iccount - 1;
-#line 10958 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10958 ""
- errmsg_(lineq, &i__1, &i__4, "You already forced a line "\
- "break at a later line!", (ftnlen)128, (ftnlen)48);
+ }
+#line 10959 ""
+L49:
+/* Transfer up from below to allow S after M */
#line 10960 ""
- stop1_();
-#line 10961 ""
- }
-#line 10962 ""
- }
-#line 10963 ""
- if (compage_1.npages == 0) {
-#line 10964 ""
- s_wsle(&io___696);
+ if (*(unsigned char *)durq == 'S') {
+
+/* Shortened line, get shortening fraction */
+
#line 10964 ""
- e_wsle();
+ comshort_1.ishort = 1;
#line 10965 ""
- s_wsle(&io___697);
-#line 10965 ""
- do_lio(&c__9, &c__1, "WARNING! You forced a line break at li"\
- "ne ", (ftnlen)41);
-#line 10965 ""
- do_lio(&c__3, &c__1, (char *)&compage_1.isysflb[
- compage_1.nflb], (ftnlen)sizeof(integer));
-#line 10965 ""
- do_lio(&c__9, &c__1, " but npage = 0. Continue?", (ftnlen)26)
- ;
-#line 10965 ""
- e_wsle();
-#line 10967 ""
- s_rsfe(&io___698);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 10966 ""
+ if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1)
+ == 0) {
#line 10967 ""
- do_fio(&c__1, charq, (ftnlen)1);
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10967 ""
- e_rsfe();
-#line 10968 ""
- if (i_indx("yY", charq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 10968 ""
- stop1_();
-#line 10968 ""
- }
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need num"\
+ "ber to define line shortening fraction!",
+ (ftnlen)128, (ftnlen)47);
#line 10969 ""
- } else if (compage_1.isysflb[compage_1.nflb] > compage_1.nsyst) {
-#line 10970 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ stop1_();
#line 10970 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at"\
- " line num > nsyst!", (ftnlen)128, (ftnlen)38);
+ }
+#line 10971 ""
+ readnum_(lineq, &a1ll_2.iccount, durq, &
+ comshort_1.shortfrac, (ftnlen)128, (ftnlen)1);
#line 10972 ""
- stop1_();
+ comshort_1.poefa[compage_1.isysflb[compage_1.nflb] -
+ 1] = comshort_1.shortfrac;
#line 10973 ""
- } else if (i_indx(" PMS", durq, (ftnlen)4, (ftnlen)1) == 0) {
+ if (*(unsigned char *)durq != ' ') {
#line 10974 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
#line 10974 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \""\
- "P\", \"M\", or \"S\" here!", (ftnlen)128, (ftnlen)37);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need bla"\
+ "nk here!", (ftnlen)128, (ftnlen)16);
#line 10976 ""
- stop1_();
+ }
#line 10977 ""
- }
+ }
#line 10978 ""
-L49:
-/* Transfer up from below to allow S after M */
-#line 10979 ""
- if (*(unsigned char *)durq == 'S') {
+ if (*(unsigned char *)durq == 'P') {
-/* Shortened line, get shortening fraction */
+/* Forced page break here, get page number. */
+#line 10982 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 10983 ""
- comshort_1.ishort = 1;
+ if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) ==
+ 0) {
#line 10984 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
-#line 10985 ""
- if (i_indx("1234567890.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 10986 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10984 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need int"\
+ "eger to define forced page break!", (
+ ftnlen)128, (ftnlen)41);
#line 10986 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need number to d"\
- "efine line shortening fraction!", (ftnlen)128, (
- ftnlen)47);
+ stop1_();
+#line 10987 ""
+ }
#line 10988 ""
- stop1_();
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)
+ 128, (ftnlen)1);
#line 10989 ""
- }
+ ++compage_1.nfpb;
#line 10990 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &comshort_1.shortfrac,
- (ftnlen)128, (ftnlen)1);
+ compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum);
#line 10991 ""
- comshort_1.poefa[compage_1.isysflb[compage_1.nflb] - 1] =
- comshort_1.shortfrac;
+ compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[
+ compage_1.nflb];
#line 10992 ""
- if (*(unsigned char *)durq != ' ') {
+ if (compage_1.ipagfpb[compage_1.nfpb] >
+ compage_1.npages) {
#line 10993 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__1 = a1ll_2.iccount - 1;
#line 10993 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need blank here!",
- (ftnlen)128, (ftnlen)16);
+ i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 10993 ""
+ errmsg_(lineq, &i__1, &i__4, "Forced page break "\
+ "at page num > npages!", (ftnlen)128, (
+ ftnlen)39);
#line 10995 ""
- }
+ stop1_();
#line 10996 ""
- }
+ } else if (compage_1.nfpb > 1) {
#line 10997 ""
- if (*(unsigned char *)durq == 'P') {
-
-/* Forced page break here, get page number. */
-
+ if (compage_1.ipagfpb[compage_1.nfpb] <=
+ compage_1.ipagfpb[compage_1.nfpb - 1]) {
+#line 10998 ""
+ i__1 = a1ll_2.iccount - 1;
+#line 10998 ""
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 10998 ""
+ errmsg_(lineq, &i__1, &i__4, "Forced page br"\
+ "eak numbers must increase!", (ftnlen)
+ 128, (ftnlen)40);
+#line 11000 ""
+ stop1_();
#line 11001 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
+ }
#line 11002 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 11003 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 11003 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to "\
- "define forced page break!", (ftnlen)128, (ftnlen)
- 41);
+ }
+#line 11004 ""
+ if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) {
#line 11005 ""
- stop1_();
-#line 11006 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 11005 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal char"\
+ "acter in linebreak symbol!", (ftnlen)128, (
+ ftnlen)38);
#line 11007 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ stop1_();
#line 11008 ""
- ++compage_1.nfpb;
+ } else if (*(unsigned char *)durq == 'M') {
#line 11009 ""
- compage_1.ipagfpb[compage_1.nfpb] = i_nint(&fnum);
+ ++compage_1.nmovbrk;
#line 11010 ""
- compage_1.isysfpb[compage_1.nfpb] = compage_1.isysflb[
- compage_1.nflb];
+ compage_1.isysmb[compage_1.nmovbrk] =
+ compage_1.isysflb[compage_1.nflb];
#line 11011 ""
- if (compage_1.ipagfpb[compage_1.nfpb] > compage_1.npages) {
-#line 11012 ""
- i__1 = a1ll_2.iccount - 1;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 11012 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+L31:
#line 11012 ""
- errmsg_(lineq, &i__1, &i__4, "Forced page break at page "\
- "num > npages!", (ftnlen)128, (ftnlen)39);
-#line 11014 ""
- stop1_();
-#line 11015 ""
- } else if (compage_1.nfpb > 1) {
+ if (*(unsigned char *)durq == '+') {
+
+/* Vertical spacing, read past number. */
+
#line 11016 ""
- if (compage_1.ipagfpb[compage_1.nfpb] <=
- compage_1.ipagfpb[compage_1.nfpb - 1]) {
-#line 11017 ""
- i__1 = a1ll_2.iccount - 1;
-#line 11017 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 11017 ""
- errmsg_(lineq, &i__1, &i__4, "Forced page break numb"\
- "ers must increase!", (ftnlen)128, (ftnlen)40);
-#line 11019 ""
- stop1_();
+ if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)
+ 1) == 0) {
+#line 11018 ""
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 11018 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Inte"\
+ "ger required here!", (ftnlen)128, (
+ ftnlen)22);
#line 11020 ""
- }
+ stop1_();
#line 11021 ""
- }
+ }
#line 11022 ""
- }
+ readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (
+ ftnlen)128, (ftnlen)1);
#line 11023 ""
- if (i_indx(" M", durq, (ftnlen)2, (ftnlen)1) == 0) {
+ goto L31;
#line 11024 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 11024 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in"\
- " linebreak symbol!", (ftnlen)128, (ftnlen)38);
-#line 11026 ""
- stop1_();
-#line 11027 ""
- } else if (*(unsigned char *)durq == 'M') {
+ } else if (*(unsigned char *)durq == 'i') {
+
+/* Change indentation, */
+
#line 11028 ""
- ++compage_1.nmovbrk;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 11029 ""
- compage_1.isysmb[compage_1.nmovbrk] = compage_1.isysflb[
- compage_1.nflb];
+ if (i_indx(".123456789", durq, (ftnlen)10, (
+ ftnlen)1) == 0) {
#line 11030 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (ftnlen)
- 1);
-#line 11031 ""
-L31:
-#line 11031 ""
- if (*(unsigned char *)durq == '+') {
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 11030 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Deci"\
+ "mal number required here!", (ftnlen)
+ 128, (ftnlen)29);
+#line 11032 ""
+ stop1_();
+#line 11033 ""
+ }
-/* Vertical spacing, read past number. */
+/* fracsys was initialized in block data to all 0.'s */
-#line 11035 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 11036 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0)
- {
-#line 11037 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
#line 11037 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ"\
- "ired here!", (ftnlen)128, (ftnlen)22);
+ readnum_(lineq, &a1ll_2.iccount, durq, &
+ compage_1.fracsys[compage_1.nmovbrk - 1],
+ (ftnlen)128, (ftnlen)1);
+#line 11038 ""
+ goto L31;
#line 11039 ""
- stop1_();
+ } else if (*(unsigned char *)durq == 'c') {
#line 11040 ""
- }
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 11041 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &fnum, (ftnlen)128,
- (ftnlen)1);
+ goto L31;
#line 11042 ""
- goto L31;
+ } else if (*(unsigned char *)durq == 'r') {
#line 11043 ""
- } else if (*(unsigned char *)durq == 'i') {
-
-/* Change indentation, */
-
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
+#line 11044 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0)
+ {
+#line 11045 ""
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
+#line 11045 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must"\
+ " have \"+\" or \"-\" after \"r\" as "\
+ "movement break option!", (ftnlen)128,
+ (ftnlen)56);
#line 11047 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ stop1_();
#line 11048 ""
- if (i_indx(".123456789", durq, (ftnlen)10, (ftnlen)1) ==
- 0) {
-#line 11049 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ }
#line 11049 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb"\
- "er required here!", (ftnlen)128, (ftnlen)29);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
+#line 11050 ""
+ goto L31;
#line 11051 ""
- stop1_();
-#line 11052 ""
- }
+ } else if (*(unsigned char *)durq == 'n') {
-/* fracsys was initialized in block data to all 0.'s */
+/* Change # of voices. Input ninow, iorig(1...ninow). Will use names, */
+/* staves per inst. and clefs corr. to iorig in original list of instruments. */
#line 11056 ""
- readnum_(lineq, &a1ll_2.iccount, durq, &compage_1.fracsys[
- compage_1.nmovbrk - 1], (ftnlen)128, (ftnlen)1);
+ a1ll_2.nv = 0;
#line 11057 ""
- goto L31;
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 11058 ""
- } else if (*(unsigned char *)durq == 'c') {
-#line 11059 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 11060 ""
- goto L31;
-#line 11061 ""
- } else if (*(unsigned char *)durq == 'r') {
+ if (*(unsigned char *)durq == ':') {
+
+/* Signals a 2-digit number, get next two characters */
+
#line 11062 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (
+ ftnlen)128, (ftnlen)1);
#line 11063 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 11064 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (
+ ftnlen)128, (ftnlen)1);
#line 11064 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have"\
- " \"+\" or \"-\" after \"r\" as movement brea"\
- "k option!", (ftnlen)128, (ftnlen)56);
+ if (i_indx("12", durq, (ftnlen)2, (ftnlen)1)
+ == 0 || i_indx("0123456789", dumq, (
+ ftnlen)10, (ftnlen)1) == 0) {
#line 11066 ""
- stop1_();
-#line 11067 ""
- }
-#line 11068 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+/* Writing concatenation */
+#line 11066 ""
+ i__8[0] = 34, a__3[0] = "Illegal new num"\
+ "ber of instruments ";
+#line 11066 ""
+ i__8[1] = 1, a__3[1] = durq;
+#line 11066 ""
+ i__8[2] = 1, a__3[2] = dumq;
+#line 11066 ""
+ i__8[3] = 19, a__3[3] = " at movement br"\
+ "eak!";
+#line 11066 ""
+ s_cat(ch__5, a__3, i__8, &c__4, (ftnlen)
+ 55);
+#line 11066 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1,
+ ch__5, (ftnlen)128, (ftnlen)55);
#line 11069 ""
- goto L31;
+ stop1_();
#line 11070 ""
- } else if (*(unsigned char *)durq == 'n') {
+ }
+#line 11071 ""
+ i__1 = a1ll_2.iccount - 2;
+#line 11071 ""
+ ici__1.icierr = 0;
+#line 11071 ""
+ ici__1.iciend = 0;
+#line 11071 ""
+ ici__1.icirnum = 1;
+#line 11071 ""
+ ici__1.icirlen = a1ll_2.iccount - i__1;
+#line 11071 ""
+ ici__1.iciunit = lineq + i__1;
+#line 11071 ""
+ ici__1.icifmt = "(i2)";
+#line 11071 ""
+ s_rsfi(&ici__1);
+#line 11071 ""
+ do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(
+ integer));
+#line 11071 ""
+ e_rsfi();
+#line 11072 ""
+ } else {
-/* Change # of voices. Input ninow, iorig(1...ninow). Will use names, */
-/* staves per inst. and clefs corr. to iorig in original list of instruments. */
+/* durq is a single digit number for noinow */
-#line 11075 ""
- a1ll_2.nv = 0;
#line 11076 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ if (i_indx("123456789", durq, (ftnlen)9, (
+ ftnlen)1) == 0) {
#line 11077 ""
- if (*(unsigned char *)durq == ':') {
-
-/* Signals a 2-digit number, get next two characters */
-
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+/* Writing concatenation */
+#line 11077 ""
+ i__2[0] = 34, a__1[0] = "Illegal new num"\
+ "ber of instruments ";
+#line 11077 ""
+ i__2[1] = 1, a__1[1] = durq;
+#line 11077 ""
+ i__2[2] = 19, a__1[2] = " at movement br"\
+ "eak!";
+#line 11077 ""
+ s_cat(ch__6, a__1, i__2, &c__3, (ftnlen)
+ 54);
+#line 11077 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1,
+ ch__6, (ftnlen)128, (ftnlen)54);
+#line 11080 ""
+ stop1_();
#line 11081 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ }
#line 11082 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)128, (
- ftnlen)1);
+ ninow = *(unsigned char *)durq - 48;
#line 11083 ""
- if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0 ||
- i_indx("0123456789", dumq, (ftnlen)10, (
- ftnlen)1) == 0) {
-#line 11085 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
-/* Writing concatenation */
-#line 11085 ""
- i__8[0] = 34, a__3[0] = "Illegal new number of i"\
- "nstruments ";
-#line 11085 ""
- i__8[1] = 1, a__3[1] = durq;
-#line 11085 ""
- i__8[2] = 1, a__3[2] = dumq;
-#line 11085 ""
- i__8[3] = 19, a__3[3] = " at movement break!";
+ }
+#line 11084 ""
+ if (ninow > comkeys_1.noinst) {
#line 11085 ""
- s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55);
+ i__1 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff + a1ll_2.nbars +
+ 1;
#line 11085 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__4, (
- ftnlen)128, (ftnlen)55);
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "New "\
+ "number of instruments must be <= ori"\
+ "ginal!", (ftnlen)128, (ftnlen)46);
+#line 11087 ""
+ stop1_();
#line 11088 ""
- stop1_();
+ }
#line 11089 ""
- }
-#line 11090 ""
- i__1 = a1ll_2.iccount - 2;
-#line 11090 ""
- ici__1.icierr = 0;
-#line 11090 ""
- ici__1.iciend = 0;
-#line 11090 ""
- ici__1.icirnum = 1;
-#line 11090 ""
- ici__1.icirlen = a1ll_2.iccount - i__1;
-#line 11090 ""
- ici__1.iciunit = lineq + i__1;
-#line 11090 ""
- ici__1.icifmt = "(i2)";
-#line 11090 ""
- s_rsfi(&ici__1);
-#line 11090 ""
- do_fio(&c__1, (char *)&ninow, (ftnlen)sizeof(integer))
- ;
+ i__1 = ninow;
+#line 11089 ""
+ for (iinow = 1; iinow <= i__1; ++iinow) {
#line 11090 ""
- e_rsfi();
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (
+ ftnlen)128, (ftnlen)1);
#line 11091 ""
- } else {
+ if (*(unsigned char *)durq == ':') {
-/* durq is a single digit number for noinow */
+/* Signals a 2-digit number */
#line 11095 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) ==
- 0) {
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (
+ ftnlen)128, (ftnlen)1);
#line 11096 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
+ g1etchar_(lineq, &a1ll_2.iccount, dumq, (
+ ftnlen)128, (ftnlen)1);
+#line 11097 ""
+ if (i_indx("12", durq, (ftnlen)2, (ftnlen)
+ 1) == 0 || i_indx("0123456789",
+ dumq, (ftnlen)10, (ftnlen)1) == 0)
+ {
+#line 11099 ""
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
/* Writing concatenation */
-#line 11096 ""
- i__2[0] = 34, a__1[0] = "Illegal new number of i"\
- "nstruments ";
-#line 11096 ""
- i__2[1] = 1, a__1[1] = durq;
-#line 11096 ""
- i__2[2] = 19, a__1[2] = " at movement break!";
-#line 11096 ""
- s_cat(ch__5, a__1, i__2, &c__3, (ftnlen)54);
-#line 11096 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, ch__5, (
- ftnlen)128, (ftnlen)54);
#line 11099 ""
- stop1_();
-#line 11100 ""
- }
-#line 11101 ""
- ninow = *(unsigned char *)durq - 48;
+ i__8[0] = 34, a__3[0] = "Illegal 2-d"\
+ "igit instrument number ";
+#line 11099 ""
+ i__8[1] = 1, a__3[1] = durq;
+#line 11099 ""
+ i__8[2] = 1, a__3[2] = dumq;
+#line 11099 ""
+ i__8[3] = 19, a__3[3] = " at movemen"\
+ "t break!";
+#line 11099 ""
+ s_cat(ch__5, a__3, i__8, &c__4, (
+ ftnlen)55);
+#line 11099 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4,
+ ch__5, (ftnlen)128, (ftnlen)
+ 55);
#line 11102 ""
- }
+ stop1_();
#line 11103 ""
- if (ninow > comkeys_1.noinst) {
+ }
#line 11104 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ i__4 = a1ll_2.iccount - 2;
#line 11104 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o"\
- "f instruments must be <= original!", (ftnlen)
- 128, (ftnlen)46);
-#line 11106 ""
- stop1_();
-#line 11107 ""
- }
-#line 11108 ""
- i__1 = ninow;
-#line 11108 ""
- for (iinow = 1; iinow <= i__1; ++iinow) {
-#line 11109 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 11110 ""
- if (*(unsigned char *)durq == ':') {
+ ici__1.icierr = 0;
+#line 11104 ""
+ ici__1.iciend = 0;
+#line 11104 ""
+ ici__1.icirnum = 1;
+#line 11104 ""
+ ici__1.icirlen = a1ll_2.iccount - i__4;
+#line 11104 ""
+ ici__1.iciunit = lineq + i__4;
+#line 11104 ""
+ ici__1.icifmt = "(i2)";
+#line 11104 ""
+ s_rsfi(&ici__1);
+#line 11104 ""
+ do_fio(&c__1, (char *)&iorig, (ftnlen)
+ sizeof(integer));
+#line 11104 ""
+ e_rsfi();
+#line 11105 ""
+ } else {
-/* Signals a 2-digit number */
+/* durq is a single digit number for iorig */
+#line 11109 ""
+ if (i_indx("123456789", durq, (ftnlen)9, (
+ ftnlen)1) == 0) {
+#line 11110 ""
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+/* Writing concatenation */
+#line 11110 ""
+ i__2[0] = 26, a__1[0] = "Illegal ins"\
+ "trument number ";
+#line 11110 ""
+ i__2[1] = 1, a__1[1] = durq;
+#line 11110 ""
+ i__2[2] = 19, a__1[2] = " at movemen"\
+ "t break!";
+#line 11110 ""
+ s_cat(ch__7, a__1, i__2, &c__3, (
+ ftnlen)46);
+#line 11110 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4,
+ ch__7, (ftnlen)128, (ftnlen)
+ 46);
+#line 11113 ""
+ stop1_();
#line 11114 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
- 128, (ftnlen)1);
+ }
#line 11115 ""
- g1etchar_(lineq, &a1ll_2.iccount, dumq, (ftnlen)
- 128, (ftnlen)1);
+ iorig = *(unsigned char *)durq - 48;
#line 11116 ""
- if (i_indx("12", durq, (ftnlen)2, (ftnlen)1) == 0
- || i_indx("0123456789", dumq, (ftnlen)10,
- (ftnlen)1) == 0) {
-#line 11118 ""
- i__4 = c1omnotes_1.ibarcnt -
- c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
-/* Writing concatenation */
-#line 11118 ""
- i__8[0] = 34, a__3[0] = "Illegal 2-digit ins"\
- "trument number ";
-#line 11118 ""
- i__8[1] = 1, a__3[1] = durq;
-#line 11118 ""
- i__8[2] = 1, a__3[2] = dumq;
-#line 11118 ""
- i__8[3] = 19, a__3[3] = " at movement break!";
+ }
+#line 11117 ""
+ if (iorig > comkeys_1.noinst) {
#line 11118 ""
- s_cat(ch__4, a__3, i__8, &c__4, (ftnlen)55);
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 11118 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__4,
- (ftnlen)128, (ftnlen)55);
+ errmsg_(lineq, &a1ll_2.iccount, &i__4,
+ "New instrument number must be <"\
+ "= original noinst!", (ftnlen)128,
+ (ftnlen)49);
+#line 11120 ""
+ stop1_();
#line 11121 ""
- stop1_();
+ }
#line 11122 ""
- }
-#line 11123 ""
- i__4 = a1ll_2.iccount - 2;
-#line 11123 ""
- ici__1.icierr = 0;
+ a1ll_2.nv += c1omget_1.nsperi[iorig - 1];
#line 11123 ""
- ici__1.iciend = 0;
-#line 11123 ""
- ici__1.icirnum = 1;
-#line 11123 ""
- ici__1.icirlen = a1ll_2.iccount - i__4;
-#line 11123 ""
- ici__1.iciunit = lineq + i__4;
-#line 11123 ""
- ici__1.icifmt = "(i2)";
-#line 11123 ""
- s_rsfi(&ici__1);
-#line 11123 ""
- do_fio(&c__1, (char *)&iorig, (ftnlen)sizeof(
- integer));
+/* L63: */
#line 11123 ""
- e_rsfi();
+ }
#line 11124 ""
- } else {
+ i__1 = a1ll_2.nv;
+#line 11124 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
-/* durq is a single digit number for iorig */
+/* Get clef names */
#line 11128 ""
- if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)
- 1) == 0) {
-#line 11129 ""
- i__4 = c1omnotes_1.ibarcnt -
- c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
-/* Writing concatenation */
-#line 11129 ""
- i__2[0] = 26, a__1[0] = "Illegal instrument "\
- "number ";
-#line 11129 ""
- i__2[1] = 1, a__1[1] = durq;
-#line 11129 ""
- i__2[2] = 19, a__1[2] = " at movement break!";
-#line 11129 ""
- s_cat(ch__6, a__1, i__2, &c__3, (ftnlen)46);
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (
+ ftnlen)128, (ftnlen)1);
#line 11129 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, ch__6,
- (ftnlen)128, (ftnlen)46);
+ if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (
+ ftnlen)1) > 0 || *(unsigned char *)
+ durq >= 48 && *(unsigned char *)durq
+ <= 56)) {
+/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */
#line 11132 ""
- stop1_();
-#line 11133 ""
- }
+ i__4 = c1omnotes_1.ibarcnt -
+ c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 11132 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__4,
+ "Must have t,s,m,a,n,r,b,f or 1-"\
+ "7 as clef symbol here!", (ftnlen)
+ 128, (ftnlen)53);
#line 11134 ""
- iorig = *(unsigned char *)durq - 48;
+ stop1_();
#line 11135 ""
- }
-#line 11136 ""
- if (iorig > comkeys_1.noinst) {
-#line 11137 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
-#line 11137 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst"\
- "rument number must be <= original noinst!"
- , (ftnlen)128, (ftnlen)49);
+ }
+
+/* Initialize new voices */
+
#line 11139 ""
- stop1_();
+ c1ommvl_1.nvmx[iiv - 1] = 1;
#line 11140 ""
- }
+ c1ommvl_1.ivmx[iiv - 1] = iiv;
#line 11141 ""
- a1ll_2.nv += c1omget_1.nsperi[iorig - 1];
-#line 11142 ""
-/* L63: */
+ a1ll_2.itsofar[iiv - 1] = 0;
#line 11142 ""
- }
-#line 11143 ""
- i__1 = a1ll_2.nv;
+ a1ll_2.nnl[iiv - 1] = 0;
#line 11143 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
+ for (j = 1; j <= 200; ++j) {
+#line 11144 ""
+ a1ll_2.rest[iiv + j * 24 - 25] = FALSE_;
+#line 11145 ""
+/* L62: */
+#line 11145 ""
+ }
+#line 11146 ""
+/* L61: */
+#line 11146 ""
+ }
-/* Get clef names */
+/* Loop back up, this might not be last option in M */
-#line 11147 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 11148 ""
- if (! (i_indx("tsmanrbf", durq, (ftnlen)8, (ftnlen)1)
- > 0 || *(unsigned char *)durq >= 48 && *(
- unsigned char *)durq <= 56)) {
-/* * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then */
-#line 11151 ""
- i__4 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
- + a1ll_2.nbars + 1;
+#line 11150 ""
+ g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 11151 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav"\
- "e t,s,m,a,n,r,b,f or 1-7 as clef symbol "\
- "here!", (ftnlen)128, (ftnlen)53);
+ goto L31;
+#line 11152 ""
+ } else if (*(unsigned char *)durq == 'S') {
#line 11153 ""
- stop1_();
+ goto L49;
#line 11154 ""
+ } else if (*(unsigned char *)durq != ' ') {
+#line 11155 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff
+ + a1ll_2.nbars + 1;
+#line 11155 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal "\
+ "character after Movement break symbol!", (
+ ftnlen)128, (ftnlen)46);
+#line 11157 ""
+ stop1_();
+#line 11158 ""
}
+#line 11159 ""
+ if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f)
+ {
-/* Initialize new voices */
+/* Since fracsys was not explicitly set, set it to prior value. */
-#line 11158 ""
- c1ommvl_1.nvmx[iiv - 1] = 1;
-#line 11159 ""
- c1ommvl_1.ivmx[iiv - 1] = iiv;
-#line 11160 ""
- a1ll_2.itsofar[iiv - 1] = 0;
-#line 11161 ""
- a1ll_2.nnl[iiv - 1] = 0;
-#line 11162 ""
- for (j = 1; j <= 200; ++j) {
#line 11163 ""
- a1ll_2.rest[iiv + j * 24 - 25] = FALSE_;
-#line 11164 ""
-/* L62: */
+ if (compage_1.nmovbrk == 1) {
#line 11164 ""
- }
-#line 11165 ""
-/* L61: */
+ compage_1.fracsys[compage_1.nmovbrk - 1] =
+ c1omget_1.fracindent;
#line 11165 ""
+ } else {
+#line 11166 ""
+ compage_1.fracsys[compage_1.nmovbrk - 1] =
+ compage_1.fracsys[compage_1.nmovbrk -
+ 2];
+#line 11167 ""
+ }
+#line 11168 ""
+ }
+#line 11169 ""
}
-/* Loop back up, this might not be last option in M */
+/* Just before exiting if-block for forced line breaks, set counter to use when */
+/* dealing with vertical space calcs */
-#line 11169 ""
- g1etchar_(lineq, &a1ll_2.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 11170 ""
- goto L31;
-#line 11171 ""
- } else if (*(unsigned char *)durq == 'S') {
-#line 11172 ""
- goto L49;
-#line 11173 ""
- } else if (*(unsigned char *)durq != ' ') {
#line 11174 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
-#line 11174 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte"\
- "r after Movement break symbol!", (ftnlen)128, (
- ftnlen)46);
+ compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1;
+#line 11175 ""
+ } else if (*(unsigned char *)charq == 'F') {
#line 11176 ""
- stop1_();
+ compage_1.usefig = FALSE_;
#line 11177 ""
- }
+ } else if (*(unsigned char *)charq == 'X') {
+#line 11178 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
#line 11178 ""
- if (compage_1.fracsys[compage_1.nmovbrk - 1] < .001f) {
+ g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &i__1,
+ &c1omnotes_1.udsp[c1omnotes_1.ibarcnt +
+ a1ll_2.nbars], &c1omnotes_1.wheadpt, (ftnlen)128);
+#line 11180 ""
+ } else if (*(unsigned char *)charq == 'I') {
-/* Since fracsys was not explicitly set, set it to prior value. */
+/* MIDI settings. */
-#line 11182 ""
- if (compage_1.nmovbrk == 1) {
-#line 11183 ""
- compage_1.fracsys[compage_1.nmovbrk - 1] =
- c1omget_1.fracindent;
#line 11184 ""
- } else {
+ if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
#line 11185 ""
- compage_1.fracsys[compage_1.nmovbrk - 1] =
- compage_1.fracsys[compage_1.nmovbrk - 2];
-#line 11186 ""
- }
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 11185 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff o"\
+ "nly allowed at start of block!", (ftnlen)128,
+ (ftnlen)42);
#line 11187 ""
- }
+ stop1_();
#line 11188 ""
- }
-
-/* Just before exiting if-block for forced line breaks, set counter to use when */
-/* dealing with vertical space calcs */
-
+ }
+#line 11189 ""
+ if (a1ll_2.nv > 15) {
+#line 11190 ""
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 11190 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MI"\
+ "DI does not work with more than 15 voices!", (
+ ftnlen)128, (ftnlen)54);
+#line 11192 ""
+ stop1_();
#line 11193 ""
- compage_1.nistaff[compage_1.nflb] = a1ll_2.nv - 1;
+ }
#line 11194 ""
- } else if (*(unsigned char *)charq == 'F') {
+ commidi_1.ismidi = TRUE_;
#line 11195 ""
- compage_1.usefig = FALSE_;
-#line 11196 ""
- } else if (*(unsigned char *)charq == 'X') {
+ getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, &
+ c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &
+ a1ll_2.nbars, &a1ll_2.lenbar, &mtrdenl, &
+ a1ll_2.nv, &c_true, (ftnlen)128);
#line 11197 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
-#line 11197 ""
- g1etx_(lineq, &a1ll_2.iccount, &comkeys_1.shifton, &i__1, &
- c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], &
- c1omnotes_1.wheadpt, (ftnlen)128);
-#line 11199 ""
- } else if (*(unsigned char *)charq == 'I') {
+ } else if (*(unsigned char *)charq == 'M') {
+#line 11198 ""
+ setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, &
+ c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, &
+ c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, (
+ ftnlen)1, (ftnlen)1);
+#line 11200 ""
+ } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
-/* MIDI settings. */
+/* Continued rhythmic shortcut */
-#line 11203 ""
- if (c1ommvl_1.ivx != 1 || a1ll_2.nnl[0] != 0) {
-#line 11204 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
#line 11204 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo"\
- "wed at start of block!", (ftnlen)128, (ftnlen)42);
-#line 11206 ""
- stop1_();
-#line 11207 ""
- }
-#line 11208 ""
- if (a1ll_2.nv > 15) {
-#line 11209 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
- a1ll_2.nbars + 1;
+ idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
+#line 11205 ""
+ if (idotform == 1) {
+
+/* Change duration of prior note */
+
#line 11209 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does "\
- "not work with more than 15 voices!", (ftnlen)128, (
- ftnlen)54);
+ a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[
+ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1]
+ * 24 - 25];
+#line 11210 ""
+ a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx
+ - 1] * 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx
+ + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 - 25] *
+ 3 / 2;
#line 11211 ""
- stop1_();
+ a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[
+ c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1]
+ * 24 - 25];
#line 11212 ""
- }
+ }
#line 11213 ""
- commidi_1.ismidi = TRUE_;
+ ++idotform;
#line 11214 ""
- getmidi_(&comkeys_1.noinst, lineq, &a1ll_2.iccount, &
- c1omnotes_1.ibarcnt, &c1omnotes_1.ibaroff, &a1ll_2.nbars,
- &a1ll_2.lenbar, &mtrdenl, &a1ll_2.nv, &c_true, (ftnlen)
- 128);
+ numnum = 1;
+#line 11215 ""
+ cdot = TRUE_;
#line 11216 ""
- } else if (*(unsigned char *)charq == 'M') {
+ goto L1;
#line 11217 ""
- setmac_(lineq, &a1ll_2.iccount, &c1omnotes_1.ibarcnt, &
- c1omnotes_1.ibaroff, &a1ll_2.nbars, charq, durq, &
- c1ommvl_1.ivx, &c1omget_1.nline, (ftnlen)128, (ftnlen)1, (
- ftnlen)1);
+ } else {
+#line 11218 ""
+ s_wsle(&io___701);
+#line 11218 ""
+ do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 11218 ""
+ i__1 = *(unsigned char *)charq;
+#line 11218 ""
+ do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(
+ integer));
+#line 11218 ""
+ e_wsle();
#line 11219 ""
- } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
-
-/* Continued rhythmic shortcut */
-
+ i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
+ a1ll_2.nbars + 1;
+#line 11219 ""
+ errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character i"\
+ "s not allowed here!", (ftnlen)128, (ftnlen)35);
+#line 11221 ""
+ s_wsle(&io___702);
+#line 11221 ""
+ do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
+#line 11221 ""
+ i__1 = *(unsigned char *)charq;
+#line 11221 ""
+ do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(
+ integer));
+#line 11221 ""
+ e_wsle();
+#line 11222 ""
+ stop1_();
+#line 11223 ""
+ }
#line 11223 ""
- idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
-#line 11224 ""
- if (idotform == 1) {
-
-/* Change duration of prior note */
-
-#line 11228 ""
- a1ll_2.itsofar[c1ommvl_1.ivx - 1] -= a1ll_2.nodur[
- c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
- 25];
-#line 11229 ""
- a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] *
- 24 - 25] = a1ll_2.nodur[c1ommvl_1.ivx + a1ll_2.nnl[
- c1ommvl_1.ivx - 1] * 24 - 25] * 3 / 2;
-#line 11230 ""
- a1ll_2.itsofar[c1ommvl_1.ivx - 1] += a1ll_2.nodur[
- c1ommvl_1.ivx + a1ll_2.nnl[c1ommvl_1.ivx - 1] * 24 -
- 25];
-#line 11231 ""
}
-#line 11232 ""
- ++idotform;
-#line 11233 ""
- numnum = 1;
-#line 11234 ""
- cdot = TRUE_;
-#line 11235 ""
- goto L1;
-#line 11236 ""
- } else {
-#line 11237 ""
- s_wsle(&io___702);
-#line 11237 ""
- do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
-#line 11237 ""
- i__1 = *(unsigned char *)charq;
-#line 11237 ""
- do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 11237 ""
- e_wsle();
-#line 11238 ""
- i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + a1ll_2.nbars +
- 1;
-#line 11238 ""
- errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\
- "lowed here!", (ftnlen)128, (ftnlen)35);
-#line 11240 ""
- s_wsle(&io___703);
-#line 11240 ""
- do_lio(&c__9, &c__1, "ASCII code:", (ftnlen)11);
-#line 11240 ""
- i__1 = *(unsigned char *)charq;
-#line 11240 ""
- do_lio(&c__3, &c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 11240 ""
- e_wsle();
-#line 11241 ""
- stop1_();
-#line 11242 ""
+#line 11223 ""
}
-#line 11242 ""
+#line 11223 ""
}
-#line 11243 ""
+#line 11224 ""
return 0;
} /* g1etnote_ */
@@ -27312,159 +27460,159 @@ L31:
static integer iccount;
/* Fortran I/O blocks */
- static cilist io___706 = { 0, 6, 0, 0, 0 };
- static cilist io___707 = { 0, 6, 0, "(1x,a46,i3)", 0 };
- static cilist io___708 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___705 = { 0, 6, 0, 0, 0 };
+ static cilist io___706 = { 0, 6, 0, "(1x,a46,i3)", 0 };
+ static cilist io___707 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___710 = { 0, 6, 0, "(a)", 0 };
static cilist io___711 = { 0, 6, 0, "(a)", 0 };
- static cilist io___712 = { 0, 6, 0, "(a)", 0 };
- static cilist io___713 = { 0, 6, 0, 0, 0 };
+ static cilist io___712 = { 0, 6, 0, 0, 0 };
/* Get the first line */
-#line 11261 ""
+#line 11242 ""
iccount = 0;
-#line 11262 ""
+#line 11243 ""
c1omget_1.nline = 1;
-#line 11263 ""
+#line 11244 ""
L9:
-#line 11263 ""
+#line 11244 ""
getbuf_(lineq, (ftnlen)128);
-#line 11264 ""
+#line 11245 ""
if (*(unsigned char *)lineq == '%') {
-#line 11265 ""
+#line 11246 ""
++c1omget_1.nline;
-#line 11266 ""
+#line 11247 ""
goto L9;
-#line 11267 ""
+#line 11248 ""
}
-#line 11268 ""
+#line 11249 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0) {
/* Have TeX input until next line that starts with '---' */
-#line 11272 ""
+#line 11253 ""
L3:
-#line 11272 ""
+#line 11253 ""
++c1omget_1.nline;
-#line 11273 ""
+#line 11254 ""
getbuf_(lineq, (ftnlen)128);
-#line 11274 ""
+#line 11255 ""
if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
-#line 11274 ""
+#line 11255 ""
goto L1;
-#line 11274 ""
+#line 11255 ""
}
-#line 11275 ""
+#line 11256 ""
goto L2;
-#line 11276 ""
+#line 11257 ""
L1:
-#line 11276 ""
- s_wsle(&io___706);
-#line 11276 ""
+#line 11257 ""
+ s_wsle(&io___705);
+#line 11257 ""
do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \""\
"---\"", (ftnlen)49);
-#line 11276 ""
+#line 11257 ""
e_wsle();
-#line 11277 ""
+#line 11258 ""
stop1_();
-#line 11278 ""
+#line 11259 ""
L2:
-#line 11279 ""
+#line 11260 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
-#line 11279 ""
+#line 11260 ""
goto L3;
-#line 11279 ""
+#line 11260 ""
}
/* Force a new line read on first call to readin */
-#line 11283 ""
+#line 11264 ""
iccount = 128;
-#line 11284 ""
+#line 11265 ""
}
/* Here, lineq and nline are first non-TeX lines. */
-#line 11288 ""
+#line 11269 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11288 ""
+#line 11269 ""
*nv = i_nint(&r__1);
-#line 11289 ""
+#line 11270 ""
if (*nv > 24) {
-#line 11290 ""
- s_wsfe(&io___707);
-#line 11290 ""
+#line 11271 ""
+ s_wsfe(&io___706);
+#line 11271 ""
do_fio(&c__1, "In setup data, number of voices cannot exceed", (
ftnlen)45);
-#line 11290 ""
+#line 11271 ""
do_fio(&c__1, (char *)&c__24, (ftnlen)sizeof(integer));
-#line 11290 ""
+#line 11271 ""
e_wsfe();
-#line 11292 ""
+#line 11273 ""
stop1_();
-#line 11293 ""
+#line 11274 ""
}
-#line 11294 ""
+#line 11275 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11294 ""
+#line 11275 ""
*noinst = i_nint(&r__1);
-#line 11295 ""
+#line 11276 ""
if (*noinst > *nv) {
-#line 11296 ""
- s_wsfe(&io___708);
-#line 11296 ""
+#line 11277 ""
+ s_wsfe(&io___707);
+#line 11277 ""
do_fio(&c__1, "In setup data, cannot have more instruments than stav"\
"es", (ftnlen)55);
-#line 11296 ""
+#line 11277 ""
e_wsfe();
-#line 11298 ""
+#line 11279 ""
stop1_();
-#line 11299 ""
+#line 11280 ""
}
-#line 11300 ""
+#line 11281 ""
newway = *noinst <= 0;
-#line 11301 ""
+#line 11282 ""
if (newway) {
-#line 11301 ""
+#line 11282 ""
*noinst = -(*noinst);
-#line 11301 ""
+#line 11282 ""
}
-#line 11302 ""
+#line 11283 ""
i__1 = *noinst;
-#line 11302 ""
+#line 11283 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* Seve # of staves per inst in case later drop some inst's. */
-#line 11306 ""
+#line 11287 ""
if (newway) {
-#line 11307 ""
+#line 11288 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11307 ""
+#line 11288 ""
c1omget_1.nsperi[iinst - 1] = i_nint(&r__1);
-#line 11308 ""
+#line 11289 ""
} else if (iinst > 1) {
-#line 11309 ""
+#line 11290 ""
c1omget_1.nsperi[iinst - 1] = 1;
-#line 11310 ""
+#line 11291 ""
} else {
-#line 11311 ""
+#line 11292 ""
c1omget_1.nsperi[iinst - 1] = *nv - *noinst + 1;
-#line 11312 ""
+#line 11293 ""
}
-#line 11313 ""
+#line 11294 ""
/* L10: */
-#line 11313 ""
+#line 11294 ""
}
-#line 11314 ""
+#line 11295 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11314 ""
+#line 11295 ""
*mtrnuml = i_nint(&r__1);
-#line 11315 ""
+#line 11296 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11315 ""
+#line 11296 ""
*mtrdenl = i_nint(&r__1);
/* c */
/* c Kluge!!! */
@@ -27473,208 +27621,208 @@ L2:
/* mtrdenl = 2 */
/* mtrnuml = mtrnuml*2 */
/* end if */
-#line 11323 ""
+#line 11304 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11323 ""
+#line 11304 ""
*mtrnmp = i_nint(&r__1);
-#line 11324 ""
+#line 11305 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11324 ""
+#line 11305 ""
*mtrdnp = i_nint(&r__1);
-#line 11325 ""
+#line 11306 ""
if (*mtrnmp == 0 && *mtrdnp >= 8) {
-#line 11326 ""
- s_wsfe(&io___711);
-#line 11326 ""
+#line 11307 ""
+ s_wsfe(&io___710);
+#line 11307 ""
do_fio(&c__1, "In setup data, with mtrnmp=0, mtrdnp must be <8", (
ftnlen)47);
-#line 11326 ""
+#line 11307 ""
e_wsfe();
-#line 11327 ""
+#line 11308 ""
stop1_();
-#line 11328 ""
+#line 11309 ""
}
-#line 11329 ""
+#line 11310 ""
*xmtrnum0 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11330 ""
+#line 11311 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11330 ""
+#line 11311 ""
*newkey = i_nint(&r__1);
/* 130316 */
/* do 11 iinst = 1 , noinst */
-#line 11333 ""
+#line 11314 ""
commidisig_1.midisig = *newkey;
/* 11 continue */
-#line 11335 ""
+#line 11316 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11335 ""
+#line 11316 ""
*npages = i_nint(&r__1);
-#line 11336 ""
+#line 11317 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11336 ""
+#line 11317 ""
*nsyst = i_nint(&r__1);
-#line 11337 ""
+#line 11318 ""
r__1 = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)128);
-#line 11337 ""
+#line 11318 ""
*musize = i_nint(&r__1);
-#line 11338 ""
+#line 11319 ""
c1omget_1.fracindent = readin_(lineq, &iccount, &c1omget_1.nline, (ftnlen)
128);
-#line 11339 ""
+#line 11320 ""
if (c1omget_1.fracindent >= 1.f) {
-#line 11340 ""
- s_wsfe(&io___712);
-#line 11340 ""
+#line 11321 ""
+ s_wsfe(&io___711);
+#line 11321 ""
do_fio(&c__1, "In setup data, fracindent must be <1", (ftnlen)36);
-#line 11340 ""
+#line 11321 ""
e_wsfe();
-#line 11341 ""
+#line 11322 ""
stop1_();
-#line 11342 ""
+#line 11323 ""
}
-#line 11343 ""
+#line 11324 ""
if (*npages > *nsyst) {
-#line 11344 ""
- s_wsle(&io___713);
-#line 11344 ""
+#line 11325 ""
+ s_wsle(&io___712);
+#line 11325 ""
do_lio(&c__9, &c__1, "Error in input file: npages > nsyst", (ftnlen)
35);
-#line 11344 ""
+#line 11325 ""
e_wsle();
-#line 11345 ""
+#line 11326 ""
stop1_();
-#line 11346 ""
+#line 11327 ""
} else if ((*musize - 16) * (*musize - 20) * (*musize - 24) * (*musize -
29) != 0) {
-#line 11347 ""
+#line 11328 ""
printl_("Musicsize must be 16, 20, 24, or 29", (ftnlen)35);
-#line 11348 ""
+#line 11329 ""
stop1_();
-#line 11349 ""
+#line 11330 ""
}
/* Next noinst non-comment lines are names of instruments. */
-#line 11353 ""
+#line 11334 ""
i__1 = abs(*noinst);
-#line 11353 ""
+#line 11334 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 11354 ""
+#line 11335 ""
L5:
-#line 11354 ""
+#line 11335 ""
getbuf_(lineq, (ftnlen)128);
-#line 11355 ""
+#line 11336 ""
++c1omget_1.nline;
-#line 11356 ""
+#line 11337 ""
if (*(unsigned char *)lineq == '%') {
-#line 11356 ""
+#line 11337 ""
goto L5;
-#line 11356 ""
+#line 11337 ""
}
-#line 11357 ""
+#line 11338 ""
/* L4: */
-#line 11357 ""
+#line 11338 ""
}
/* Mext non-comment line has nv clef names */
-#line 11361 ""
+#line 11342 ""
L6:
-#line 11361 ""
+#line 11342 ""
getbuf_(lineq, (ftnlen)128);
-#line 11362 ""
+#line 11343 ""
++c1omget_1.nline;
-#line 11363 ""
+#line 11344 ""
if (*(unsigned char *)lineq == '%') {
-#line 11363 ""
+#line 11344 ""
goto L6;
-#line 11363 ""
+#line 11344 ""
}
-#line 11364 ""
+#line 11345 ""
i__1 = *nv;
-#line 11364 ""
+#line 11345 ""
for (iv = 1; iv <= i__1; ++iv) {
/* if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then */
-#line 11366 ""
+#line 11347 ""
if (i_indx("brnamstf012345678", lineq + (iv - 1), (ftnlen)17, (ftnlen)
1) == 0) {
-#line 11367 ""
+#line 11348 ""
errmsg_(lineq, &iv, &c__0, "There should be a clef symbol here!",
(ftnlen)128, (ftnlen)35);
-#line 11369 ""
+#line 11350 ""
stop1_();
-#line 11370 ""
+#line 11351 ""
}
-#line 11371 ""
+#line 11352 ""
/* L7: */
-#line 11371 ""
+#line 11352 ""
}
-#line 11372 ""
+#line 11353 ""
i__1 = *nv;
-#line 11372 ""
+#line 11353 ""
if (s_cmp(lineq + i__1, " ", *nv + 1 - i__1, (ftnlen)1) != 0) {
-#line 11373 ""
+#line 11354 ""
i__1 = *nv + 1;
-#line 11373 ""
+#line 11354 ""
errmsg_(lineq, &i__1, &c__0, "There should be a blank here!", (ftnlen)
128, (ftnlen)29);
-#line 11375 ""
+#line 11356 ""
stop1_();
-#line 11376 ""
+#line 11357 ""
}
/* Set flag if voice 1 is treble, since it affects vertical spacing */
/* bottreb = lineq(1:1).eq.'t' */
-#line 11381 ""
+#line 11362 ""
*bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0;
/* Next non-comment line has path name */
-#line 11385 ""
+#line 11366 ""
L8:
-#line 11385 ""
+#line 11366 ""
getbuf_(lineq, (ftnlen)128);
-#line 11386 ""
+#line 11367 ""
++c1omget_1.nline;
-#line 11387 ""
+#line 11368 ""
if (*(unsigned char *)lineq == '%') {
-#line 11387 ""
+#line 11368 ""
goto L8;
-#line 11387 ""
+#line 11368 ""
}
-#line 11388 ""
+#line 11369 ""
lpath = i_indx(lineq, " ", (ftnlen)128, (ftnlen)1) - 1;
/* Writing concatenation */
-#line 11389 ""
+#line 11370 ""
i__2[0] = 2, a__1[0] = "/:";
-#line 11389 ""
+#line 11370 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 11389 ""
+#line 11370 ""
i__2[1] = 1, a__1[1] = ch__2;
-#line 11389 ""
+#line 11370 ""
s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)3);
-#line 11389 ""
+#line 11370 ""
if (i_indx(ch__1, lineq + (lpath - 1), (ftnlen)3, (ftnlen)1) == 0) {
/* Writing concatenation */
-#line 11390 ""
+#line 11371 ""
i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\""\
":\", or \"";
-#line 11390 ""
+#line 11371 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 11390 ""
+#line 11371 ""
i__3[1] = 1, a__2[1] = ch__2;
-#line 11390 ""
+#line 11371 ""
i__3[2] = 2, a__2[2] = "\"!";
-#line 11390 ""
+#line 11371 ""
s_cat(ch__3, a__2, i__3, &c__3, (ftnlen)50);
-#line 11390 ""
+#line 11371 ""
errmsg_(lineq, &lpath, &c__0, ch__3, (ftnlen)128, (ftnlen)50);
-#line 11393 ""
+#line 11374 ""
stop1_();
-#line 11394 ""
+#line 11375 ""
}
-#line 11395 ""
+#line 11376 ""
return 0;
} /* g1etset_ */
@@ -27703,155 +27851,155 @@ L8:
/* Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. */
/* In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */
-#line 11405 ""
+#line 11386 ""
number = FALSE_;
-#line 11406 ""
+#line 11387 ""
npbsc = 0;
-#line 11407 ""
+#line 11388 ""
L1:
-#line 11407 ""
+#line 11388 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11408 ""
+#line 11389 ""
if (i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1) > 0) {
/* Continue checking here even if "P". */
-#line 11412 ""
+#line 11393 ""
ipbsc = i_indx("PBS:", charq, (ftnlen)4, (ftnlen)1);
-#line 11413 ""
+#line 11394 ""
if (bit_test(npbsc,ipbsc)) {
-#line 11414 ""
+#line 11395 ""
errmsg_(lineq, iccount, ibar, "Only one allowed per symbol!", (
ftnlen)128, (ftnlen)28);
-#line 11415 ""
+#line 11396 ""
stop1_();
-#line 11416 ""
+#line 11397 ""
}
-#line 11417 ""
+#line 11398 ""
npbsc = bit_set(npbsc,ipbsc);
-#line 11418 ""
+#line 11399 ""
goto L1;
-#line 11419 ""
+#line 11400 ""
} else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
-#line 11420 ""
+#line 11401 ""
number = TRUE_;
-#line 11421 ""
+#line 11402 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 11422 ""
+#line 11403 ""
g1etchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1);
-#line 11423 ""
+#line 11404 ""
if (i_indx(".0123456789", dumq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 11424 ""
+#line 11405 ""
errmsg_(lineq, iccount, ibar, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
-#line 11425 ""
+#line 11406 ""
stop1_();
-#line 11426 ""
+#line 11407 ""
}
-#line 11427 ""
+#line 11408 ""
}
-#line 11428 ""
+#line 11409 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11429 ""
+#line 11410 ""
if (*(unsigned char *)charq == '-') {
-#line 11429 ""
+#line 11410 ""
fnum = -fnum;
-#line 11429 ""
+#line 11410 ""
}
-#line 11430 ""
+#line 11411 ""
if (*(unsigned char *)dumq != 'p') {
-#line 11431 ""
+#line 11412 ""
--(*iccount);
-#line 11432 ""
+#line 11413 ""
fnum *= *wheadpt;
-#line 11433 ""
+#line 11414 ""
}
-#line 11434 ""
+#line 11415 ""
goto L1;
-#line 11435 ""
+#line 11416 ""
} else if (*(unsigned char *)charq != ' ') {
-#line 11436 ""
+#line 11417 ""
errmsg_(lineq, iccount, ibar, "Not allowed in \"X\" symbol!", (ftnlen)
128, (ftnlen)26);
-#line 11437 ""
+#line 11418 ""
stop1_();
-#line 11438 ""
+#line 11419 ""
}
/* Done with parsing. Other checks */
-#line 11442 ""
+#line 11423 ""
if ((6 & npbsc) == 6 || (24 & npbsc) == 24) {
-#line 11443 ""
+#line 11424 ""
i__1 = *iccount - 1;
-#line 11443 ""
+#line 11424 ""
errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \""\
"S\" and \":\"!", (ftnlen)128, (ftnlen)44);
-#line 11445 ""
+#line 11426 ""
stop1_();
-#line 11446 ""
+#line 11427 ""
}
-#line 11447 ""
+#line 11428 ""
if (bit_test(npbsc,4)) {
-#line 11448 ""
+#line 11429 ""
if (number) {
-#line 11449 ""
+#line 11430 ""
if (*shifton) {
-#line 11450 ""
+#line 11431 ""
i__1 = *iccount - 1;
-#line 11450 ""
+#line 11431 ""
errmsg_(lineq, &i__1, ibar, "Started a group shift without s"\
"topping prior one!", (ftnlen)128, (ftnlen)49);
-#line 11452 ""
+#line 11433 ""
stop1_();
-#line 11453 ""
+#line 11434 ""
} else {
-#line 11454 ""
+#line 11435 ""
*shifton = TRUE_;
-#line 11455 ""
+#line 11436 ""
}
-#line 11456 ""
+#line 11437 ""
} else {
-#line 11457 ""
+#line 11438 ""
if (! (*shifton)) {
-#line 11458 ""
+#line 11439 ""
i__1 = *iccount - 1;
-#line 11458 ""
+#line 11439 ""
errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta"\
"rting one!", (ftnlen)128, (ftnlen)41);
-#line 11460 ""
+#line 11441 ""
stop1_();
-#line 11461 ""
+#line 11442 ""
} else {
-#line 11462 ""
+#line 11443 ""
*shifton = FALSE_;
-#line 11463 ""
+#line 11444 ""
}
-#line 11464 ""
+#line 11445 ""
}
-#line 11465 ""
+#line 11446 ""
}
/* P off, S off, c off => normal user-defined space. Add to udsp (later fsyst) */
-#line 11469 ""
+#line 11450 ""
if ((npbsc & 26) == 0) {
-#line 11469 ""
+#line 11450 ""
*udsp += fnum;
-#line 11469 ""
+#line 11450 ""
}
-#line 11470 ""
+#line 11451 ""
if (! number && ! bit_test(npbsc,4)) {
-#line 11471 ""
+#line 11452 ""
i__1 = *iccount - 1;
-#line 11471 ""
+#line 11452 ""
errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon "\
"in \"X\" symbol!", (ftnlen)128, (ftnlen)51);
-#line 11473 ""
+#line 11454 ""
stop1_();
-#line 11474 ""
+#line 11455 ""
}
-#line 11475 ""
+#line 11456 ""
return 0;
} /* g1etx_ */
@@ -27870,16 +28018,16 @@ L1:
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
-#line 11490 ""
+#line 11471 ""
i__1 = inbuff_1.ipbuf;
-#line 11490 ""
+#line 11471 ""
s_copy(lineq, inbuff_1.bufq + i__1, lineq_len, inbuff_1.ipbuf +
inbuff_1.lbuf[inbuff_1.ilbuf - 1] - i__1);
-#line 11491 ""
+#line 11472 ""
inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1];
-#line 11492 ""
+#line 11473 ""
++inbuff_1.ilbuf;
-#line 11493 ""
+#line 11474 ""
return 0;
} /* getbuf_ */
@@ -27898,43 +28046,43 @@ L1:
/* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */
/* then reads in a new line. Resets iccount. Ends program if no more input. */
-#line 11509 ""
+#line 11490 ""
if (*iccount == 128) {
-#line 11510 ""
+#line 11491 ""
read10_(lineq, &comget_1.lastchar, (ftnlen)128);
-#line 11511 ""
+#line 11492 ""
if (comget_1.lastchar) {
-#line 11511 ""
+#line 11492 ""
return 0;
-#line 11511 ""
+#line 11492 ""
}
-#line 11512 ""
+#line 11493 ""
if (! commac_1.endmac) {
-#line 11513 ""
+#line 11494 ""
*iccount = 0;
-#line 11514 ""
+#line 11495 ""
} else {
-#line 11515 ""
+#line 11496 ""
commac_1.endmac = FALSE_;
-#line 11516 ""
+#line 11497 ""
*iccount = commac_1.icchold;
-#line 11517 ""
+#line 11498 ""
s_copy(lineq, commac_1.lnholdq, (ftnlen)128, (ftnlen)128);
-#line 11518 ""
+#line 11499 ""
}
-#line 11519 ""
+#line 11500 ""
if (commac_1.mrecord) {
-#line 11520 ""
+#line 11501 ""
mrec1_(lineq, iccount, &ndxm, (ftnlen)128);
-#line 11521 ""
+#line 11502 ""
}
-#line 11522 ""
+#line 11503 ""
}
-#line 11523 ""
+#line 11504 ""
++(*iccount);
-#line 11524 ""
+#line 11505 ""
*(unsigned char *)charq = *(unsigned char *)&lineq[*iccount - 1];
-#line 11525 ""
+#line 11506 ""
return 0;
} /* getchar_ */
@@ -27945,7 +28093,7 @@ L1:
address a__1[3];
integer i__1, i__2[3], i__3;
real r__1;
- char ch__1[4], ch__2[1];
+ char ch__1[1], ch__2[4];
icilist ici__1;
/* Builtin functions */
@@ -27991,284 +28139,290 @@ L1:
/* 01-09 (horizontal offset)/10 + 25.6 notehead widths */
/* 10 5th bit for ivx (5/15/10) */
-#line 11562 ""
+#line 11543 ""
*irest = bit_set(*irest,26);
-#line 11563 ""
+#line 11544 ""
++comdyn_1.ndyn;
-#line 11564 ""
+#line 11545 ""
idyn = *ivx;
-#line 11565 ""
+#line 11546 ""
comdyn_1.idynda2[comdyn_1.ndyn - 1] = 0;
-#line 11566 ""
+#line 11547 ""
if (*ivx >= 16) {
-#line 11566 ""
+#line 11547 ""
setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__1, &c__10, &c__1);
-#line 11566 ""
+#line 11547 ""
}
-#line 11567 ""
+#line 11548 ""
setbits_(&idyn, &c__8, &c__4, ip);
-#line 11568 ""
+#line 11549 ""
i__1 = *iccount;
-#line 11568 ""
- if (s_cmp(lineq + i__1, "\"", *iccount + 1 - i__1, (ftnlen)1) == 0) {
+#line 11549 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 11549 ""
+ if (s_cmp(lineq + i__1, ch__1, *iccount + 1 - i__1, (ftnlen)1) == 0) {
/* text-dynamic */
-#line 11572 ""
+#line 11553 ""
++comdyn_1.ntxtdyn;
-#line 11573 ""
+#line 11554 ""
iccountt = *iccount;
-#line 11574 ""
+#line 11555 ""
L3:
-#line 11575 ""
+#line 11556 ""
i__1 = iccountt + 1;
-#line 11575 ""
- iend = iccountt + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1) +
- 2;
-#line 11576 ""
+#line 11556 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 11556 ""
+ iend = iccountt + i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1)
+ + 2;
+#line 11557 ""
i__1 = iend - 3;
-#line 11576 ""
- if (s_cmp(lineq + i__1, "\\", iend - 2 - i__1, (ftnlen)1) == 0) {
-#line 11577 ""
+#line 11557 ""
+ chax_(ch__1, (ftnlen)1, &c__92);
+#line 11557 ""
+ if (s_cmp(lineq + i__1, ch__1, iend - 2 - i__1, (ftnlen)1) == 0) {
+#line 11558 ""
iccountt = iend - 2;
-#line 11578 ""
+#line 11559 ""
goto L3;
-#line 11579 ""
+#line 11560 ""
}
-#line 11580 ""
+#line 11561 ""
i__1 = *iccount + 1;
-#line 11580 ""
+#line 11561 ""
s_copy(comdyn_1.txtdynq + (comdyn_1.ntxtdyn - 1 << 7), lineq + i__1, (
ftnlen)128, iend - 2 - i__1);
/* Store ivx, ip in bits 0-12 */
-#line 11584 ""
+#line 11565 ""
comdyn_1.ivxiptxt[comdyn_1.ntxtdyn - 1] = *ivx + (*ip << 5);
-#line 11585 ""
+#line 11566 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
-#line 11586 ""
+#line 11567 ""
idno = 0;
-#line 11587 ""
+#line 11568 ""
} else {
/* Word-group or hairpin */
-#line 11591 ""
+#line 11572 ""
for (iend = *iccount + 2; iend <= 128; ++iend) {
-#line 11592 ""
+#line 11573 ""
ipm = i_indx("- +", lineq + (iend - 1), (ftnlen)3, (ftnlen)1);
/* Exit the loop at first blank, "+", or "-" */
-#line 11596 ""
+#line 11577 ""
if (ipm > 0) {
-#line 11596 ""
+#line 11577 ""
goto L2;
-#line 11596 ""
+#line 11577 ""
}
-#line 11597 ""
+#line 11578 ""
/* L1: */
-#line 11597 ""
+#line 11578 ""
}
-#line 11598 ""
+#line 11579 ""
L2:
-#line 11599 ""
+#line 11580 ""
i__1 = *iccount;
-#line 11599 ""
+#line 11580 ""
ici__1.icierr = 0;
-#line 11599 ""
+#line 11580 ""
ici__1.iciend = 0;
-#line 11599 ""
+#line 11580 ""
ici__1.icirnum = 1;
-#line 11599 ""
+#line 11580 ""
ici__1.icirlen = iend - 1 - i__1;
-#line 11599 ""
+#line 11580 ""
ici__1.iciunit = lineq + i__1;
/* Writing concatenation */
-#line 11599 ""
+#line 11580 ""
i__2[0] = 2, a__1[0] = "(a";
-#line 11599 ""
+#line 11580 ""
i__3 = iend + 47 - *iccount;
-#line 11599 ""
- chax_(ch__2, (ftnlen)1, &i__3);
-#line 11599 ""
- i__2[1] = 1, a__1[1] = ch__2;
-#line 11599 ""
+#line 11580 ""
+ chax_(ch__1, (ftnlen)1, &i__3);
+#line 11580 ""
+ i__2[1] = 1, a__1[1] = ch__1;
+#line 11580 ""
i__2[2] = 1, a__1[2] = ")";
-#line 11599 ""
- ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
-#line 11599 ""
+#line 11580 ""
+ ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2);
+#line 11580 ""
s_rsfi(&ici__1);
-#line 11599 ""
+#line 11580 ""
do_fio(&c__1, dynsymq, (ftnlen)4);
-#line 11599 ""
+#line 11580 ""
e_rsfi();
-#line 11601 ""
+#line 11582 ""
idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff "\
"< > ", dynsymq, (ftnlen)60, (ftnlen)4) + 3) / 4;
/* Save for later down */
-#line 11607 ""
+#line 11588 ""
idno1 = idno;
-#line 11608 ""
+#line 11589 ""
}
/* Set flag to check level later if in beam */
-#line 11612 ""
+#line 11593 ""
*iornq = bit_set(*iornq,23);
-#line 11613 ""
+#line 11594 ""
if (idno >= 14) {
/* Hairpin here. Check if opposite type from one that's already on */
-#line 11617 ""
+#line 11598 ""
if (idno == 14 && bit_test(comdyn_1.listdecresc,*ivx) || idno == 15 &&
bit_test(comdyn_1.listcresc,*ivx)) {
-#line 11619 ""
+#line 11600 ""
printl_(" ", (ftnlen)1);
-#line 11620 ""
+#line 11601 ""
printl_("Started one kind of hairpin while other is on", (ftnlen)
45);
-#line 11621 ""
+#line 11602 ""
stop1_();
-#line 11622 ""
+#line 11603 ""
}
/* Start or stop? */
-#line 11626 ""
+#line 11607 ""
if (bit_test(comdyn_1.listcresc,*ivx) || bit_test(
comdyn_1.listdecresc,*ivx)) {
/* Cresc/decresc is on, this is an ending. If fontslur, leave idno as is. */
-#line 11630 ""
+#line 11611 ""
if (! comslur_1.fontslur) {
-#line 11630 ""
+#line 11611 ""
idno = 15;
-#line 11630 ""
+#line 11611 ""
}
-#line 11631 ""
+#line 11612 ""
} else if (comslur_1.fontslur) {
/* Start of font slur */
-#line 11635 ""
+#line 11616 ""
idno = 13;
-#line 11636 ""
+#line 11617 ""
} else {
/* Start of postscript slur */
-#line 11640 ""
+#line 11621 ""
--idno;
-#line 11641 ""
+#line 11622 ""
}
-#line 11642 ""
+#line 11623 ""
}
/* Now that we used list[de]cresc, update */
-#line 11646 ""
+#line 11627 ""
if (idno >= 13) {
-#line 11647 ""
+#line 11628 ""
if (idno == 15 || comslur_1.fontslur && idno == 14) {
/* Something's ending */
-#line 11651 ""
+#line 11632 ""
if (bit_test(comdyn_1.listcresc,*ivx)) {
/* It's a cresc! */
-#line 11655 ""
+#line 11636 ""
comdyn_1.listcresc = bit_clear(comdyn_1.listcresc,*ivx);
-#line 11656 ""
+#line 11637 ""
} else {
-#line 11657 ""
+#line 11638 ""
comdyn_1.listdecresc = bit_clear(comdyn_1.listdecresc,*ivx);
-#line 11658 ""
+#line 11639 ""
}
-#line 11659 ""
+#line 11640 ""
} else {
/* Something's starting */
-#line 11663 ""
+#line 11644 ""
if (idno1 == 14) {
/* It's a cresc! */
-#line 11667 ""
+#line 11648 ""
comdyn_1.listcresc = bit_set(comdyn_1.listcresc,*ivx);
-#line 11668 ""
+#line 11649 ""
} else {
-#line 11669 ""
+#line 11650 ""
comdyn_1.listdecresc = bit_set(comdyn_1.listdecresc,*ivx);
-#line 11670 ""
+#line 11651 ""
}
-#line 11671 ""
+#line 11652 ""
}
-#line 11672 ""
+#line 11653 ""
}
-#line 11673 ""
+#line 11654 ""
setbits_(&idyn, &c__4, &c__12, &idno);
-#line 11674 ""
+#line 11655 ""
*iccount = iend;
-#line 11675 ""
+#line 11656 ""
if (ipm != 2) {
/* There is a vertical shift */
-#line 11679 ""
+#line 11660 ""
idyn = bit_set(idyn,16);
-#line 11680 ""
+#line 11661 ""
++(*iccount);
-#line 11681 ""
+#line 11662 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11682 ""
+#line 11663 ""
idno = i_nint(&fnum);
-#line 11683 ""
+#line 11664 ""
i__1 = (ipm - 2) * idno + 64;
-#line 11683 ""
+#line 11664 ""
setbits_(&idyn, &c__7, &c__17, &i__1);
-#line 11684 ""
+#line 11665 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1);
-#line 11685 ""
+#line 11666 ""
if (ipm != 2) {
/* There is a horizontal shift */
/* idynda2(ndyn) = ibset(idyn,23) */
-#line 11690 ""
+#line 11671 ""
comdyn_1.idynda2[comdyn_1.ndyn - 1] = bit_set(comdyn_1.idynda2[
comdyn_1.ndyn - 1],0);
-#line 11691 ""
+#line 11672 ""
++(*iccount);
-#line 11692 ""
+#line 11673 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11693 ""
+#line 11674 ""
r__1 = fnum * 10;
-#line 11693 ""
+#line 11674 ""
idno = i_nint(&r__1);
-#line 11694 ""
+#line 11675 ""
i__1 = (ipm - 2) * idno + 256;
-#line 11694 ""
+#line 11675 ""
setbits_(&comdyn_1.idynda2[comdyn_1.ndyn - 1], &c__9, &c__1, &
i__1);
-#line 11695 ""
+#line 11676 ""
}
/* iccount should be on the blank at the end of the entire symbol */
-#line 11699 ""
+#line 11680 ""
}
-#line 11700 ""
+#line 11681 ""
comdyn_1.idyndat[comdyn_1.ndyn - 1] = idyn;
-#line 11701 ""
+#line 11682 ""
return 0;
} /* getdyn_ */
@@ -28300,129 +28454,129 @@ L2:
extern integer ifnodur_(integer *, char *, ftnlen);
/* * itsofar,nodur,figq,ivupfig,nfigs) */
-#line 11710 ""
+#line 11691 ""
++(*nfigs);
-#line 11711 ""
+#line 11692 ""
*ivupfig = 0;
-#line 11712 ""
+#line 11693 ""
*ivvfig = 0;
-#line 11713 ""
+#line 11694 ""
*itoff = 0;
-#line 11714 ""
+#line 11695 ""
if (*(unsigned char *)charq == 'x') {
/* Floating figure. */
-#line 11718 ""
+#line 11699 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11719 ""
+#line 11700 ""
ici__1.icierr = 0;
-#line 11719 ""
+#line 11700 ""
ici__1.iciend = 0;
-#line 11719 ""
+#line 11700 ""
ici__1.icirnum = 1;
-#line 11719 ""
+#line 11700 ""
ici__1.icirlen = 1;
-#line 11719 ""
+#line 11700 ""
ici__1.iciunit = charq;
-#line 11719 ""
+#line 11700 ""
ici__1.icifmt = "(i1)";
-#line 11719 ""
+#line 11700 ""
s_rsfi(&ici__1);
-#line 11719 ""
+#line 11700 ""
do_fio(&c__1, (char *)&noff, (ftnlen)sizeof(integer));
-#line 11719 ""
+#line 11700 ""
e_rsfi();
-#line 11720 ""
+#line 11701 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11721 ""
+#line 11702 ""
ici__1.icierr = 0;
-#line 11721 ""
+#line 11702 ""
ici__1.iciend = 0;
-#line 11721 ""
+#line 11702 ""
ici__1.icirnum = 1;
-#line 11721 ""
+#line 11702 ""
ici__1.icirlen = 1;
-#line 11721 ""
+#line 11702 ""
ici__1.iciunit = charq;
-#line 11721 ""
+#line 11702 ""
ici__1.icifmt = "(i1)";
-#line 11721 ""
+#line 11702 ""
s_rsfi(&ici__1);
-#line 11721 ""
+#line 11702 ""
do_fio(&c__1, (char *)&loff, (ftnlen)sizeof(integer));
-#line 11721 ""
+#line 11702 ""
e_rsfi();
-#line 11722 ""
+#line 11703 ""
*itoff = noff * ifnodur_(&loff, "x", (ftnlen)1);
-#line 11723 ""
+#line 11704 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11724 ""
+#line 11705 ""
} else {
/* Figure on a note */
-#line 11728 ""
+#line 11709 ""
*isfig = TRUE_;
-#line 11729 ""
+#line 11710 ""
}
-#line 11730 ""
+#line 11711 ""
*itfig = *itsofar + *itoff - *nodur;
-#line 11731 ""
+#line 11712 ""
lfig = 1;
-#line 11732 ""
+#line 11713 ""
s_copy(figq, charq, (ftnlen)10, (ftnlen)1);
-#line 11733 ""
+#line 11714 ""
L5:
-#line 11733 ""
+#line 11714 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
/* if (index(' +',charq) .eq. 0) then */
-#line 11735 ""
+#line 11716 ""
if (i_indx(" +v", charq, (ftnlen)3, (ftnlen)1) == 0) {
/* Writing concatenation */
-#line 11736 ""
+#line 11717 ""
i__1[0] = lfig, a__1[0] = figq;
-#line 11736 ""
+#line 11717 ""
i__1[1] = 1, a__1[1] = charq;
-#line 11736 ""
+#line 11717 ""
s_cat(figq, a__1, i__1, &c__2, (ftnlen)10);
-#line 11737 ""
+#line 11718 ""
++lfig;
-#line 11738 ""
+#line 11719 ""
goto L5;
-#line 11739 ""
+#line 11720 ""
} else if (*(unsigned char *)charq == '+') {
/* Get vertical offset for figure. Next character after number has to be blank. */
-#line 11743 ""
+#line 11724 ""
++(*iccount);
-#line 11744 ""
+#line 11725 ""
readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11745 ""
+#line 11726 ""
*ivupfig = i_nint(&fnum);
-#line 11746 ""
+#line 11727 ""
} else if (*(unsigned char *)charq == 'v') {
/* Get vertical change in figdrop. Must be last item in figure word. */
-#line 11750 ""
+#line 11731 ""
isign = 1;
-#line 11751 ""
+#line 11732 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11752 ""
+#line 11733 ""
if (*(unsigned char *)charq == '-') {
-#line 11753 ""
+#line 11734 ""
isign = -1;
-#line 11754 ""
+#line 11735 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11755 ""
+#line 11736 ""
}
-#line 11756 ""
+#line 11737 ""
*ivvfig = isign * (*(unsigned char *)charq - 48);
-#line 11757 ""
+#line 11738 ""
}
-#line 11758 ""
+#line 11739 ""
return 0;
} /* getfig_ */
@@ -28460,289 +28614,289 @@ L5:
/* These data MUST precede note name of first note */
/* nolevg, naccg: lists of levels and accid's, indexed as described above. */
-#line 11792 ""
+#line 11773 ""
/* Parameter adjustments */
-#line 11792 ""
+#line 11773 ""
ndlev -= 25;
-#line 11792 ""
+#line 11773 ""
ipl -= 25;
-#line 11792 ""
+#line 11773 ""
--iornq;
-#line 11792 ""
+#line 11773 ""
islur -= 25;
-#line 11792 ""
+#line 11773 ""
--nnl;
-#line 11792 ""
+#line 11773 ""
-#line 11792 ""
+#line 11773 ""
/* Function Body */
-#line 11792 ""
+#line 11773 ""
++comgrace_1.ngrace;
-#line 11793 ""
+#line 11774 ""
comgrace_1.ivg[comgrace_1.ngrace - 1] = *ivx;
-#line 11794 ""
+#line 11775 ""
comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx] + 1;
-#line 11795 ""
+#line 11776 ""
if (comgrace_1.ngrace == 1) {
-#line 11796 ""
+#line 11777 ""
comgrace_1.ngstrt[comgrace_1.ngrace - 1] = 1;
-#line 11797 ""
+#line 11778 ""
} else {
-#line 11798 ""
+#line 11779 ""
comgrace_1.ngstrt[comgrace_1.ngrace - 1] = comgrace_1.ngstrt[
comgrace_1.ngrace - 2] + comgrace_1.nng[comgrace_1.ngrace - 2]
;
-#line 11799 ""
+#line 11780 ""
}
-#line 11800 ""
+#line 11781 ""
islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_set(islur[*ivx + (nnl[*ivx] + 1)
* 24],4);
-#line 11801 ""
+#line 11782 ""
comgrace_1.nng[comgrace_1.ngrace - 1] = 1;
-#line 11802 ""
+#line 11783 ""
comgrace_1.multg[comgrace_1.ngrace - 1] = 1;
-#line 11803 ""
+#line 11784 ""
comgrace_1.upg[comgrace_1.ngrace - 1] = TRUE_;
-#line 11804 ""
+#line 11785 ""
comgrace_1.slurg[comgrace_1.ngrace - 1] = FALSE_;
-#line 11805 ""
+#line 11786 ""
comgrace_1.slashg[comgrace_1.ngrace - 1] = FALSE_;
-#line 11806 ""
+#line 11787 ""
L18:
-#line 11806 ""
+#line 11787 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11807 ""
+#line 11788 ""
if (i_indx("WA", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Grace is on note that was already done, so shift flags forward one note. */
/* This puts flag on actual note with grace; later for W will go ahead one more. */
-#line 11812 ""
+#line 11793 ""
comgrace_1.ipg[comgrace_1.ngrace - 1] = nnl[*ivx];
-#line 11813 ""
+#line 11794 ""
islur[*ivx + (nnl[*ivx] + 1) * 24] = bit_clear(islur[*ivx + (nnl[*ivx]
+ 1) * 24],4);
-#line 11814 ""
+#line 11795 ""
islur[*ivx + nnl[*ivx] * 24] = bit_set(islur[*ivx + nnl[*ivx] * 24],4)
;
-#line 11815 ""
+#line 11796 ""
if (comgrace_1.slurg[comgrace_1.ngrace - 1]) {
-#line 11815 ""
+#line 11796 ""
iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx] *
24],24);
-#line 11815 ""
+#line 11796 ""
}
-#line 11817 ""
+#line 11798 ""
if (*(unsigned char *)charq == 'A') {
/* close After, clear way-after bit, to ensure priority of most recent A/W */
-#line 11821 ""
+#line 11802 ""
ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
ivx] * 24],31),29);
-#line 11822 ""
+#line 11803 ""
} else {
/* Way after; later assign to following note, and position like normal grace. */
-#line 11826 ""
+#line 11807 ""
ipl[*ivx + nnl[*ivx] * 24] = bit_set(bit_clear(ipl[*ivx + nnl[*
ivx] * 24],29),31);
-#line 11827 ""
+#line 11808 ""
}
-#line 11828 ""
+#line 11809 ""
} else if (*(unsigned char *)charq == 'm') {
-#line 11829 ""
+#line 11810 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11830 ""
+#line 11811 ""
comgrace_1.multg[comgrace_1.ngrace - 1] = *(unsigned char *)charq -
48;
-#line 11831 ""
+#line 11812 ""
} else if (i_indx("123456789", charq, (ftnlen)9, (ftnlen)1) > 0) {
-#line 11832 ""
+#line 11813 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11833 ""
+#line 11814 ""
--(*iccount);
-#line 11834 ""
+#line 11815 ""
comgrace_1.nng[comgrace_1.ngrace - 1] = i_nint(&fnum);
-#line 11835 ""
+#line 11816 ""
} else if (*(unsigned char *)charq == 'l') {
-#line 11836 ""
+#line 11817 ""
comgrace_1.upg[comgrace_1.ngrace - 1] = FALSE_;
-#line 11837 ""
+#line 11818 ""
} else if (*(unsigned char *)charq == 's') {
-#line 11838 ""
+#line 11819 ""
comgrace_1.slurg[comgrace_1.ngrace - 1] = TRUE_;
-#line 11839 ""
+#line 11820 ""
if (nnl[*ivx] > 0) {
/* If A- or W-grace, set signal to start slur on main note. */
-#line 11843 ""
+#line 11824 ""
if (bit_test(ipl[*ivx + nnl[*ivx] * 24],31) || bit_test(ipl[*ivx
+ nnl[*ivx] * 24],29)) {
-#line 11843 ""
+#line 11824 ""
iornq[*ivx + nnl[*ivx] * 24] = bit_set(iornq[*ivx + nnl[*ivx]
* 24],24);
-#line 11843 ""
+#line 11824 ""
}
-#line 11846 ""
+#line 11827 ""
}
-#line 11847 ""
+#line 11828 ""
} else if (*(unsigned char *)charq == 'x') {
-#line 11848 ""
+#line 11829 ""
comgrace_1.slashg[comgrace_1.ngrace - 1] = TRUE_;
-#line 11849 ""
+#line 11830 ""
} else if (*(unsigned char *)charq == 'u') {
-#line 11850 ""
+#line 11831 ""
} else if (*(unsigned char *)charq == 'X') {
/* Space before main note of grace. Number will come next. */
-#line 11854 ""
+#line 11835 ""
++(*iccount);
-#line 11855 ""
+#line 11836 ""
readnum_(lineq, iccount, durq, &comgrace_1.graspace[comgrace_1.ngrace
- 1], (ftnlen)128, (ftnlen)1);
-#line 11856 ""
+#line 11837 ""
--(*iccount);
-#line 11857 ""
+#line 11838 ""
}
-#line 11858 ""
+#line 11839 ""
if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) == 0) {
-#line 11858 ""
+#line 11839 ""
goto L18;
-#line 11858 ""
+#line 11839 ""
}
/* At this point, charq is first note name in grace */
-#line 11862 ""
+#line 11843 ""
i__1 = comgrace_1.ngstrt[comgrace_1.ngrace - 1] + comgrace_1.nng[
comgrace_1.ngrace - 1] - 1;
-#line 11862 ""
+#line 11843 ""
for (ing = comgrace_1.ngstrt[comgrace_1.ngrace - 1]; ing <= i__1; ++ing) {
-#line 11863 ""
+#line 11844 ""
comgrace_1.naccg[ing - 1] = 0;
-#line 11864 ""
+#line 11845 ""
ioct = 0;
-#line 11865 ""
+#line 11846 ""
if (ing > comgrace_1.ngstrt[comgrace_1.ngrace - 1]) {
-#line 11866 ""
+#line 11847 ""
L55:
-#line 11866 ""
+#line 11847 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 11867 ""
+#line 11848 ""
if (*(unsigned char *)charq == ' ') {
-#line 11867 ""
+#line 11848 ""
goto L55;
-#line 11867 ""
+#line 11848 ""
}
-#line 11868 ""
+#line 11849 ""
}
-#line 11869 ""
+#line 11850 ""
iclastlev = 0;
-#line 11870 ""
+#line 11851 ""
L9:
-#line 11870 ""
+#line 11851 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 11871 ""
+#line 11852 ""
if (*(unsigned char *)durq != ' ') {
-#line 11872 ""
+#line 11853 ""
if (*(unsigned char *)durq == '+') {
-#line 11873 ""
+#line 11854 ""
*lastlev += 7;
-#line 11874 ""
+#line 11855 ""
iclastlev += 7;
-#line 11875 ""
+#line 11856 ""
} else if (*(unsigned char *)durq == '-') {
-#line 11876 ""
+#line 11857 ""
*lastlev += -7;
-#line 11877 ""
+#line 11858 ""
iclastlev += -7;
-#line 11878 ""
+#line 11859 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
-#line 11879 ""
+#line 11860 ""
if (comgrace_1.naccg[ing - 1] == 0) {
-#line 11880 ""
+#line 11861 ""
comgrace_1.naccg[ing - 1] = i_indx("fsn", durq, (ftnlen)3,
(ftnlen)1);
-#line 11881 ""
+#line 11862 ""
} else {
/* Double accidental */
-#line 11885 ""
+#line 11866 ""
comgrace_1.naccg[ing - 1] = bit_set(comgrace_1.naccg[ing
- 1],2);
-#line 11886 ""
+#line 11867 ""
}
-#line 11887 ""
+#line 11868 ""
} else {
-#line 11888 ""
+#line 11869 ""
ioct = *(unsigned char *)durq - 48;
-#line 11889 ""
+#line 11870 ""
}
-#line 11890 ""
+#line 11871 ""
goto L9;
-#line 11891 ""
+#line 11872 ""
}
-#line 11892 ""
+#line 11873 ""
if (ioct > 0) {
-#line 11893 ""
+#line 11874 ""
*lastlev = ifnolev_(charq, &ioct, &cominsttrans_1.itransamt[
cominsttrans_1.instno[*iv - 1] - 1], (ftnlen)1);
-#line 11894 ""
+#line 11875 ""
} else {
-#line 11895 ""
+#line 11876 ""
if (nnl[*ivx] == 0 && ing == comgrace_1.ngstrt[comgrace_1.ngrace
- 1]) {
-#line 11896 ""
+#line 11877 ""
if (*ivx <= *nv) {
-#line 11897 ""
+#line 11878 ""
kv = 1;
-#line 11898 ""
+#line 11879 ""
} else {
-#line 11899 ""
+#line 11880 ""
kv = 2;
-#line 11900 ""
+#line 11881 ""
}
-#line 11901 ""
+#line 11882 ""
*lastlev = ndlev[*iv + kv * 24] + iclastlev;
-#line 11902 ""
+#line 11883 ""
}
-#line 11903 ""
+#line 11884 ""
*lastlev = *lastlev - 3 + (ifnolev_(charq, &c__10, &
cominsttrans_1.itransamt[cominsttrans_1.instno[*iv - 1] -
1], (ftnlen)1) - *lastlev + 3) % 7;
-#line 11905 ""
+#line 11886 ""
}
-#line 11906 ""
+#line 11887 ""
comgrace_1.nolevg[ing - 1] = *lastlev;
-#line 11907 ""
+#line 11888 ""
/* L19: */
-#line 11907 ""
+#line 11888 ""
}
/* Grace could come before first note of block, so reset end level. */
-#line 11911 ""
+#line 11892 ""
if (nnl[*ivx] == 0) {
-#line 11912 ""
+#line 11893 ""
if (*ivx <= *nv) {
-#line 11913 ""
+#line 11894 ""
kv = 1;
-#line 11914 ""
+#line 11895 ""
} else {
-#line 11915 ""
+#line 11896 ""
kv = 2;
-#line 11916 ""
+#line 11897 ""
}
-#line 11917 ""
+#line 11898 ""
ndlev[*iv + kv * 24] = *lastlev;
-#line 11918 ""
+#line 11899 ""
}
-#line 11919 ""
+#line 11900 ""
return 0;
} /* getgrace_ */
@@ -28798,166 +28952,166 @@ L9:
/* fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */
/* simplifies use of iTransAmt for all calls to ifnolev. */
-#line 11958 ""
+#line 11939 ""
*(unsigned char *)durq = 'x';
/* Can't initialize in declaration stmt, only works onc */
-#line 11959 ""
+#line 11940 ""
if (! cominsttrans_1.earlytranson) {
-#line 11959 ""
+#line 11940 ""
cominsttrans_1.earlytranson = *from1 && *ibarcnt == 0;
-#line 11959 ""
+#line 11940 ""
}
-#line 11960 ""
+#line 11941 ""
store = cominsttrans_1.earlytranson && *ibarcnt == 0 || *ibarcnt > 0 && !
(*from1);
-#line 11962 ""
+#line 11943 ""
cominsttrans_1.laterinsttrans = ! (*from1) && *ibarcnt > 0;
-#line 11963 ""
+#line 11944 ""
if (store) {
-#line 11963 ""
+#line 11944 ""
cominsttrans_1.ninsttrans = 0;
-#line 11963 ""
+#line 11944 ""
}
-#line 11964 ""
+#line 11945 ""
L1:
-#line 11965 ""
+#line 11946 ""
if (*(unsigned char *)durq == ' ') {
-#line 11965 ""
+#line 11946 ""
return 0;
-#line 11965 ""
+#line 11946 ""
}
-#line 11966 ""
+#line 11947 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 11967 ""
+#line 11948 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 11968 ""
+#line 11949 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 11968 ""
+#line 11949 ""
errmsg_(lineq, iccount, &i__1, "There must be an instrument number h"\
"ere!", (ftnlen)128, (ftnlen)40);
-#line 11970 ""
+#line 11951 ""
stop1_();
-#line 11971 ""
+#line 11952 ""
}
-#line 11972 ""
+#line 11953 ""
if (store) {
-#line 11972 ""
+#line 11953 ""
++cominsttrans_1.ninsttrans;
-#line 11972 ""
+#line 11953 ""
}
-#line 11973 ""
+#line 11954 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11974 ""
+#line 11955 ""
instn = i_nint(&fnum);
-#line 11975 ""
+#line 11956 ""
if (instn > *noinst) {
-#line 11976 ""
+#line 11957 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 11976 ""
+#line 11957 ""
errmsg_(lineq, iccount, &i__1, "Instrument number out of range!", (
ftnlen)128, (ftnlen)31);
-#line 11978 ""
+#line 11959 ""
stop1_();
-#line 11979 ""
+#line 11960 ""
}
-#line 11980 ""
+#line 11961 ""
if (store) {
-#line 11980 ""
+#line 11961 ""
cominsttrans_1.iinsttrans[cominsttrans_1.ninsttrans - 1] = instn;
-#line 11980 ""
+#line 11961 ""
}
/* durq is +/- following inst # (for iTransAmt), iccount is on it. */
-#line 11984 ""
+#line 11965 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 11985 ""
+#line 11966 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 11985 ""
+#line 11966 ""
errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe"\
"r must be \"+,-\"!", (ftnlen)128, (ftnlen)52);
-#line 11987 ""
+#line 11968 ""
stop1_();
-#line 11988 ""
+#line 11969 ""
}
-#line 11989 ""
+#line 11970 ""
itramt = 44 - *(unsigned char *)durq;
/* +1/-1 for itramt */
-#line 11990 ""
+#line 11971 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 11991 ""
+#line 11972 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 11992 ""
+#line 11973 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 11992 ""
+#line 11973 ""
errmsg_(lineq, iccount, &i__1, "There must be a transposition amount"\
" here!", (ftnlen)128, (ftnlen)42);
-#line 11994 ""
+#line 11975 ""
stop1_();
-#line 11995 ""
+#line 11976 ""
}
-#line 11996 ""
+#line 11977 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 11997 ""
+#line 11978 ""
if (store) {
-#line 11997 ""
+#line 11978 ""
cominsttrans_1.itransamt[instn - 1] = i_nint(&fnum) * itramt;
-#line 11997 ""
+#line 11978 ""
}
/* durq is +/- following iTransAmt (for iTransKey), iccount is on it. */
-#line 12001 ""
+#line 11982 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 12002 ""
+#line 11983 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12002 ""
+#line 11983 ""
errmsg_(lineq, iccount, &i__1, "1st character after transposition am"\
"ount must be \"+,-\"!", (ftnlen)128, (ftnlen)55);
-#line 12004 ""
+#line 11985 ""
stop1_();
-#line 12005 ""
+#line 11986 ""
}
-#line 12006 ""
+#line 11987 ""
ikey = 44 - *(unsigned char *)durq;
/* +1/-1 */
-#line 12007 ""
+#line 11988 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12008 ""
+#line 11989 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 12009 ""
+#line 11990 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12009 ""
+#line 11990 ""
errmsg_(lineq, iccount, &i__1, "There must be a key indicator here!",
(ftnlen)128, (ftnlen)35);
-#line 12011 ""
+#line 11992 ""
stop1_();
-#line 12012 ""
+#line 11993 ""
}
-#line 12013 ""
+#line 11994 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12014 ""
+#line 11995 ""
if (store) {
-#line 12014 ""
+#line 11995 ""
cominsttrans_1.itranskey[cominsttrans_1.ninsttrans - 1] = i_nint(&
fnum) * ikey;
-#line 12014 ""
+#line 11995 ""
}
/* durq is now 1st character after iTransKey, should be either 'i' or ' ' */
-#line 12018 ""
+#line 11999 ""
if (*(unsigned char *)durq != 'i' && *(unsigned char *)durq != ' ') {
-#line 12019 ""
+#line 12000 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12019 ""
+#line 12000 ""
errmsg_(lineq, iccount, &i__1, "There must be blank or \"i\" here!", (
ftnlen)128, (ftnlen)32);
-#line 12021 ""
+#line 12002 ""
stop1_();
-#line 12022 ""
+#line 12003 ""
}
-#line 12023 ""
+#line 12004 ""
goto L1;
} /* getitransinfo_ */
@@ -29001,8 +29155,8 @@ L1:
char *, real *, ftnlen, ftnlen);
/* Fortran I/O blocks */
- static cilist io___762 = { 0, 6, 0, "(a)", 0 };
- static cilist io___763 = { 0, 15, 0, "(a)", 0 };
+ static cilist io___761 = { 0, 6, 0, "(a)", 0 };
+ static cilist io___762 = { 0, 15, 0, "(a)", 0 };
@@ -29021,480 +29175,480 @@ L1:
/* bsXobXbaXclXflXreXctXvo */
-#line 12069 ""
+#line 12050 ""
L1:
-#line 12069 ""
+#line 12050 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12070 ""
+#line 12051 ""
if (*(unsigned char *)durq == 't') {
/* Tempo in beats ber minute */
-#line 12074 ""
+#line 12055 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12075 ""
+#line 12056 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 12076 ""
+#line 12057 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12076 ""
+#line 12057 ""
errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\
" pause!", (ftnlen)128, (ftnlen)39);
-#line 12078 ""
+#line 12059 ""
stop1_();
-#line 12079 ""
+#line 12060 ""
}
-#line 12080 ""
+#line 12061 ""
readnum_(lineq, iccount, durq, &qpm, (ftnlen)128, (ftnlen)1);
-#line 12081 ""
+#line 12062 ""
--(*iccount);
-#line 12082 ""
+#line 12063 ""
if (! (*first)) {
-#line 12083 ""
+#line 12064 ""
i__1 = i_nint(&qpm);
-#line 12083 ""
+#line 12064 ""
midievent_("t", &i__1, &c__0, (ftnlen)1);
-#line 12084 ""
+#line 12065 ""
commmac_1.gottempo = TRUE_;
-#line 12085 ""
+#line 12066 ""
}
-#line 12086 ""
+#line 12067 ""
goto L1;
-#line 12087 ""
+#line 12068 ""
} else if (*(unsigned char *)durq == 'p') {
/* Insert a pause. pausemid = pause in 1/4's */
-#line 12091 ""
+#line 12072 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12092 ""
+#line 12073 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) == 0) {
-#line 12093 ""
+#line 12074 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12093 ""
+#line 12074 ""
errmsg_(lineq, iccount, &i__1, "Expected a number here for the p"\
"ause!", (ftnlen)128, (ftnlen)37);
-#line 12095 ""
+#line 12076 ""
stop1_();
-#line 12096 ""
+#line 12077 ""
}
-#line 12097 ""
+#line 12078 ""
readnum_(lineq, iccount, durq, &pausemid, (ftnlen)128, (ftnlen)1);
-#line 12098 ""
+#line 12079 ""
--(*iccount);
-#line 12099 ""
+#line 12080 ""
if (! (*first)) {
/* Compute a meter for the pause. This is only to keep MidiNotate on track. */
/* Round pause to nearest 16th. Let denominator always be 16. */
-#line 12104 ""
+#line 12085 ""
r__1 = pausemid * 4;
-#line 12104 ""
+#line 12085 ""
numb16 = i_nint(&r__1);
-#line 12105 ""
+#line 12086 ""
midievent_("m", &numb16, &c__16, (ftnlen)1);
/* Put in pausemid beats of rest */
-#line 12109 ""
+#line 12090 ""
i__1 = commidi_1.numchan - 1;
-#line 12109 ""
+#line 12090 ""
for (icm = 0; icm <= i__1; ++icm) {
-#line 12110 ""
+#line 12091 ""
r__1 = numb16 * 4.f;
-#line 12110 ""
+#line 12091 ""
addmidi_(&icm, &c__0, &c__0, &c__0, &r__1, &c_true, &c_false);
-#line 12111 ""
+#line 12092 ""
/* L3: */
-#line 12111 ""
+#line 12092 ""
}
-#line 12112 ""
+#line 12093 ""
r__1 = pausemid * 240;
-#line 12112 ""
+#line 12093 ""
comevent_1.miditime += i_nint(&r__1);
/* Restore meter */
-#line 12116 ""
+#line 12097 ""
i__1 = *mtrdenl * *lenbar / 64;
-#line 12116 ""
+#line 12097 ""
midievent_("m", &i__1, mtrdenl, (ftnlen)1);
-#line 12117 ""
+#line 12098 ""
}
-#line 12118 ""
+#line 12099 ""
goto L1;
-#line 12119 ""
+#line 12100 ""
} else if (*(unsigned char *)durq == 'i') {
/* Instrument numbers or letters. Expect noinst of them. */
-#line 12123 ""
+#line 12104 ""
i__1 = *noinstarg;
-#line 12123 ""
+#line 12104 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
-#line 12124 ""
+#line 12105 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12125 ""
+#line 12106 ""
if (*(unsigned char *)durq > 96) {
/* It's a lowercase letter. Get another, find corr. instrument #. */
-#line 12129 ""
+#line 12110 ""
*(unsigned char *)instq = *(unsigned char *)durq;
-#line 12130 ""
+#line 12111 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Writing concatenation */
-#line 12131 ""
+#line 12112 ""
i__2[0] = 1, a__1[0] = instq;
-#line 12131 ""
+#line 12112 ""
i__2[1] = 1, a__1[1] = durq;
-#line 12131 ""
+#line 12112 ""
s_cat(instq, a__1, i__2, &c__2, (ftnlen)2);
-#line 12132 ""
+#line 12113 ""
iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX"\
"frXsoXalXteXbsXobXbaXclXflXreXctXvo", instq, (ftnlen)
79, (ftnlen)2) / 3;
-#line 12134 ""
+#line 12115 ""
if (iname == 0) {
-#line 12135 ""
+#line 12116 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12135 ""
+#line 12116 ""
errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi"\
"di instrument name!", (ftnlen)128, (ftnlen)43);
-#line 12137 ""
+#line 12118 ""
stop1_();
-#line 12138 ""
+#line 12119 ""
}
-#line 12139 ""
+#line 12120 ""
commidi_1.midinst[ivx - 1] = midinum[iname - 1] - 1;
-#line 12140 ""
+#line 12121 ""
} else {
/* Expect a number, followed by ":" if that is followed by another number. */
/* I.e., if after call to readnum, durq is not ":", it must be either blank */
/* or next instrument letter. */
-#line 12146 ""
+#line 12127 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 12147 ""
+#line 12128 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12147 ""
+#line 12128 ""
errmsg_(lineq, iccount, &i__3, "Expected a midi instrume"\
"nt number here!", (ftnlen)128, (ftnlen)39);
-#line 12149 ""
+#line 12130 ""
stop1_();
-#line 12150 ""
+#line 12131 ""
}
-#line 12151 ""
+#line 12132 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12152 ""
+#line 12133 ""
commidi_1.midinst[ivx - 1] = i_nint(&fnum) - 1;
-#line 12153 ""
+#line 12134 ""
if (commidi_1.midinst[ivx - 1] < 0 || commidi_1.midinst[ivx -
1] > 255) {
-#line 12154 ""
+#line 12135 ""
i__3 = *iccount - 1;
-#line 12154 ""
+#line 12135 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12154 ""
+#line 12135 ""
errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus"\
"t be in range 1-128!", (ftnlen)128, (ftnlen)46);
-#line 12156 ""
+#line 12137 ""
stop1_();
-#line 12157 ""
+#line 12138 ""
}
-#line 12158 ""
+#line 12139 ""
if (*(unsigned char *)durq != ':') {
-#line 12158 ""
+#line 12139 ""
--(*iccount);
-#line 12158 ""
+#line 12139 ""
}
-#line 12159 ""
+#line 12140 ""
}
-#line 12160 ""
+#line 12141 ""
/* L2: */
-#line 12160 ""
+#line 12141 ""
}
-#line 12161 ""
+#line 12142 ""
goto L1;
-#line 12162 ""
+#line 12143 ""
} else if (*(unsigned char *)durq == 'v') {
/* Get volumes for each instrument. Expect noinst of them. */
/* Follow same pattern as for insttrument numbers above. */
-#line 12167 ""
+#line 12148 ""
i__1 = *noinstarg;
-#line 12167 ""
+#line 12148 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
-#line 12168 ""
+#line 12149 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12169 ""
+#line 12150 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 12170 ""
+#line 12151 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12170 ""
+#line 12151 ""
errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num"\
"ber here!", (ftnlen)128, (ftnlen)37);
-#line 12172 ""
+#line 12153 ""
stop1_();
-#line 12173 ""
+#line 12154 ""
}
-#line 12174 ""
+#line 12155 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12175 ""
+#line 12156 ""
commvel_2.midivel[ivx - 1] = i_nint(&fnum) - 1;
-#line 12176 ""
+#line 12157 ""
if (commvel_2.midivel[ivx - 1] < 0 || commvel_2.midivel[ivx - 1]
> 127) {
-#line 12177 ""
+#line 12158 ""
i__3 = *iccount - 1;
-#line 12177 ""
+#line 12158 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12177 ""
+#line 12158 ""
errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range"\
" 1-128!", (ftnlen)128, (ftnlen)37);
-#line 12179 ""
+#line 12160 ""
stop1_();
-#line 12180 ""
+#line 12161 ""
}
-#line 12181 ""
+#line 12162 ""
if (*(unsigned char *)durq != ':') {
-#line 12181 ""
+#line 12162 ""
--(*iccount);
-#line 12181 ""
+#line 12162 ""
}
-#line 12182 ""
+#line 12163 ""
/* L7: */
-#line 12182 ""
+#line 12163 ""
}
-#line 12183 ""
+#line 12164 ""
if (! (*first)) {
-#line 12184 ""
+#line 12165 ""
inst2chan_(commvel_2.midvelc, commvel_2.midivel,
commidi_1.midchan, nv, commvel_2.iinsiv,
commidi_1.twoline);
-#line 12185 ""
+#line 12166 ""
}
-#line 12186 ""
+#line 12167 ""
goto L1;
-#line 12187 ""
+#line 12168 ""
} else if (*(unsigned char *)durq == 'b') {
/* Get balance for each instrument. Expect noinst of them. */
/* Follow same pattern as for instrument numbers above. */
-#line 12192 ""
+#line 12173 ""
i__1 = *noinstarg;
-#line 12192 ""
+#line 12173 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
-#line 12193 ""
+#line 12174 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12194 ""
+#line 12175 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 12195 ""
+#line 12176 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12195 ""
+#line 12176 ""
errmsg_(lineq, iccount, &i__3, "Expected a balance number he"\
"re!", (ftnlen)128, (ftnlen)31);
-#line 12197 ""
+#line 12178 ""
stop1_();
-#line 12198 ""
+#line 12179 ""
}
-#line 12199 ""
+#line 12180 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12200 ""
+#line 12181 ""
commvel_2.midibal[ivx - 1] = i_nint(&fnum) - 1;
-#line 12201 ""
+#line 12182 ""
if (commvel_2.midibal[ivx - 1] < 0 || commvel_2.midibal[ivx - 1]
> 127) {
-#line 12202 ""
+#line 12183 ""
i__3 = *iccount - 1;
-#line 12202 ""
+#line 12183 ""
i__4 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12202 ""
+#line 12183 ""
errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range "\
"1-128!", (ftnlen)128, (ftnlen)36);
-#line 12204 ""
+#line 12185 ""
stop1_();
-#line 12205 ""
+#line 12186 ""
}
-#line 12206 ""
+#line 12187 ""
if (*(unsigned char *)durq != ':') {
-#line 12206 ""
+#line 12187 ""
--(*iccount);
-#line 12206 ""
+#line 12187 ""
}
-#line 12207 ""
+#line 12188 ""
/* L8: */
-#line 12207 ""
+#line 12188 ""
}
-#line 12208 ""
+#line 12189 ""
if (! (*first)) {
-#line 12209 ""
+#line 12190 ""
inst2chan_(commvel_2.midbc, commvel_2.midibal, commidi_1.midchan,
nv, commvel_2.iinsiv, commidi_1.twoline);
-#line 12210 ""
+#line 12191 ""
}
-#line 12211 ""
+#line 12192 ""
goto L1;
-#line 12212 ""
+#line 12193 ""
} else if (*(unsigned char *)durq == 'T') {
/* Get transposition for each instrument. Expect noinst of them. */
/* Follow similar pattern as above, but separator is +|-. */
-#line 12217 ""
+#line 12198 ""
i__1 = *noinstarg;
-#line 12217 ""
+#line 12198 ""
for (ivx = 1; ivx <= i__1; ++ivx) {
-#line 12218 ""
+#line 12199 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12219 ""
+#line 12200 ""
ipm = i_indx("-+", durq, (ftnlen)2, (ftnlen)1);
-#line 12220 ""
+#line 12201 ""
if (ipm == 0) {
-#line 12221 ""
+#line 12202 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12221 ""
+#line 12202 ""
errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for "\
"midi transposition here!", (ftnlen)128, (ftnlen)48);
-#line 12223 ""
+#line 12204 ""
stop1_();
-#line 12224 ""
+#line 12205 ""
}
-#line 12225 ""
+#line 12206 ""
ipm = (ipm << 1) - 3;
-#line 12226 ""
+#line 12207 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12227 ""
+#line 12208 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 12228 ""
+#line 12209 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12228 ""
+#line 12209 ""
errmsg_(lineq, iccount, &i__3, "Expected a number here!", (
ftnlen)128, (ftnlen)23);
-#line 12230 ""
+#line 12211 ""
stop1_();
-#line 12231 ""
+#line 12212 ""
}
-#line 12232 ""
+#line 12213 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12233 ""
+#line 12214 ""
commvel_2.miditran[ivx - 1] = ipm * i_nint(&fnum);
/* if (mod(miditran(ivx),12).ne. 0) then */
/* call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, */
/* * 'Midi transposition limited to multiples of 12!') */
/* call stop1() */
/* end if */
-#line 12239 ""
+#line 12220 ""
--(*iccount);
-#line 12240 ""
+#line 12221 ""
/* L9: */
-#line 12240 ""
+#line 12221 ""
}
-#line 12241 ""
+#line 12222 ""
if (! (*first)) {
-#line 12242 ""
+#line 12223 ""
inst2chan_(commvel_2.midtc, commvel_2.miditran, commidi_1.midchan,
nv, commvel_2.iinsiv, commidi_1.twoline);
-#line 12243 ""
+#line 12224 ""
}
-#line 12244 ""
+#line 12225 ""
goto L1;
-#line 12245 ""
+#line 12226 ""
} else if (*(unsigned char *)durq == 'g') {
-#line 12246 ""
+#line 12227 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12247 ""
+#line 12228 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 12248 ""
+#line 12229 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12248 ""
+#line 12229 ""
errmsg_(lineq, iccount, &i__1, "Expected an integer here for the"\
" midi gap!", (ftnlen)128, (ftnlen)42);
-#line 12250 ""
+#line 12231 ""
stop1_();
-#line 12251 ""
+#line 12232 ""
}
-#line 12252 ""
+#line 12233 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12253 ""
+#line 12234 ""
commidi_1.mgap = i_nint(&fnum);
-#line 12254 ""
+#line 12235 ""
--(*iccount);
-#line 12255 ""
+#line 12236 ""
goto L1;
-#line 12256 ""
+#line 12237 ""
} else if (*(unsigned char *)durq == 'M') {
/* MidiMacros */
-#line 12260 ""
+#line 12241 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12261 ""
+#line 12242 ""
if (*(unsigned char *)durq == 'R') {
/* Start recording */
-#line 12265 ""
+#line 12246 ""
if (commmac_1.mmacrec) {
-#line 12266 ""
+#line 12247 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12266 ""
+#line 12247 ""
errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa"\
"cro while already recording!", (ftnlen)128, (ftnlen)
56);
-#line 12268 ""
+#line 12249 ""
stop1_();
-#line 12269 ""
+#line 12250 ""
}
-#line 12270 ""
+#line 12251 ""
commmac_1.mmacrec = TRUE_;
-#line 12271 ""
+#line 12252 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12272 ""
+#line 12253 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 12273 ""
+#line 12254 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12273 ""
+#line 12254 ""
errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\
" here!", (ftnlen)128, (ftnlen)34);
-#line 12275 ""
+#line 12256 ""
stop1_();
-#line 12276 ""
+#line 12257 ""
}
-#line 12277 ""
+#line 12258 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12278 ""
+#line 12259 ""
--(*iccount);
-#line 12279 ""
+#line 12260 ""
if (! (*first)) {
-#line 12280 ""
+#line 12261 ""
commmac_1.immac = i_nint(&fnum);
-#line 12281 ""
+#line 12262 ""
if (commmac_1.immac > 20) {
-#line 12282 ""
+#line 12263 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12282 ""
+#line 12263 ""
errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce"\
"ed 20!", (ftnlen)128, (ftnlen)30);
-#line 12284 ""
+#line 12265 ""
stop1_();
-#line 12285 ""
+#line 12266 ""
}
/* Save the start time */
-#line 12289 ""
+#line 12270 ""
commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime;
-#line 12290 ""
+#line 12271 ""
i__1 = commidi_1.numchan;
-#line 12290 ""
+#line 12271 ""
for (icm = 0; icm <= i__1; ++icm) {
-#line 12291 ""
+#line 12272 ""
if (icm < commidi_1.numchan) {
-#line 12292 ""
+#line 12273 ""
if (commidi_1.restpend[icm]) {
/* Adjust if there's a rest at end of prior section. Insert dummy turnoff. */
@@ -29503,294 +29657,294 @@ L1:
/* Before: section1 ------rest------- section2(to be recorded) */
/* After: section1 rest1 now rest2 section2(recorded) */
-#line 12300 ""
+#line 12281 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
-#line 12301 ""
+#line 12282 ""
commidi_1.trest[icm] = 0.f;
-#line 12302 ""
+#line 12283 ""
commidi_1.restpend[icm] = FALSE_;
-#line 12303 ""
+#line 12284 ""
}
-#line 12304 ""
+#line 12285 ""
} else {
-#line 12305 ""
+#line 12286 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track */
-#line 12309 ""
+#line 12290 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
-#line 12309 ""
+#line 12290 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
-#line 12311 ""
+#line 12292 ""
comevent_1.lasttime = comevent_1.miditime;
-#line 12312 ""
+#line 12293 ""
}
-#line 12313 ""
+#line 12294 ""
}
-#line 12314 ""
+#line 12295 ""
commmac_1.mmacstrt[icm + commmac_1.immac * 25 - 25] =
commidi_1.imidi[icm] + 1;
-#line 12315 ""
+#line 12296 ""
/* L4: */
-#line 12315 ""
+#line 12296 ""
}
-#line 12316 ""
+#line 12297 ""
}
-#line 12317 ""
+#line 12298 ""
goto L1;
-#line 12318 ""
+#line 12299 ""
} else if (i_indx("123456789P", durq, (ftnlen)10, (ftnlen)1) == 0) {
/* End recording; close the open macro. Get immac from common. */
-#line 12322 ""
+#line 12303 ""
if (! commmac_1.mmacrec) {
-#line 12323 ""
+#line 12304 ""
i__1 = *iccount - 1;
-#line 12323 ""
+#line 12304 ""
i__3 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12323 ""
+#line 12304 ""
errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b"\
"efore starting one!", (ftnlen)128, (ftnlen)49);
-#line 12325 ""
+#line 12306 ""
stop1_();
-#line 12326 ""
+#line 12307 ""
}
-#line 12327 ""
+#line 12308 ""
commmac_1.mmacrec = FALSE_;
-#line 12328 ""
+#line 12309 ""
--(*iccount);
-#line 12329 ""
+#line 12310 ""
if (! (*first)) {
/* Save the macro duration */
-#line 12333 ""
+#line 12314 ""
commmac_1.mmactime[commmac_1.immac - 1] = comevent_1.miditime
- commmac_1.mmactime[commmac_1.immac - 1];
-#line 12334 ""
+#line 12315 ""
i__1 = commidi_1.numchan;
-#line 12334 ""
+#line 12315 ""
for (icm = 0; icm <= i__1; ++icm) {
-#line 12335 ""
+#line 12316 ""
if (icm < commidi_1.numchan) {
-#line 12336 ""
+#line 12317 ""
if (commidi_1.restpend[icm]) {
-#line 12337 ""
+#line 12318 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
-#line 12338 ""
+#line 12319 ""
commidi_1.trest[icm] = 0.f;
-#line 12339 ""
+#line 12320 ""
commidi_1.restpend[icm] = FALSE_;
-#line 12340 ""
+#line 12321 ""
}
-#line 12341 ""
+#line 12322 ""
} else {
-#line 12342 ""
+#line 12323 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track if needed. */
-#line 12346 ""
+#line 12327 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
-#line 12346 ""
+#line 12327 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
-#line 12348 ""
+#line 12329 ""
comevent_1.lasttime = comevent_1.miditime;
-#line 12349 ""
+#line 12330 ""
}
-#line 12350 ""
+#line 12331 ""
}
-#line 12351 ""
+#line 12332 ""
commmac_1.mmacend[icm + commmac_1.immac * 25 - 25] =
commidi_1.imidi[icm];
-#line 12352 ""
+#line 12333 ""
/* L5: */
-#line 12352 ""
+#line 12333 ""
}
-#line 12353 ""
+#line 12334 ""
}
-#line 12354 ""
+#line 12335 ""
if (*(unsigned char *)durq != ' ') {
-#line 12354 ""
+#line 12335 ""
goto L1;
-#line 12354 ""
+#line 12335 ""
}
-#line 12355 ""
+#line 12336 ""
} else if (*(unsigned char *)durq == 'P') {
/* Play Back a Macro */
-#line 12359 ""
+#line 12340 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12360 ""
+#line 12341 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 12361 ""
+#line 12342 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12361 ""
+#line 12342 ""
errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number"\
" here!", (ftnlen)128, (ftnlen)34);
-#line 12363 ""
+#line 12344 ""
stop1_();
-#line 12364 ""
+#line 12345 ""
}
-#line 12365 ""
+#line 12346 ""
if (commmac_1.mmacrec) {
-#line 12366 ""
+#line 12347 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12366 ""
+#line 12347 ""
errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr"\
"o before ending recording!", (ftnlen)128, (ftnlen)54);
-#line 12368 ""
+#line 12349 ""
stop1_();
-#line 12369 ""
+#line 12350 ""
}
-#line 12370 ""
+#line 12351 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 12371 ""
+#line 12352 ""
--(*iccount);
-#line 12372 ""
+#line 12353 ""
if (! (*first)) {
-#line 12373 ""
+#line 12354 ""
commmac_1.immac = i_nint(&fnum);
-#line 12374 ""
+#line 12355 ""
if (commmac_1.mmactime[commmac_1.immac - 1] == 0) {
-#line 12375 ""
+#line 12356 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12375 ""
+#line 12356 ""
errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro"\
" before recording it!", (ftnlen)128, (ftnlen)45);
-#line 12377 ""
+#line 12358 ""
stop1_();
-#line 12378 ""
+#line 12359 ""
}
-#line 12379 ""
+#line 12360 ""
i__1 = commidi_1.numchan;
-#line 12379 ""
+#line 12360 ""
for (icm = 0; icm <= i__1; ++icm) {
-#line 12380 ""
+#line 12361 ""
if (icm < commidi_1.numchan) {
-#line 12381 ""
+#line 12362 ""
if (commidi_1.restpend[icm]) {
-#line 12382 ""
+#line 12363 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &
commidi_1.trest[icm], &c_false, &c_true);
-#line 12383 ""
+#line 12364 ""
commidi_1.trest[icm] = 0.f;
-#line 12384 ""
+#line 12365 ""
commidi_1.restpend[icm] = FALSE_;
-#line 12385 ""
+#line 12366 ""
}
-#line 12386 ""
+#line 12367 ""
} else {
-#line 12387 ""
+#line 12368 ""
if (comevent_1.miditime > comevent_1.lasttime) {
/* Insert a dummy turnoff in conductor track */
-#line 12391 ""
+#line 12372 ""
r__1 = (comevent_1.miditime - comevent_1.lasttime)
/ 15.f;
-#line 12391 ""
+#line 12372 ""
addmidi_(&icm, &c__30, &c__0, &c__0, &r__1, &
c_false, &c_true);
-#line 12393 ""
+#line 12374 ""
}
-#line 12394 ""
+#line 12375 ""
}
-#line 12395 ""
+#line 12376 ""
commmac_1.msecend[icm + commmac_1.nmidsec * 25 - 25] =
commidi_1.imidi[icm];
-#line 12396 ""
+#line 12377 ""
commmac_1.msecstrt[icm + (commmac_1.nmidsec + 1) * 25 -
25] = commmac_1.mmacstrt[icm + commmac_1.immac *
25 - 25];
-#line 12397 ""
+#line 12378 ""
commmac_1.msecend[icm + (commmac_1.nmidsec + 1) * 25 - 25]
= commmac_1.mmacend[icm + commmac_1.immac * 25 -
25];
-#line 12398 ""
+#line 12379 ""
commmac_1.msecstrt[icm + (commmac_1.nmidsec + 2) * 25 -
25] = commidi_1.imidi[icm] + 1;
-#line 12399 ""
+#line 12380 ""
/* L6: */
-#line 12399 ""
+#line 12380 ""
}
-#line 12400 ""
+#line 12381 ""
commmac_1.nmidsec += 2;
/* Update running time */
-#line 12404 ""
+#line 12385 ""
comevent_1.miditime += commmac_1.mmactime[commmac_1.immac - 1]
;
-#line 12405 ""
+#line 12386 ""
comevent_1.lasttime = comevent_1.miditime;
-#line 12406 ""
+#line 12387 ""
}
-#line 12407 ""
+#line 12388 ""
goto L1;
-#line 12408 ""
+#line 12389 ""
} else {
-#line 12409 ""
+#line 12390 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12409 ""
+#line 12390 ""
errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s"\
"ub-command!", (ftnlen)128, (ftnlen)43);
-#line 12411 ""
+#line 12392 ""
stop1_();
-#line 12412 ""
+#line 12393 ""
}
-#line 12413 ""
+#line 12394 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 12414 ""
+#line 12395 ""
commidi_1.debugmidi = TRUE_;
-#line 12415 ""
+#line 12396 ""
goto L1;
-#line 12416 ""
+#line 12397 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 12417 ""
+#line 12398 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 12417 ""
+#line 12398 ""
errmsg_(lineq, iccount, &i__1, "Illegal character in MIDI input data!"
, (ftnlen)128, (ftnlen)37);
-#line 12419 ""
- s_wsfe(&io___762);
-#line 12419 ""
+#line 12400 ""
+ s_wsfe(&io___761);
+#line 12400 ""
do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\
"should be noinst, not nv", (ftnlen)77);
-#line 12419 ""
+#line 12400 ""
e_wsfe();
-#line 12422 ""
- s_wsfe(&io___763);
-#line 12422 ""
+#line 12403 ""
+ s_wsfe(&io___762);
+#line 12403 ""
do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, "\
"should be noinst, not nv", (ftnlen)77);
-#line 12422 ""
+#line 12403 ""
e_wsfe();
-#line 12425 ""
+#line 12406 ""
stop1_();
-#line 12426 ""
+#line 12407 ""
}
-#line 12427 ""
+#line 12408 ""
if (! commmac_1.gottempo && ! (*first)) {
/* If no tempo is set on first call on the pmxb pass, then set it */
-#line 12431 ""
+#line 12412 ""
midievent_("t", &c__96, &c__0, (ftnlen)1);
-#line 12432 ""
+#line 12413 ""
commmac_1.gottempo = TRUE_;
-#line 12433 ""
+#line 12414 ""
}
-#line 12434 ""
+#line 12415 ""
return 0;
} /* getmidi_ */
@@ -29912,37 +30066,38 @@ L1:
static integer lvoltxt, ltopnam;
/* Fortran I/O blocks */
- static cilist io___768 = { 0, 11, 0, "(a)", 0 };
- static cilist io___776 = { 0, 6, 0, 0, 0 };
+ static cilist io___767 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___775 = { 0, 6, 0, 0, 0 };
+ static cilist io___786 = { 0, 6, 0, 0, 0 };
static cilist io___787 = { 0, 6, 0, 0, 0 };
- static cilist io___788 = { 0, 6, 0, 0, 0 };
+ static cilist io___798 = { 0, 6, 0, 0, 0 };
static cilist io___799 = { 0, 6, 0, 0, 0 };
- static cilist io___800 = { 0, 6, 0, 0, 0 };
+ static cilist io___815 = { 0, 6, 0, 0, 0 };
static cilist io___816 = { 0, 6, 0, 0, 0 };
static cilist io___817 = { 0, 6, 0, 0, 0 };
- static cilist io___818 = { 0, 6, 0, 0, 0 };
- static cilist io___820 = { 0, 6, 0, 0, 0 };
+ static cilist io___819 = { 0, 6, 0, 0, 0 };
+ static cilist io___824 = { 0, 11, 0, "(a)", 0 };
static cilist io___825 = { 0, 11, 0, "(a)", 0 };
- static cilist io___826 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___828 = { 0, 11, 0, "(a)", 0 };
static cilist io___829 = { 0, 11, 0, "(a)", 0 };
static cilist io___830 = { 0, 11, 0, "(a)", 0 };
static cilist io___831 = { 0, 11, 0, "(a)", 0 };
static cilist io___832 = { 0, 11, 0, "(a)", 0 };
- static cilist io___833 = { 0, 11, 0, "(a)", 0 };
- static cilist io___834 = { 0, 11, 0, "(a11,i2,a)", 0 };
- static cilist io___835 = { 0, 11, 0, "(a9,i2,a)", 0 };
- static cilist io___837 = { 0, 11, 0, "(a8,i1,a3)", 0 };
- static cilist io___838 = { 0, 11, 0, "(a9,i2,a4)", 0 };
- static cilist io___839 = { 0, 11, 0, "(a8,i1,a)", 0 };
- static cilist io___840 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___833 = { 0, 11, 0, "(a11,i2,a)", 0 };
+ static cilist io___834 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___836 = { 0, 11, 0, "(a8,i1,a3)", 0 };
+ static cilist io___837 = { 0, 11, 0, "(a9,i2,a4)", 0 };
+ static cilist io___838 = { 0, 11, 0, "(a8,i1,a)", 0 };
+ static cilist io___839 = { 0, 11, 0, "(a9,i2,a)", 0 };
+ static cilist io___840 = { 0, 6, 0, 0, 0 };
static cilist io___841 = { 0, 6, 0, 0, 0 };
- static cilist io___842 = { 0, 6, 0, 0, 0 };
- static cilist io___851 = { 0, 6, 0, 0, 0 };
+ static cilist io___850 = { 0, 6, 0, 0, 0 };
+ static cilist io___852 = { 0, 11, 0, "(a)", 0 };
static cilist io___853 = { 0, 11, 0, "(a)", 0 };
static cilist io___854 = { 0, 11, 0, "(a)", 0 };
static cilist io___855 = { 0, 11, 0, "(a)", 0 };
- static cilist io___856 = { 0, 11, 0, "(a)", 0 };
- static cilist io___858 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___857 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___860 = { 0, 11, 0, "(a)", 0 };
static cilist io___861 = { 0, 11, 0, "(a)", 0 };
static cilist io___862 = { 0, 11, 0, "(a)", 0 };
static cilist io___863 = { 0, 11, 0, "(a)", 0 };
@@ -29950,108 +30105,110 @@ L1:
static cilist io___865 = { 0, 11, 0, "(a)", 0 };
static cilist io___866 = { 0, 11, 0, "(a)", 0 };
static cilist io___867 = { 0, 11, 0, "(a)", 0 };
- static cilist io___868 = { 0, 11, 0, "(a)", 0 };
/* nvmx is either 1 or 2. ivmx(iv,1)=iv, ; ivmx(iv,2)>nv if defined */
/* ivx is current ivmx, and is the index for all notes, acc's etc. */
-#line 12560 ""
+#line 12541 ""
cdot = FALSE_;
-#line 12561 ""
+#line 12542 ""
inxtup = FALSE_;
-#line 12562 ""
+#line 12543 ""
L1:
-#line 12562 ""
+#line 12543 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 12563 ""
+#line 12544 ""
if (comget_1.lastchar) {
-#line 12563 ""
+#line 12544 ""
return 0;
-#line 12563 ""
+#line 12544 ""
}
-#line 12564 ""
+#line 12545 ""
if (*(unsigned char *)charq == ' ') {
-#line 12564 ""
+#line 12545 ""
goto L1;
-#line 12564 ""
+#line 12545 ""
}
-#line 12565 ""
+#line 12546 ""
if (*(unsigned char *)charq == '%') {
/* Check for a bar number format: */
-#line 12569 ""
+#line 12550 ""
if (all_1.iccount == 1 && *(unsigned char *)&lineq[1] == ' ' &&
i_indx("bB1234567890", lineq + 2, (ftnlen)12, (ftnlen)1) > 0)
{
-#line 12571 ""
+#line 12552 ""
if (comlast_1.islast) {
-#line 12571 ""
- s_wsfe(&io___768);
-#line 12571 ""
+#line 12552 ""
+ s_wsfe(&io___767);
+#line 12552 ""
do_fio(&c__1, lineq, lenstr_(lineq, &c__128, (ftnlen)128));
-#line 12571 ""
+#line 12552 ""
e_wsfe();
-#line 12571 ""
+#line 12552 ""
}
-#line 12572 ""
+#line 12553 ""
}
-#line 12573 ""
+#line 12554 ""
all_1.iccount = 128;
-#line 12574 ""
+#line 12555 ""
goto L1;
-#line 12575 ""
+#line 12556 ""
}
/* Closing repeat iff charq='/' and the prev. char was 'R' with 'd' or 'r' */
-#line 12579 ""
+#line 12560 ""
if (comget_1.rptprev) {
-#line 12580 ""
- comget_1.rptnd1 = *(unsigned char *)charq == '/';
-#line 12581 ""
+#line 12561 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 12561 ""
+ comget_1.rptnd1 = *(unsigned char *)charq == *(unsigned char *)&ch__1[
+ 0];
+#line 12562 ""
comget_1.rptprev = FALSE_;
-#line 12582 ""
+#line 12563 ""
}
/* Repeat at end of a piece */
-#line 12586 ""
+#line 12567 ""
if (*(unsigned char *)charq >= 97 && *(unsigned char *)charq <= 103 || *(
unsigned char *)charq == 'r') {
-#line 12588 ""
+#line 12569 ""
if (cdot) {
-#line 12588 ""
+#line 12569 ""
goto L28;
-#line 12588 ""
+#line 12569 ""
}
/* This is a note/rest. */
-#line 12592 ""
+#line 12573 ""
idotform = 0;
-#line 12593 ""
+#line 12574 ""
numnum = 0;
/* If start of line of music, set pitch from previous */
-#line 12597 ""
+#line 12578 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 12598 ""
+#line 12579 ""
kv = 1;
-#line 12599 ""
+#line 12580 ""
} else {
-#line 12600 ""
+#line 12581 ""
kv = 2;
-#line 12601 ""
+#line 12582 ""
}
-#line 12602 ""
+#line 12583 ""
if (all_1.nnl[commvl_1.ivx - 1] == 0) {
-#line 12602 ""
+#line 12583 ""
comnotes_1.lastlev = comnotes_1.ndlev[all_1.iv + kv * 24 - 25];
-#line 12602 ""
+#line 12583 ""
}
/* notcrd is used to tell if orn. goes on main note or chord note */
@@ -30060,63 +30217,63 @@ L1:
/* Increase note count, then loop 'til blank. Label 28 is for dotted shortcuts. */
-#line 12610 ""
+#line 12591 ""
L28:
/* Moved this from just above, 2 Feb 02 */
-#line 12614 ""
+#line 12595 ""
comnotes_1.notcrd = TRUE_;
-#line 12615 ""
+#line 12596 ""
++all_1.nnl[commvl_1.ivx - 1];
-#line 12616 ""
+#line 12597 ""
if (comget_1.ornrpt) {
/* Replicate ornament bits, also bit 23 for beam handling if chord. */
-#line 12620 ""
+#line 12601 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1]
|= all_1.iornq[commvl_1.ivx - 1];
-#line 12621 ""
+#line 12602 ""
if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24
- 1] & 32896) > 0) {
/* This is a trill (bit 7 or 15) so must dup the parameters */
-#line 12625 ""
+#line 12606 ""
++comtrill_1.ntrill;
-#line 12626 ""
+#line 12607 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
-#line 12627 ""
+#line 12608 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
-#line 12628 ""
+#line 12609 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] = comtrill_1.xnsktr[
comtrill_1.ntrill - 2];
-#line 12629 ""
+#line 12610 ""
}
-#line 12630 ""
+#line 12611 ""
}
-#line 12631 ""
+#line 12612 ""
if (comget_1.stickys) {
/* Grab stemlength shortening parameters from prior note */
-#line 12635 ""
+#line 12616 ""
all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],27);
/* call setbits (mult(ivx,nnl(ivx)),3,28, */
/* * igetbits(mult(ivx,nnl(ivx)-1),3,28)) */
-#line 12638 ""
+#line 12619 ""
i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10);
-#line 12638 ""
+#line 12619 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &c__6, &c__10, &i__1);
-#line 12640 ""
+#line 12621 ""
}
-#line 12641 ""
+#line 12622 ""
if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol && !
comget_1.fbon) {
@@ -30124,514 +30281,514 @@ L28:
/* starts a period. */
/* if (mod(1.*itsofar(ivx),tautofb) .lt. tol) then */
-#line 12647 ""
+#line 12628 ""
r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
-#line 12647 ""
+#line 12628 ""
if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
/* Start a forced beam here */
-#line 12651 ""
+#line 12632 ""
++comfb_1.nfb[commvl_1.ivx - 1];
-#line 12652 ""
+#line 12633 ""
comget_1.fbon = TRUE_;
-#line 12653 ""
+#line 12634 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
commvl_1.ivx - 1] * 24 - 25] = 'x';
-#line 12654 ""
+#line 12635 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
-#line 12655 ""
+#line 12636 ""
}
-#line 12656 ""
+#line 12637 ""
}
-#line 12657 ""
+#line 12638 ""
if (comget_1.fbon) {
-#line 12657 ""
+#line 12638 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],30);
-#line 12657 ""
+#line 12638 ""
}
-#line 12658 ""
+#line 12639 ""
*(unsigned char *)dotq = 'x';
-#line 12659 ""
+#line 12640 ""
if (*(unsigned char *)charq == 'r') {
-#line 12659 ""
+#line 12640 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],0);
-#line 12659 ""
+#line 12640 ""
}
-#line 12661 ""
+#line 12642 ""
if (bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],0)) {
/* Rest stuff. First check if previous note was full-bar-pause */
-#line 12665 ""
+#line 12646 ""
i__1 = all_1.iccount;
-#line 12665 ""
+#line 12646 ""
if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (ftnlen)1)
== 0 && all_1.nnl[commvl_1.ivx - 1] > 1) {
-#line 12667 ""
+#line 12648 ""
if (bit_test(all_1.islur[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25],19)) {
-#line 12667 ""
+#line 12648 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.islur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19);
-#line 12667 ""
+#line 12648 ""
}
-#line 12669 ""
+#line 12650 ""
}
/* Set default rest level at 0 unless 2 voices/staff in which case it's -4 or 2 */
/* for voice a or b. Set a-types at 0 as encountered and adjust later */
/* after '//'. (Override heights will be set to 100+offset) */
-#line 12675 ""
+#line 12656 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 12676 ""
+#line 12657 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = 0;
-#line 12677 ""
+#line 12658 ""
} else {
-#line 12678 ""
+#line 12659 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = 2;
-#line 12679 ""
+#line 12660 ""
}
-#line 12680 ""
+#line 12661 ""
}
-#line 12681 ""
+#line 12662 ""
L2:
-#line 12681 ""
+#line 12662 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12682 ""
+#line 12663 ""
ic = *(unsigned char *)durq;
-#line 12683 ""
+#line 12664 ""
if (ic <= 57 && ic >= 48) {
/* Digit */
-#line 12687 ""
+#line 12668 ""
if (numnum == 0) {
-#line 12688 ""
+#line 12669 ""
comnotes_1.nnodur = ic - 48;
-#line 12689 ""
+#line 12670 ""
numnum = 1;
-#line 12690 ""
+#line 12671 ""
goto L2;
-#line 12691 ""
+#line 12672 ""
} else if (numnum == 1) {
-#line 12692 ""
+#line 12673 ""
ioct = ic - 48;
-#line 12693 ""
+#line 12674 ""
numnum = 2;
-#line 12694 ""
+#line 12675 ""
goto L2;
-#line 12695 ""
+#line 12676 ""
} else {
-#line 12696 ""
- s_wsle(&io___776);
-#line 12696 ""
+#line 12677 ""
+ s_wsle(&io___775);
+#line 12677 ""
do_lio(&c__9, &c__1, ">2 digits in note sym., ivx,nn:", (
ftnlen)31);
-#line 12696 ""
+#line 12677 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
-#line 12696 ""
+#line 12677 ""
do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
ftnlen)sizeof(integer));
-#line 12696 ""
+#line 12677 ""
e_wsle();
-#line 12697 ""
+#line 12678 ""
stop1_();
-#line 12698 ""
+#line 12679 ""
}
-#line 12699 ""
+#line 12680 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 12700 ""
+#line 12681 ""
*(unsigned char *)dotq = *(unsigned char *)durq;
-#line 12701 ""
+#line 12682 ""
i__1 = all_1.iccount;
-#line 12701 ""
+#line 12682 ""
if (s_cmp(lineq + i__1, "d", all_1.iccount + 1 - i__1, (ftnlen)1)
== 0) {
/* Double dot. */
-#line 12705 ""
+#line 12686 ""
++all_1.iccount;
-#line 12706 ""
+#line 12687 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],3);
-#line 12707 ""
+#line 12688 ""
}
-#line 12708 ""
+#line 12689 ""
i__1 = all_1.iccount;
-#line 12708 ""
+#line 12689 ""
if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 -
i__1) > 0) {
/* move a dot, unless next char is not part of a number */
-#line 12712 ""
+#line 12693 ""
i__1 = all_1.iccount + 1;
-#line 12712 ""
+#line 12693 ""
if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
all_1.iccount + 2 - i__1) == 0) {
-#line 12712 ""
+#line 12693 ""
goto L2;
-#line 12712 ""
+#line 12693 ""
}
-#line 12714 ""
+#line 12695 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],19);
-#line 12715 ""
+#line 12696 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12716 ""
+#line 12697 ""
++comcc_1.ndotmv[commvl_1.ivx - 1];
-#line 12717 ""
+#line 12698 ""
++all_1.iccount;
-#line 12718 ""
+#line 12699 ""
readnum_(lineq, &all_1.iccount, dumq, &comcc_1.updot[
commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] * 24
- 25], (ftnlen)128, (ftnlen)1);
-#line 12719 ""
+#line 12700 ""
if (*(unsigned char *)durq == '-') {
-#line 12719 ""
+#line 12700 ""
comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx
- 1] * 24 - 25] = -comcc_1.updot[commvl_1.ivx +
comcc_1.ndotmv[commvl_1.ivx - 1] * 24 - 25];
-#line 12719 ""
+#line 12700 ""
}
-#line 12721 ""
+#line 12702 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift also */
-#line 12725 ""
+#line 12706 ""
++all_1.iccount;
-#line 12726 ""
+#line 12707 ""
readnum_(lineq, &all_1.iccount, durq, &comcc_1.rtdot[
commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx - 1] *
24 - 25], (ftnlen)128, (ftnlen)1);
-#line 12727 ""
+#line 12708 ""
if (*(unsigned char *)dumq == '-') {
-#line 12727 ""
+#line 12708 ""
comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[
commvl_1.ivx - 1] * 24 - 25] = -comcc_1.rtdot[
commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx -
1] * 24 - 25];
-#line 12727 ""
+#line 12708 ""
}
-#line 12729 ""
+#line 12710 ""
} else {
-#line 12730 ""
+#line 12711 ""
comcc_1.rtdot[commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx
- 1] * 24 - 25] = 0.f;
-#line 12731 ""
+#line 12712 ""
}
-#line 12732 ""
+#line 12713 ""
--all_1.iccount;
-#line 12733 ""
+#line 12714 ""
}
-#line 12734 ""
+#line 12715 ""
goto L2;
-#line 12735 ""
+#line 12716 ""
} else if (*(unsigned char *)durq == 'p') {
/* Full-bar rest as pause */
-#line 12739 ""
+#line 12720 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],19);
-#line 12740 ""
+#line 12721 ""
goto L2;
-#line 12741 ""
+#line 12722 ""
} else if (*(unsigned char *)durq == 'b') {
/* Blank rest */
-#line 12745 ""
+#line 12726 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],29);
-#line 12746 ""
+#line 12727 ""
goto L2;
-#line 12747 ""
+#line 12728 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Accidental */
/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */
/* 171209 May have set bit 18 earlier if D or F preceded accidental */
-#line 12753 ""
+#line 12734 ""
if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25], &c__2, &c__0) == 0) {
/* No accidental has been set yet */
/* nacc(ivx,nnl(ivx)) = index('fsn',durq) */
-#line 12758 ""
+#line 12739 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] |= i_indx("fsn", durq, (ftnlen)3, (ftnlen)1);
-#line 12760 ""
+#line 12741 ""
} else {
/* Repeated accid, so must be double */
-#line 12764 ""
+#line 12745 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],2);
-#line 12765 ""
+#line 12746 ""
}
-#line 12766 ""
+#line 12747 ""
goto L2;
-#line 12767 ""
+#line 12748 ""
} else if (*(unsigned char *)durq == 'i') {
/* Set flag for MIDI-only accidental. */
-#line 12771 ""
+#line 12752 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],17);
-#line 12772 ""
+#line 12753 ""
goto L2;
-#line 12773 ""
+#line 12754 ""
} else if (*(unsigned char *)durq == 'c') {
/* Set flags for cautionary accidental */
-#line 12777 ""
+#line 12758 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],31);
-#line 12778 ""
+#line 12759 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] =
bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 1],31);
-#line 12779 ""
+#line 12760 ""
goto L2;
-#line 12780 ""
+#line 12761 ""
} else if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
-#line 12781 ""
+#line 12762 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2;
-#line 12782 ""
+#line 12763 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],0)) {
/* A note, not a rest. */
-#line 12786 ""
+#line 12767 ""
chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &moved, (
ftnlen)128);
-#line 12787 ""
+#line 12768 ""
if (moved) {
-#line 12787 ""
+#line 12768 ""
goto L2;
-#line 12787 ""
+#line 12768 ""
}
/* Octave jump with a note */
-#line 12791 ""
+#line 12772 ""
if (numnum < 2) {
-#line 12792 ""
+#line 12773 ""
comnotes_1.lastlev += ipm * 7;
-#line 12793 ""
+#line 12774 ""
} else {
-#line 12794 ""
+#line 12775 ""
ioct += ipm;
-#line 12795 ""
+#line 12776 ""
}
-#line 12796 ""
+#line 12777 ""
goto L2;
-#line 12797 ""
+#line 12778 ""
} else {
/* Override default height of a rest */
-#line 12801 ""
+#line 12782 ""
++all_1.iccount;
-#line 12802 ""
+#line 12783 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 12803 ""
+#line 12784 ""
i__1 = all_1.iccount - 2;
-#line 12803 ""
+#line 12784 ""
if (s_cmp(lineq + i__1, ".", all_1.iccount - 1 - i__1, (
ftnlen)1) == 0) {
/* Kluge in case there is a shortcut ".". It will have been sucked up by */
/* readnum. (Same doesn't hold for ",") */
-#line 12808 ""
+#line 12789 ""
--all_1.iccount;
/* go to 2 */
-#line 12810 ""
+#line 12791 ""
}
-#line 12811 ""
+#line 12792 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = ipm * i_nint(&fnum) + 100;
/* There may be more characters for this rest */
-#line 12815 ""
+#line 12796 ""
--all_1.iccount;
-#line 12816 ""
+#line 12797 ""
goto L2;
-#line 12817 ""
+#line 12798 ""
}
-#line 12818 ""
+#line 12799 ""
} else if (*(unsigned char *)durq == 'x') {
/* Xtuplet. Count number of doubled notes (for unequal xtups) */
-#line 12822 ""
+#line 12803 ""
if (bit_test(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],18)) {
-#line 12823 ""
+#line 12804 ""
ndoub = 1;
-#line 12824 ""
+#line 12805 ""
} else {
-#line 12825 ""
+#line 12806 ""
ndoub = 0;
-#line 12826 ""
+#line 12807 ""
}
/* Initialize counter for # of non-rests, so can later unbeam if = 1. */
-#line 12830 ""
+#line 12811 ""
inxtup = TRUE_;
-#line 12831 ""
+#line 12812 ""
note1xtup = all_1.nnl[commvl_1.ivx - 1];
-#line 12832 ""
+#line 12813 ""
nnb = 0;
-#line 12833 ""
+#line 12814 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],0)) {
-#line 12833 ""
+#line 12814 ""
nnb = 1;
-#line 12833 ""
+#line 12814 ""
}
/* Will set all durations to 0 except last one. Set flag on this note. */
-#line 12837 ""
+#line 12818 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],28);
/* Next input will be digit unless its a "T" */
-#line 12841 ""
+#line 12822 ""
++all_1.iccount;
-#line 12842 ""
+#line 12823 ""
if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'T') {
/* Set up tremolo */
-#line 12846 ""
+#line 12827 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],2);
-#line 12847 ""
+#line 12828 ""
ntup = 2;
/* Set default beaming, based on Wikipedia article */
/* May be a problem here is nnodur is inherited */
-#line 12852 ""
+#line 12833 ""
if (comnotes_1.nnodur == 4) {
-#line 12853 ""
+#line 12834 ""
nsolid = 0;
-#line 12854 ""
+#line 12835 ""
nindent = 3;
-#line 12855 ""
+#line 12836 ""
} else if (comnotes_1.nnodur == 2) {
-#line 12856 ""
+#line 12837 ""
nsolid = 3;
-#line 12857 ""
+#line 12838 ""
nindent = 0;
-#line 12858 ""
+#line 12839 ""
} else if (comnotes_1.nnodur == 8) {
-#line 12859 ""
+#line 12840 ""
nsolid = 1;
-#line 12860 ""
+#line 12841 ""
nindent = 2;
-#line 12861 ""
+#line 12842 ""
}
-#line 12862 ""
+#line 12843 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12863 ""
+#line 12844 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0) {
-#line 12864 ""
+#line 12845 ""
nsolid = i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1)
- 1;
-#line 12865 ""
+#line 12846 ""
if (nsolid == 0 && comnotes_1.nnodur == 2) {
-#line 12866 ""
- s_wsle(&io___787);
-#line 12866 ""
+#line 12847 ""
+ s_wsle(&io___786);
+#line 12847 ""
do_lio(&c__9, &c__1, "", (ftnlen)0);
-#line 12866 ""
+#line 12847 ""
e_wsle();
-#line 12867 ""
- s_wsle(&io___788);
-#line 12867 ""
+#line 12848 ""
+ s_wsle(&io___787);
+#line 12848 ""
do_lio(&c__9, &c__1, "Unbeamed half-note 2-note trem"\
"olo forbidden.", (ftnlen)44);
-#line 12867 ""
+#line 12848 ""
e_wsle();
-#line 12868 ""
+#line 12849 ""
stop1_();
-#line 12869 ""
+#line 12850 ""
}
-#line 12870 ""
+#line 12851 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 12871 ""
+#line 12852 ""
if (i_indx("0123456789", durq, (ftnlen)10, (ftnlen)1) > 0)
{
-#line 12872 ""
+#line 12853 ""
nindent = i_indx("0123456789", durq, (ftnlen)10, (
ftnlen)1) - 1;
-#line 12873 ""
+#line 12854 ""
}
-#line 12874 ""
+#line 12855 ""
}
-#line 12875 ""
+#line 12856 ""
setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25], &c__2, &c__3, &nsolid);
-#line 12876 ""
+#line 12857 ""
setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25], &c__2, &c__5, &nindent);
-#line 12877 ""
+#line 12858 ""
if (nsolid == 0) {
-#line 12878 ""
+#line 12859 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.islur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18);
-#line 12880 ""
+#line 12861 ""
}
-#line 12881 ""
+#line 12862 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],31);
-#line 12882 ""
+#line 12863 ""
all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (
all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21);
-#line 12883 ""
+#line 12864 ""
setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
- 1] + 1) * 24 - 25], &c__3, &c__22, &nsolid);
@@ -30640,144 +30797,144 @@ L2:
/* Need to check if there's already a forced beam explicitly set here. */
/* If there was, shouldn't do any harm resetting parameters. */
-#line 12890 ""
+#line 12871 ""
if (comfb_1.nfb[commvl_1.ivx - 1] == 0 || comfb_1.t1fb[
commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 -
25] != (real) all_1.itsofar[commvl_1.ivx - 1]) {
-#line 12890 ""
+#line 12871 ""
++comfb_1.nfb[commvl_1.ivx - 1];
-#line 12890 ""
+#line 12871 ""
}
-#line 12892 ""
+#line 12873 ""
comget_1.fbon = TRUE_;
-#line 12893 ""
+#line 12874 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
commvl_1.ivx - 1] * 24 - 25] = 'x';
-#line 12894 ""
+#line 12875 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
-#line 12895 ""
+#line 12876 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) (all_1.itsofar[commvl_1.ivx - 1] +
ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1));
-#line 12896 ""
+#line 12877 ""
nadj = 0;
/* Set open beamed notehead flag for half-note tremolo */
/* Just gave 2 quarters with or without flag set. Need to fix */
-#line 12901 ""
+#line 12882 ""
} else {
-#line 12902 ""
+#line 12883 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
ftnlen)1);
-#line 12903 ""
+#line 12884 ""
ntup = i_nint(&fnum);
-#line 12904 ""
+#line 12885 ""
}
-#line 12905 ""
+#line 12886 ""
if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double xtup note to make an un= xtup. Here xtup number already set but may also */
/* have this command before. */
-#line 12911 ""
+#line 12892 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],18);
-#line 12912 ""
+#line 12893 ""
if (*(unsigned char *)durq == 'F') {
-#line 12912 ""
+#line 12893 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.nacc[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],19);
-#line 12912 ""
+#line 12893 ""
}
-#line 12914 ""
+#line 12895 ""
ndoub = 1;
-#line 12915 ""
+#line 12896 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12916 ""
+#line 12897 ""
} else if (*(unsigned char *)durq == 'd') {
-#line 12917 ""
+#line 12898 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],27);
-#line 12918 ""
+#line 12899 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 12919 ""
+#line 12900 ""
}
/* Only other possibilities here are ' ' or 'n' */
-#line 12923 ""
+#line 12904 ""
if (*(unsigned char *)durq == 'n') {
/* Alter xtup number */
-#line 12927 ""
+#line 12908 ""
i__1 = all_1.iccount;
-#line 12927 ""
+#line 12908 ""
if (s_cmp(lineq + i__1, " ", all_1.iccount + 1 - i__1, (
ftnlen)1) == 0) {
/* If the only modifier is 'n', cancel the number */
-#line 12931 ""
+#line 12912 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.islur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],31);
-#line 12932 ""
+#line 12913 ""
} else {
-#line 12933 ""
+#line 12914 ""
numshft = 0;
-#line 12934 ""
+#line 12915 ""
L30:
-#line 12934 ""
+#line 12915 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 12935 ""
+#line 12916 ""
if (*(unsigned char *)durq == 'f') {
/* Flip up-down-ness */
-#line 12939 ""
+#line 12920 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],14);
-#line 12940 ""
+#line 12921 ""
goto L30;
-#line 12941 ""
+#line 12922 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical or horiz shift */
-#line 12945 ""
+#line 12926 ""
++numshft;
-#line 12946 ""
+#line 12927 ""
iofforn = 1;
-#line 12947 ""
+#line 12928 ""
if (*(unsigned char *)durq == '-') {
-#line 12947 ""
+#line 12928 ""
iofforn = -1;
-#line 12947 ""
+#line 12928 ""
}
-#line 12948 ""
+#line 12929 ""
++all_1.iccount;
-#line 12949 ""
+#line 12930 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
-#line 12950 ""
+#line 12931 ""
--all_1.iccount;
-#line 12951 ""
+#line 12932 ""
if (numshft == 1) {
/* Vertical shift */
/* 160214 Allow (-64,64) */
/* iofforn = iofforn*nint(xofforn) + 16 */
-#line 12956 ""
+#line 12937 ""
iofforn = iofforn * i_nint(&xofforn) + 64;
/* c Turn on bit 1; set bits 2-6 to iofforn */
@@ -30785,1055 +30942,1078 @@ L30:
/* irest(ivx,nnl(ivx)) = */
/* * ior(irest(ivx,nnl(ivx)),2+4*iofforn) */
-#line 12963 ""
+#line 12944 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],1);
-#line 12964 ""
+#line 12945 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__8, &
c__16, &iofforn);
-#line 12965 ""
+#line 12946 ""
} else {
/* Horizontal shift */
-#line 12969 ""
+#line 12950 ""
r__1 = xofforn * 10;
-#line 12969 ""
+#line 12950 ""
iofforn = iofforn * i_nint(&r__1) + 16;
-#line 12970 ""
+#line 12951 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],7);
-#line 12971 ""
+#line 12952 ""
setbits_(&all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &
c__9, &iofforn);
-#line 12972 ""
+#line 12953 ""
}
-#line 12973 ""
+#line 12954 ""
goto L30;
-#line 12974 ""
+#line 12955 ""
} else if (*(unsigned char *)durq == 's') {
/* Slope adjustment for bracket */
-#line 12978 ""
+#line 12959 ""
all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.mult[commvl_1.ivx
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],4);
-#line 12979 ""
+#line 12960 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 12980 ""
+#line 12961 ""
iofforn = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
2;
-#line 12981 ""
+#line 12962 ""
++all_1.iccount;
-#line 12982 ""
+#line 12963 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
-#line 12983 ""
+#line 12964 ""
--all_1.iccount;
-#line 12984 ""
+#line 12965 ""
r__1 = iofforn * xofforn + 16;
-#line 12984 ""
+#line 12965 ""
iofforn = i_nint(&r__1);
-#line 12985 ""
+#line 12966 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &c__5, &
iofforn);
-#line 12986 ""
+#line 12967 ""
} else if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1)
> 0) {
/* Replacement printed number */
-#line 12990 ""
+#line 12971 ""
readnum_(lineq, &all_1.iccount, durq, &xofforn, (
ftnlen)128, (ftnlen)1);
-#line 12991 ""
+#line 12972 ""
i__1 = i_nint(&xofforn);
-#line 12991 ""
+#line 12972 ""
setbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__5, &c__22, &
i__1);
-#line 12992 ""
+#line 12973 ""
--all_1.iccount;
-#line 12993 ""
+#line 12974 ""
goto L30;
-#line 12994 ""
+#line 12975 ""
}
-#line 12995 ""
+#line 12976 ""
}
-#line 12996 ""
+#line 12977 ""
}
/* Set note level of 1st note of xtup, provided not a rest */
-#line 13000 ""
+#line 12981 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],0)) {
-#line 13001 ""
+#line 12982 ""
if (numnum == 2) {
-#line 13002 ""
+#line 12983 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[
all_1.iv - 1] - 1], (ftnlen)1);
-#line 13003 ""
+#line 12984 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = comnotes_1.lastlev;
-#line 13004 ""
+#line 12985 ""
} else {
-#line 13005 ""
+#line 12986 ""
comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(
charq, &c__10, &cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)
1) - comnotes_1.lastlev + 3) % 7;
-#line 13007 ""
+#line 12988 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = comnotes_1.lastlev;
-#line 13008 ""
+#line 12989 ""
}
-#line 13009 ""
+#line 12990 ""
}
-#line 13010 ""
+#line 12991 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set note level for preslur on starting note of xtuplet */
-#line 13014 ""
+#line 12995 ""
setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
c__7, &c__19, &comnotes_1.lastlev);
-#line 13015 ""
+#line 12996 ""
/* L40: */
-#line 13015 ""
+#line 12996 ""
}
-#line 13016 ""
+#line 12997 ""
numnum = 0;
-#line 13017 ""
+#line 12998 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= 0;
-#line 13018 ""
+#line 12999 ""
i__1 = ntup;
-#line 13018 ""
+#line 12999 ""
for (itup = 2; itup <= i__1; ++itup) {
-#line 13019 ""
+#line 13000 ""
if (comget_1.ornrpt) {
-#line 13020 ""
+#line 13001 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991;
-#line 13022 ""
+#line 13003 ""
if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 1] & 32896) > 0) {
/* This is a trill (bit 7 or 15) so must dup the parameters */
-#line 13026 ""
+#line 13007 ""
++comtrill_1.ntrill;
-#line 13027 ""
+#line 13008 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] =
commvl_1.ivx;
-#line 13028 ""
+#line 13009 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
-#line 13029 ""
+#line 13010 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
comtrill_1.xnsktr[comtrill_1.ntrill - 2];
-#line 13030 ""
+#line 13011 ""
}
-#line 13031 ""
+#line 13012 ""
}
-#line 13032 ""
+#line 13013 ""
++all_1.nnl[commvl_1.ivx - 1];
-#line 13033 ""
+#line 13014 ""
if (comget_1.fbon) {
-#line 13033 ""
+#line 13014 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24
- 25] = bit_set(all_1.ipl[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],30);
-#line 13033 ""
+#line 13014 ""
}
-#line 13034 ""
+#line 13015 ""
L7:
-#line 13034 ""
+#line 13015 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1)
;
-#line 13035 ""
+#line 13016 ""
if (*(unsigned char *)charq == ' ') {
-#line 13036 ""
+#line 13017 ""
goto L7;
-#line 13037 ""
+#line 13018 ""
} else if (*(unsigned char *)charq == '%') {
-#line 13038 ""
+#line 13019 ""
all_1.iccount = 128;
-#line 13039 ""
+#line 13020 ""
goto L7;
-#line 13040 ""
+#line 13021 ""
} else if (*(unsigned char *)charq == 'o') {
/* Ornament in xtuplet. "o" symbol must come AFTER the affected note */
-#line 13044 ""
+#line 13025 ""
if (comnotes_1.notcrd) {
-#line 13045 ""
+#line 13026 ""
nole = all_1.nolev[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25];
-#line 13046 ""
+#line 13027 ""
} else {
-#line 13047 ""
+#line 13028 ""
nole = 127 & lbit_shift(comtrill_1.icrdat[
comtrill_1.ncrd - 1], (ftnlen)-12);
-#line 13048 ""
+#line 13029 ""
}
-#line 13049 ""
+#line 13030 ""
i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
-#line 13049 ""
+#line 13030 ""
getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx
+ (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1], &
all_1.iornq[commvl_1.ivx - 1], &comget_1.ornrpt, &
comgrace_1.noffseg, &i__2, &commvl_1.ivx, &
c_false, &comnotes_1.notcrd, &nole, (ftnlen)128);
-#line 13052 ""
+#line 13033 ""
goto L7;
-#line 13053 ""
+#line 13034 ""
} else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0)
{
-#line 13054 ""
+#line 13035 ""
nnlivx = all_1.nnl[commvl_1.ivx - 1] - 1;
-#line 13055 ""
+#line 13036 ""
if (*(unsigned char *)charq == '(' || *(unsigned char *)
charq == '{') {
/* Detected preslur in xtuplet loop, non-chord note */
-#line 13059 ""
+#line 13040 ""
++nnlivx;
-#line 13060 ""
+#line 13041 ""
++comnotes_1.npreslur;
-#line 13061 ""
+#line 13042 ""
}
-#line 13062 ""
+#line 13043 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0);
-#line 13063 ""
+#line 13044 ""
if (*(unsigned char *)charq == 't') {
-#line 13063 ""
+#line 13044 ""
all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] =
bit_set(all_1.islur[commvl_1.ivx + nnlivx *
24 - 25],1);
-#line 13063 ""
+#line 13044 ""
}
-#line 13065 ""
+#line 13046 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 13066 ""
+#line 13047 ""
kv = 1;
-#line 13067 ""
+#line 13048 ""
} else {
-#line 13068 ""
+#line 13049 ""
kv = 2;
-#line 13069 ""
+#line 13050 ""
}
-#line 13070 ""
+#line 13051 ""
if (comslur_1.fontslur) {
-#line 13071 ""
+#line 13052 ""
sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
all_1.isdat1, all_1.isdat2, all_1.isdat3, &
all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[
commvl_1.ivx + nnlivx * 24 - 25], charq, (
ftnlen)128, (ftnlen)1);
-#line 13073 ""
+#line 13054 ""
} else {
-#line 13074 ""
+#line 13055 ""
spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &
nnlivx, all_1.isdat1, all_1.isdat2,
all_1.isdat3, all_1.isdat4, &all_1.nsdat, &
comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx
+ nnlivx * 24 - 25], charq, (ftnlen)128, (
ftnlen)1);
-#line 13076 ""
+#line 13057 ""
}
-#line 13077 ""
+#line 13058 ""
goto L7;
-#line 13078 ""
+#line 13059 ""
} else if (*(unsigned char *)charq == 'G') {
/* Kluge to get grace in xtup at right location */
-#line 13082 ""
+#line 13063 ""
--all_1.nnl[commvl_1.ivx - 1];
-#line 13083 ""
+#line 13064 ""
getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount,
all_1.islur, all_1.iornq, all_1.ipl,
comnotes_1.ndlev, &comnotes_1.lastlev, &all_1.iv,
&all_1.nv, (ftnlen)128);
-#line 13085 ""
+#line 13066 ""
++all_1.nnl[commvl_1.ivx - 1];
-#line 13086 ""
+#line 13067 ""
goto L7;
-#line 13087 ""
+#line 13068 ""
} else if (*(unsigned char *)charq == *(unsigned char *)
all_1.sq) {
-#line 13088 ""
+#line 13069 ""
littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
-#line 13089 ""
+#line 13070 ""
goto L7;
-#line 13090 ""
- } else if (*(unsigned char *)charq == '"') {
+#line 13071 ""
+ } else /* if(complicated condition) */ {
+#line 13071 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 13071 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]
+ ) {
/* pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ */
+#line 13075 ""
+ if (! comlyr_1.inputmlyr) {
+#line 13076 ""
+ ictemp = 0;
+/* Writing concatenation */
+#line 13077 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 13077 ""
+ i__3[1] = 1, a__1[1] = all_1.sq;
+#line 13077 ""
+ i__3[2] = 1, a__1[2] = all_1.sq;
+#line 13077 ""
+ i__3[3] = 15, a__1[3] = "input musixlyr ";
+#line 13077 ""
+ i__3[4] = 1, a__1[4] = all_1.sq;
+#line 13077 ""
+ s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
+#line 13078 ""
+ i__2 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 13078 ""
+ littex_(all_1.islur, &i__2, &commvl_1.ivx, &
+ comas3_1.topmods, lineqt, &ictemp, (
+ ftnlen)128);
+#line 13079 ""
+ comlyr_1.inputmlyr = TRUE_;
+#line 13080 ""
+ }
+#line 13081 ""
+ dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
+#line 13082 ""
+ *(unsigned char *)charq = *(unsigned char *)all_1.sq;
+#line 13083 ""
+ littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
+ commvl_1.ivx, &comas3_1.topmods, lineq, &
+ all_1.iccount, (ftnlen)128);
+#line 13084 ""
+ goto L7;
+#line 13085 ""
+ } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (
+ ftnlen)1) > 0) {
+
+/* Figure. Must come AFTER the first note of xtup */
+
+#line 13089 ""
+ ivf = 1;
+#line 13090 ""
+ if (commvl_1.ivx > 1) {
+#line 13091 ""
+ if (comfig_1.ivxfig2 == 0) {
+#line 13092 ""
+ comfig_1.ivxfig2 = commvl_1.ivx;
+#line 13093 ""
+ } else if (commvl_1.ivx != comfig_1.ivxfig2) {
#line 13094 ""
- if (! comlyr_1.inputmlyr) {
+ s_wsle(&io___798);
+#line 13094 ""
+ e_wsle();
#line 13095 ""
- ictemp = 0;
-/* Writing concatenation */
-#line 13096 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
-#line 13096 ""
- i__3[1] = 1, a__1[1] = all_1.sq;
-#line 13096 ""
- i__3[2] = 1, a__1[2] = all_1.sq;
-#line 13096 ""
- i__3[3] = 15, a__1[3] = "input musixlyr ";
-#line 13096 ""
- i__3[4] = 1, a__1[4] = all_1.sq;
+ s_wsle(&io___799);
+#line 13095 ""
+ do_lio(&c__9, &c__1, "Figures not allowed in"\
+ " >1 voice above first", (ftnlen)43);
+#line 13095 ""
+ e_wsle();
#line 13096 ""
- s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
-#line 13097 ""
- i__2 = all_1.nnl[commvl_1.ivx - 1] + 1;
+ s_stop("", (ftnlen)0);
#line 13097 ""
- littex_(all_1.islur, &i__2, &commvl_1.ivx, &
- comas3_1.topmods, lineqt, &ictemp, (ftnlen)
- 128);
+ }
#line 13098 ""
- comlyr_1.inputmlyr = TRUE_;
+ ivf = 2;
#line 13099 ""
- }
+ }
#line 13100 ""
- dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
+ nfig1 = comfig_1.nfigs[ivf - 1] + 1;
#line 13101 ""
- *(unsigned char *)charq = *(unsigned char *)all_1.sq;
-#line 13102 ""
- littex_(all_1.islur, &all_1.nnl[commvl_1.ivx - 1], &
- commvl_1.ivx, &comas3_1.topmods, lineq, &
- all_1.iccount, (ftnlen)128);
-#line 13103 ""
- goto L7;
-#line 13104 ""
- } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (
- ftnlen)1) > 0) {
-
-/* Figure. Must come AFTER the first note of xtup */
-
+ getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3],
+ charq, lineq, &all_1.iccount, &all_1.isfig[
+ ivf + (all_1.nnl[commvl_1.ivx - 1] - 1 << 1)
+ - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3],
+ &all_1.itsofar[commvl_1.ivx - 1], &c__0,
+ comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10,
+ &comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], &
+ comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], &
+ comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)
+ 128, (ftnlen)10);
+/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */
+#line 13106 ""
+ goto L7;
+#line 13107 ""
+ } else if (*(unsigned char *)charq == 'X') {
+/* Computing MAX */
#line 13108 ""
- ivf = 1;
-#line 13109 ""
- if (commvl_1.ivx > 1) {
-#line 13110 ""
- if (comfig_1.ivxfig2 == 0) {
-#line 13111 ""
- comfig_1.ivxfig2 = commvl_1.ivx;
+ i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 13108 ""
+ getx_(lineq, &all_1.iccount, &all_1.irest[
+ commvl_1.ivx + max(i__2,i__4) * 24 - 25], &
+ comnotes_1.shifton, &comask_1.wheadpt, &
+ all_1.iornq[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 1], &commvl_1.ivx, &
+ all_1.irest[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25], &all_1.itsofar[
+ commvl_1.ivx - 1], &ntup, &itup, &
+ comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128,
+ (ftnlen)1);
#line 13112 ""
- } else if (commvl_1.ivx != comfig_1.ivxfig2) {
-#line 13113 ""
- s_wsle(&io___799);
+ goto L7;
#line 13113 ""
- e_wsle();
-#line 13114 ""
- s_wsle(&io___800);
-#line 13114 ""
- do_lio(&c__9, &c__1, "Figures not allowed in >1 "\
- "voice above first", (ftnlen)43);
-#line 13114 ""
- e_wsle();
-#line 13115 ""
- s_stop("", (ftnlen)0);
-#line 13116 ""
- }
+ } else if (*(unsigned char *)charq == 'z') {
+
+/* Chord note in xtup. Goes with *prior* note. */
+
#line 13117 ""
- ivf = 2;
+ comnotes_1.notcrd = FALSE_;
#line 13118 ""
- }
+ ++comtrill_1.ncrd;
#line 13119 ""
- nfig1 = comfig_1.nfigs[ivf - 1] + 1;
+ all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
+ - 1) * 24 - 25] = bit_set(all_1.ipl[
+ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
+ 1) * 24 - 25],10);
#line 13120 ""
- getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq,
- lineq, &all_1.iccount, &all_1.isfig[ivf + (
- all_1.nnl[commvl_1.ivx - 1] - 1 << 1) - 3], &
- comfig_1.itfig[ivf + (nfig1 << 1) - 3], &
- all_1.itsofar[commvl_1.ivx - 1], &c__0,
- comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, &
- comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], &
- comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], &
- comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (
- ftnlen)10);
-/* * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) */
+ numnum = 0;
+/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
+#line 13122 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[
+ commvl_1.ivx - 1] - 1;
+#line 13123 ""
+ i__2 = commvl_1.ivx % 16;
+#line 13123 ""
+ setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &
+ c__4, &c__8, &i__2);
+#line 13124 ""
+ if (commvl_1.ivx >= 16) {
+#line 13124 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
+ comtrill_1.icrdat[comtrill_1.ncrd - 1],28)
+ ;
+#line 13124 ""
+ }
#line 13125 ""
- goto L7;
-#line 13126 ""
- } else if (*(unsigned char *)charq == 'X') {
-/* Computing MAX */
-#line 13127 ""
- i__2 = 1, i__4 = all_1.nnl[commvl_1.ivx - 1] - 1;
-#line 13127 ""
- getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx +
- max(i__2,i__4) * 24 - 25], &comnotes_1.shifton, &
- comask_1.wheadpt, &all_1.iornq[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 1], &
- commvl_1.ivx, &all_1.irest[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &
- all_1.itsofar[commvl_1.ivx - 1], &ntup, &itup, &
- comnotes_1.nnodur, dotq, &ndoub, (ftnlen)128, (
- ftnlen)1);
-#line 13131 ""
- goto L7;
-#line 13132 ""
- } else if (*(unsigned char *)charq == 'z') {
+ comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
-/* Chord note in xtup. Goes with *prior* note. */
+/* Get note name */
+
+#line 13129 ""
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
+ ftnlen)1);
+
+/* Get optional inputs */
+
+#line 13133 ""
+L34:
+#line 13133 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+
+/* When chord note is done, will get ' ', making ndx=0, so go past this block */
-#line 13136 ""
- comnotes_1.notcrd = FALSE_;
#line 13137 ""
- ++comtrill_1.ncrd;
+ ndx = i_indx("fsn+-<>12345678reicd", durq, (ftnlen)20,
+ (ftnlen)1);
#line 13138 ""
- all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1)
- * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + (
- all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],10);
+ if (ndx > 0) {
#line 13139 ""
- numnum = 0;
-/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
+ if (ndx <= 3) {
+#line 13140 ""
+ if (! bit_test(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],19)) {
#line 13141 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[
- commvl_1.ivx - 1] - 1;
-#line 13142 ""
- i__2 = commvl_1.ivx % 16;
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],19);
#line 13142 ""
- setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &
- c__8, &i__2);
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] |=
+ ndx << 20;
#line 13143 ""
- if (commvl_1.ivx >= 16) {
-#line 13143 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
-#line 13143 ""
- }
+ } else {
#line 13144 ""
- comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
-
-/* Get note name */
-
-#line 13148 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
- ftnlen)1);
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],22);
+#line 13145 ""
+ }
+#line 13146 ""
+ } else if (*(unsigned char *)durq == 'd') {
-/* Get optional inputs */
+/* Get dot on chord note in xtup. Assume +n+n */
+#line 13150 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],26);
+#line 13151 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)
+ 128, (ftnlen)1);
#line 13152 ""
-L34:
-#line 13152 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-
-/* When chord note is done, will get ' ', making ndx=0, so go past this block */
-
+ ++all_1.iccount;
+#line 13153 ""
+ readnum_(lineq, &all_1.iccount, dumq, &fnum, (
+ ftnlen)128, (ftnlen)1);
+#line 13154 ""
+ if (*(unsigned char *)durq == '+') {
+#line 13155 ""
+ r__1 = fnum * 10;
+#line 13155 ""
+ comtrill_1.icrdot[comtrill_1.ncrd - 1] |=
+ i_nint(&r__1) + 64;
#line 13156 ""
- ndx = i_indx("fsn+-<>12345678reicd", durq, (ftnlen)20, (
- ftnlen)1);
+ } else {
#line 13157 ""
- if (ndx > 0) {
+ r__1 = fnum * 10;
+#line 13157 ""
+ comtrill_1.icrdot[comtrill_1.ncrd - 1] |=
+ -i_nint(&r__1) + 64;
#line 13158 ""
- if (ndx <= 3) {
+ }
#line 13159 ""
- if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd
- - 1],19)) {
-#line 13160 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] =
- bit_set(comtrill_1.icrdat[
- comtrill_1.ncrd - 1],19);
-#line 13161 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx
- << 20;
-#line 13162 ""
- } else {
+ if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1)
+ > 0) {
+
+/* Vertical shift specified also */
+
#line 13163 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] =
- bit_set(comtrill_1.icrdat[
- comtrill_1.ncrd - 1],22);
+ ++all_1.iccount;
#line 13164 ""
- }
+ readnum_(lineq, &all_1.iccount, durq, &
+ fnum, (ftnlen)128, (ftnlen)1);
#line 13165 ""
- } else if (*(unsigned char *)durq == 'd') {
-
-/* Get dot on chord note in xtup. Assume +n+n */
-
+ if (*(unsigned char *)dumq == '+') {
+#line 13166 ""
+ r__1 = fnum * 10;
+#line 13166 ""
+ ifnum = i_nint(&r__1) + 64;
+#line 13167 ""
+ } else {
+#line 13168 ""
+ r__1 = fnum * 10;
+#line 13168 ""
+ ifnum = -i_nint(&r__1) + 64;
#line 13169 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],26)
- ;
+ }
#line 13170 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128,
- (ftnlen)1);
+ } else {
#line 13171 ""
- ++all_1.iccount;
+ ifnum = 64;
#line 13172 ""
- readnum_(lineq, &all_1.iccount, dumq, &fnum, (
- ftnlen)128, (ftnlen)1);
+ }
#line 13173 ""
- if (*(unsigned char *)durq == '+') {
-#line 13174 ""
- r__1 = fnum * 10;
-#line 13174 ""
- comtrill_1.icrdot[comtrill_1.ncrd - 1] |=
- i_nint(&r__1) + 64;
-#line 13175 ""
- } else {
-#line 13176 ""
- r__1 = fnum * 10;
-#line 13176 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |=
- -i_nint(&r__1) + 64;
-#line 13177 ""
- }
-#line 13178 ""
- if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0)
- {
+ ifnum << 7;
+#line 13174 ""
+ --all_1.iccount;
+/* iccount = iccount+4 */
-/* Vertical shift specified also */
-#line 13182 ""
- ++all_1.iccount;
+
+#line 13179 ""
+ } else if (ndx == 19) {
+
+/* Set flags for cautionary accidental */
+
#line 13183 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (
- ftnlen)128, (ftnlen)1);
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],31);
#line 13184 ""
- if (*(unsigned char *)dumq == '+') {
-#line 13185 ""
- r__1 = fnum * 10;
-#line 13185 ""
- ifnum = i_nint(&r__1) + 64;
+ all_1.iornq[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] - 1) * 24 - 1] =
+ bit_set(all_1.iornq[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] - 1) * 24
+ - 1],31);
#line 13186 ""
- } else {
-#line 13187 ""
- r__1 = fnum * 10;
-#line 13187 ""
- ifnum = -i_nint(&r__1) + 64;
-#line 13188 ""
- }
-#line 13189 ""
- } else {
+ } else if (ndx <= 7) {
+
+/* +/-/</> Check whether octave or accidental shift */
+
#line 13190 ""
- ifnum = 64;
+ nactmp = 0;
#line 13191 ""
- }
+ chkpm4ac_(lineq, &all_1.iccount, &nactmp, &
+ moved, (ftnlen)128);
#line 13192 ""
- comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum <<
- 7;
-#line 13193 ""
- --all_1.iccount;
-/* iccount = iccount+4 */
-
+ if (moved) {
+/* Transfer accidental shift values */
+#line 13196 ""
+ i__2 = igetbits_(&nactmp, &c__6, &c__4);
+#line 13196 ""
+ setbits_(&comtrill_1.icrdot[
+ comtrill_1.ncrd - 1], &c__6, &
+ c__14, &i__2);
#line 13198 ""
- } else if (ndx == 19) {
-
-/* Set flags for cautionary accidental */
-
+ i__2 = igetbits_(&nactmp, &c__7, &c__10);
+#line 13198 ""
+ setbits_(&comtrill_1.icrdot[
+ comtrill_1.ncrd - 1], &c__7, &
+ c__20, &i__2);
+#line 13200 ""
+ } else {
+#line 13201 ""
+ if (*(unsigned char *)durq == '+') {
#line 13202 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],31)
- ;
+ comnotes_1.lastlev += 7;
#line 13203 ""
- all_1.iornq[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] - 1) * 24 - 1] =
- bit_set(all_1.iornq[commvl_1.ivx + (
- all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1]
- ,31);
+ } else if (*(unsigned char *)durq == '-')
+ {
+#line 13204 ""
+ comnotes_1.lastlev += -7;
#line 13205 ""
- } else if (ndx <= 7) {
-
-/* +/-/</> Check whether octave or accidental shift */
-
+ }
+#line 13206 ""
+ }
+#line 13207 ""
+ } else if (*(unsigned char *)durq == 'e') {
+#line 13208 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],23);
#line 13209 ""
- nactmp = 0;
+ all_1.irest[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25] =
+ bit_set(all_1.irest[commvl_1.ivx +
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
+ ,27);
#line 13210 ""
- chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved,
- (ftnlen)128);
+ } else if (*(unsigned char *)durq == 'r') {
#line 13211 ""
- if (moved) {
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],24);
+#line 13212 ""
+ all_1.irest[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] - 1) * 24 - 25] =
+ bit_set(all_1.irest[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] - 1) * 24
+ - 25],20);
+#line 13214 ""
+ } else if (*(unsigned char *)durq == 'i') {
-/* Transfer accidental shift values */
+/* Midi-only accidental */
-#line 13215 ""
- i__2 = igetbits_(&nactmp, &c__6, &c__4);
-#line 13215 ""
- setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
- 1], &c__6, &c__14, &i__2);
-#line 13217 ""
- i__2 = igetbits_(&nactmp, &c__7, &c__10);
-#line 13217 ""
- setbits_(&comtrill_1.icrdot[comtrill_1.ncrd -
- 1], &c__7, &c__20, &i__2);
+#line 13218 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] =
+ bit_set(comtrill_1.icrdat[
+ comtrill_1.ncrd - 1],27);
#line 13219 ""
} else {
-#line 13220 ""
- if (*(unsigned char *)durq == '+') {
-#line 13221 ""
- comnotes_1.lastlev += 7;
-#line 13222 ""
- } else if (*(unsigned char *)durq == '-') {
+
+/* must be a number, save it in ioct */
+
#line 13223 ""
- comnotes_1.lastlev += -7;
+ numnum = 1;
#line 13224 ""
- }
+ ioct = ndx - 7;
#line 13225 ""
}
#line 13226 ""
- } else if (*(unsigned char *)durq == 'e') {
+ goto L34;
#line 13227 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],23)
- ;
+ }
#line 13228 ""
- all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- - 1] * 24 - 25] = bit_set(all_1.irest[
- commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
- * 24 - 25],27);
+ if (numnum == 1) {
#line 13229 ""
- } else if (*(unsigned char *)durq == 'r') {
+ comnotes_1.lastlev = ifnolev_(charq, &ioct, &
+ cominsttrans_1.itransamt[
+ cominsttrans_1.instno[all_1.iv - 1] - 1],
+ (ftnlen)1);
#line 13230 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],24)
- ;
+ } else {
#line 13231 ""
- all_1.irest[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] - 1) * 24 - 25] =
- bit_set(all_1.irest[commvl_1.ivx + (
- all_1.nnl[commvl_1.ivx - 1] - 1) * 24 -
- 25],20);
+ comnotes_1.lastlev = comnotes_1.lastlev - 3 + (
+ ifnolev_(charq, &c__10, &
+ cominsttrans_1.itransamt[
+ cominsttrans_1.instno[all_1.iv - 1] - 1],
+ (ftnlen)1) - comnotes_1.lastlev + 3) % 7;
#line 13233 ""
- } else if (*(unsigned char *)durq == 'i') {
+ }
+#line 13234 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] |=
+ comnotes_1.lastlev << 12;
+#line 13235 ""
+ for (comnotes_1.npreslur = comnotes_1.npreslur;
+ comnotes_1.npreslur >= 1;
+ --comnotes_1.npreslur) {
-/* Midi-only accidental */
+/* Set note level for preslur on chord note in xtup */
-#line 13237 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],27)
- ;
-#line 13238 ""
- } else {
+#line 13239 ""
+ setbits_(&all_1.isdat2[all_1.nsdat -
+ comnotes_1.npreslur], &c__7, &c__19, &
+ comnotes_1.lastlev);
-/* must be a number, save it in ioct */
+/* Following lines copied from loop for non-xtup, chord note, preslur */
+/* Initially I assigned the slur(s) to next note, so fix. */
-#line 13242 ""
- numnum = 1;
-#line 13243 ""
- ioct = ndx - 7;
#line 13244 ""
- }
+ all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
+ - 1] * 24 - 25] = bit_clear(all_1.islur[
+ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
+ * 24 - 25],0);
#line 13245 ""
- goto L34;
+ all_1.islur[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] - 1) * 24 - 25] =
+ bit_set(all_1.islur[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] - 1) * 24 -
+ 25],0);
#line 13246 ""
- }
-#line 13247 ""
- if (numnum == 1) {
+ all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] =
+ bit_set(all_1.isdat2[all_1.nsdat -
+ comnotes_1.npreslur],0);
#line 13248 ""
- comnotes_1.lastlev = ifnolev_(charq, &ioct, &
- cominsttrans_1.itransamt[
- cominsttrans_1.instno[all_1.iv - 1] - 1], (
- ftnlen)1);
-#line 13249 ""
- } else {
+ i__2 = igetbits_(&all_1.isdat1[all_1.nsdat -
+ comnotes_1.npreslur], &c__8, &c__3) - 1;
+#line 13248 ""
+ setbits_(&all_1.isdat1[all_1.nsdat -
+ comnotes_1.npreslur], &c__8, &c__3, &i__2)
+ ;
#line 13250 ""
- comnotes_1.lastlev = comnotes_1.lastlev - 3 + (
- ifnolev_(charq, &c__10, &
- cominsttrans_1.itransamt[
- cominsttrans_1.instno[all_1.iv - 1] - 1], (
- ftnlen)1) - comnotes_1.lastlev + 3) % 7;
+/* L41: */
+#line 13250 ""
+ }
+#line 13251 ""
+ goto L7;
#line 13252 ""
- }
-#line 13253 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] |=
- comnotes_1.lastlev << 12;
-#line 13254 ""
- for (comnotes_1.npreslur = comnotes_1.npreslur;
- comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
+ } else if (*(unsigned char *)charq == '?') {
-/* Set note level for preslur on chord note in xtup */
+/* Arpeggio */
-#line 13258 ""
- setbits_(&all_1.isdat2[all_1.nsdat -
- comnotes_1.npreslur], &c__7, &c__19, &
- comnotes_1.lastlev);
+#line 13256 ""
+ if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] - 1) * 24 - 25],10)) {
-/* Following lines copied from loop for non-xtup, chord note, preslur */
-/* Initially I assigned the slur(s) to next note, so fix. */
+/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */
+/* of chord, will not set icrdat(25), but iornq(27) */
+#line 13261 ""
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
+ comtrill_1.icrdat[comtrill_1.ncrd - 1],25)
+ ;
+#line 13262 ""
+ } else {
#line 13263 ""
- all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
- * 24 - 25] = bit_clear(all_1.islur[
- commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
- 24 - 25],0);
+ all_1.iornq[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] - 1) * 24 - 1] =
+ bit_set(all_1.iornq[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1]
+ ,27);
#line 13264 ""
- all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
- 1] - 1) * 24 - 25] = bit_set(all_1.islur[
- commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
- 1) * 24 - 25],0);
-#line 13265 ""
- all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] =
- bit_set(all_1.isdat2[all_1.nsdat -
- comnotes_1.npreslur],0);
-#line 13267 ""
- i__2 = igetbits_(&all_1.isdat1[all_1.nsdat -
- comnotes_1.npreslur], &c__8, &c__3) - 1;
-#line 13267 ""
- setbits_(&all_1.isdat1[all_1.nsdat -
- comnotes_1.npreslur], &c__8, &c__3, &i__2);
-#line 13269 ""
-/* L41: */
+ }
+
+/* Check for shift */
+
+#line 13268 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 13269 ""
- }
+ if (*(unsigned char *)durq == ' ') {
#line 13270 ""
- goto L7;
+ --all_1.iccount;
#line 13271 ""
- } else if (*(unsigned char *)charq == '?') {
+ } else {
-/* Arpeggio */
+/* durq must be "-" */
#line 13275 ""
- if (bit_test(all_1.ipl[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] - 1) * 24 - 25],10)) {
+ ++all_1.iccount;
+#line 13276 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (
+ ftnlen)128, (ftnlen)1);
+#line 13277 ""
+ --all_1.iccount;
-/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */
-/* of chord, will not set icrdat(25), but iornq(27) */
+/* record the shift */
-#line 13280 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
#line 13281 ""
- } else {
+ ++comarpshift_1.numarpshift;
#line 13282 ""
- all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
- 1] - 1) * 24 - 1] = bit_set(all_1.iornq[
- commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
- 1) * 24 - 1],27);
+ comarpshift_1.ivarpshift[
+ comarpshift_1.numarpshift - 1] =
+ commvl_1.ivx;
#line 13283 ""
- }
-
-/* Check for shift */
-
+ comarpshift_1.iparpshift[
+ comarpshift_1.numarpshift - 1] =
+ all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 13284 ""
+ comarpshift_1.arpshift[comarpshift_1.numarpshift
+ - 1] = fnum;
+#line 13285 ""
+ }
+#line 13286 ""
+ goto L7;
#line 13287 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
- ftnlen)1);
+ } else if (*(unsigned char *)charq == 'D') {
#line 13288 ""
- if (*(unsigned char *)durq == ' ') {
-#line 13289 ""
- --all_1.iccount;
+ i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
+#line 13288 ""
+ getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[
+ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
+ 1) * 24 - 25], &all_1.iornq[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 1],
+ lineq, &all_1.iccount, (ftnlen)128);
#line 13290 ""
- } else {
+ goto L7;
-/* durq must be "-" */
+/* 140215 Allow clef change inside xtuplet. With normal code, came out one */
+/* note too late, so try making it come earlier. */
-#line 13294 ""
- ++all_1.iccount;
#line 13295 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
- 128, (ftnlen)1);
-#line 13296 ""
- --all_1.iccount;
+ } else if (*(unsigned char *)charq == 'C') {
-/* record the shift */
+/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
+
+#line 13299 ""
+ if (all_1.nnl[all_1.iv - 1] - 1 > 0) {
+#line 13299 ""
+ ++comcc_1.ncc[all_1.iv - 1];
+#line 13299 ""
+ }
+
+/* 140218 Need to get time differently inside xtup, since itsofar doesn't get */
+/* updated until after xtup is done */
-#line 13300 ""
- ++comarpshift_1.numarpshift;
-#line 13301 ""
- comarpshift_1.ivarpshift[comarpshift_1.numarpshift -
- 1] = commvl_1.ivx;
-#line 13302 ""
- comarpshift_1.iparpshift[comarpshift_1.numarpshift -
- 1] = all_1.nnl[commvl_1.ivx - 1] - 1;
-#line 13303 ""
- comarpshift_1.arpshift[comarpshift_1.numarpshift - 1]
- = fnum;
#line 13304 ""
- }
+ nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1)
+ ;
#line 13305 ""
- goto L7;
+ comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24
+ - 25] = (real) (all_1.itsofar[all_1.iv - 1] +
+ (integer) (nodurt * 1.f / ntup * (itup - 1)));
#line 13306 ""
- } else if (*(unsigned char *)charq == 'D') {
-#line 13307 ""
- i__2 = all_1.nnl[commvl_1.ivx - 1] - 1;
+ isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[
+ all_1.iv - 1] * 24 - 25],11);
#line 13307 ""
- getdyn_(&commvl_1.ivx, &i__2, &all_1.irest[commvl_1.ivx +
- (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25], &
- all_1.iornq[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] - 1) * 24 - 1], lineq, &
- all_1.iccount, (ftnlen)128);
-#line 13309 ""
- goto L7;
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
-/* 140215 Allow clef change inside xtuplet. With normal code, came out one */
-/* note too late, so try making it come earlier. */
+/* Store clef number, or 7 if clef number = 9 (French violin clef) */
+/* Computing MIN */
+#line 13311 ""
+ i__2 = numclef_(durq, (ftnlen)1);
+#line 13311 ""
+ isl |= min(i__2,7) << 12;
+#line 13312 ""
+ comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] *
+ 24 - 25] = ncmidf_(durq, (ftnlen)1);
+#line 13313 ""
+ if (*(unsigned char *)durq == '8') {
#line 13314 ""
- } else if (*(unsigned char *)charq == 'C') {
-
-/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
-
-#line 13318 ""
- if (all_1.nnl[all_1.iv - 1] - 1 > 0) {
-#line 13318 ""
- ++comcc_1.ncc[all_1.iv - 1];
-#line 13318 ""
- }
+ all_1.ipl[all_1.iv + all_1.nnl[all_1.iv - 1] * 24
+ - 25] = bit_set(all_1.ipl[all_1.iv +
+ all_1.nnl[all_1.iv - 1] * 24 - 25],2);
+#line 13315 ""
+ cominsttrans_1.itransamt[cominsttrans_1.instno[
+ all_1.iv - 1] - 1] += 7;
+#line 13316 ""
+ }
-/* 140218 Need to get time differently inside xtup, since itsofar doesn't get */
-/* updated until after xtup is done */
+/* Set marker on note with lowest voice # starting at same time. */
+#line 13320 ""
+ if (all_1.iv == 1) {
+#line 13321 ""
+ isl = bit_set(isl,15);
+#line 13322 ""
+ } else {
#line 13323 ""
- nodurt = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
-#line 13324 ""
- comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 -
- 25] = (real) (all_1.itsofar[all_1.iv - 1] + (
- integer) (nodurt * 1.f / ntup * (itup - 1)));
+ i__2 = all_1.iv;
+#line 13323 ""
+ for (iiv = 1; iiv <= i__2; ++iiv) {
+/* nnliiv = nnl(iiv) */
#line 13325 ""
- isl = bit_set(all_1.islur[all_1.iv + all_1.nnl[all_1.iv -
- 1] * 24 - 25],11);
+ nnliiv = all_1.nnl[iiv - 1] - 1;
#line 13326 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-
-/* Store clef number, or 7 if clef number = 9 (French violin clef) */
-
-/* Computing MIN */
-#line 13330 ""
- i__2 = numclef_(durq, (ftnlen)1);
+ if (iiv == all_1.iv) {
+#line 13326 ""
+ ++nnliiv;
+#line 13326 ""
+ }
+#line 13327 ""
+ itother = 0;
+#line 13328 ""
+ i__4 = nnliiv;
+#line 13328 ""
+ for (iip = 1; iip <= i__4; ++iip) {
+#line 13329 ""
+ if (itother < all_1.itsofar[all_1.iv - 1])
+ {
#line 13330 ""
- isl |= min(i__2,7) << 12;
+ itother += all_1.nodur[iiv + iip * 24
+ - 25];
#line 13331 ""
- comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24
- - 25] = ncmidf_(durq, (ftnlen)1);
+ goto L71;
#line 13332 ""
- if (*(unsigned char *)durq == '8') {
+ } else if (itother == all_1.itsofar[
+ all_1.iv - 1]) {
#line 13333 ""
- all_1.ipl[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 -
- 25] = bit_set(all_1.ipl[all_1.iv + all_1.nnl[
- all_1.iv - 1] * 24 - 25],2);
+ all_1.islur[iiv + iip * 24 - 25] =
+ bit_set(all_1.islur[iiv + iip
+ * 24 - 25],15);
#line 13334 ""
- cominsttrans_1.itransamt[cominsttrans_1.instno[
- all_1.iv - 1] - 1] += 7;
+ goto L72;
#line 13335 ""
- }
-
-/* Set marker on note with lowest voice # starting at same time. */
-
-#line 13339 ""
- if (all_1.iv == 1) {
-#line 13340 ""
- isl = bit_set(isl,15);
-#line 13341 ""
- } else {
-#line 13342 ""
- i__2 = all_1.iv;
-#line 13342 ""
- for (iiv = 1; iiv <= i__2; ++iiv) {
-/* nnliiv = nnl(iiv) */
-#line 13344 ""
- nnliiv = all_1.nnl[iiv - 1] - 1;
-#line 13345 ""
- if (iiv == all_1.iv) {
-#line 13345 ""
- ++nnliiv;
-#line 13345 ""
- }
-#line 13346 ""
- itother = 0;
-#line 13347 ""
- i__4 = nnliiv;
-#line 13347 ""
- for (iip = 1; iip <= i__4; ++iip) {
-#line 13348 ""
- if (itother < all_1.itsofar[all_1.iv - 1]) {
-#line 13349 ""
- itother += all_1.nodur[iiv + iip * 24 -
- 25];
-#line 13350 ""
- goto L71;
-#line 13351 ""
- } else if (itother == all_1.itsofar[all_1.iv
- - 1]) {
-#line 13352 ""
- all_1.islur[iiv + iip * 24 - 25] =
- bit_set(all_1.islur[iiv + iip *
- 24 - 25],15);
-#line 13353 ""
- goto L72;
-#line 13354 ""
- }
-#line 13355 ""
+ }
+#line 13336 ""
L71:
-#line 13355 ""
- ;
-#line 13355 ""
- }
-#line 13356 ""
+#line 13336 ""
+ ;
+#line 13336 ""
+ }
+#line 13337 ""
/* L70: */
-#line 13356 ""
- }
-#line 13357 ""
+#line 13337 ""
+ }
+#line 13338 ""
L72:
-#line 13358 ""
- ;
-#line 13358 ""
- }
+#line 13339 ""
+ ;
+#line 13339 ""
+ }
/* Need 'or' since may have set bit 15 in the above loop */
/* islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) */
-#line 13363 ""
- all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 - 25]
- = isl | all_1.islur[all_1.iv + all_1.nnl[all_1.iv
- - 1] * 24 - 25];
-#line 13364 ""
- goto L7;
+#line 13344 ""
+ all_1.islur[all_1.iv + all_1.nnl[all_1.iv - 1] * 24 -
+ 25] = isl | all_1.islur[all_1.iv + all_1.nnl[
+ all_1.iv - 1] * 24 - 25];
+#line 13345 ""
+ goto L7;
/* +++ */
-#line 13366 ""
- } else if (*(unsigned char *)charq == ']') {
+#line 13347 ""
+ } else if (*(unsigned char *)charq == ']') {
/* Multiplicity up-down, must have '][ ' */
-#line 13370 ""
- all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
- 1) * 24 - 25] = bit_set(all_1.islur[commvl_1.ivx
- + (all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],20)
- ;
-#line 13371 ""
- all_1.iccount += 2;
-#line 13372 ""
- goto L7;
+#line 13351 ""
+ all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
+ 1] - 1) * 24 - 25] = bit_set(all_1.islur[
+ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] -
+ 1) * 24 - 25],20);
+#line 13352 ""
+ all_1.iccount += 2;
+#line 13353 ""
+ goto L7;
/* c+++ */
-#line 13374 ""
+#line 13355 ""
+ }
+#line 13355 ""
}
/* End of loop for xtup options. If here, charq must be a (non-crd) note name. */
/* or rest */
-#line 13379 ""
+#line 13360 ""
if (*(unsigned char *)charq == 'r') {
/* Rest in xtup */
-#line 13383 ""
+#line 13364 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.irest[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],0);
-#line 13384 ""
+#line 13365 ""
i__2 = all_1.iccount;
-#line 13384 ""
+#line 13365 ""
if (i_indx("+-b", lineq + i__2, (ftnlen)3, all_1.iccount
+ 1 - i__2) > 0) {
-#line 13385 ""
+#line 13366 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 13386 ""
+#line 13367 ""
if (*(unsigned char *)durq == 'b') {
/* Blank rest in middle of xtup */
-#line 13390 ""
+#line 13371 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.islur[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],29);
-#line 13391 ""
+#line 13372 ""
} else {
/* Override height of embedded xtup rest */
-#line 13395 ""
+#line 13376 ""
ipm = i_indx("- +", durq, (ftnlen)3, (ftnlen)1) -
2;
-#line 13396 ""
+#line 13377 ""
++all_1.iccount;
-#line 13397 ""
+#line 13378 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (
ftnlen)128, (ftnlen)1);
-#line 13398 ""
+#line 13379 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = ipm * i_nint(&fnum) +
100;
-#line 13399 ""
+#line 13380 ""
--all_1.iccount;
-#line 13400 ""
+#line 13381 ""
}
-#line 13401 ""
+#line 13382 ""
} else if (commvl_1.ivx <= all_1.nv) {
-#line 13402 ""
+#line 13383 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = 0;
-#line 13403 ""
+#line 13384 ""
} else {
-#line 13404 ""
+#line 13385 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = 2;
-#line 13405 ""
+#line 13386 ""
}
-#line 13406 ""
+#line 13387 ""
} else {
/* Counter for non-rests */
-#line 13410 ""
+#line 13391 ""
++nnb;
-#line 13411 ""
+#line 13392 ""
}
-#line 13412 ""
+#line 13393 ""
comnotes_1.notcrd = TRUE_;
-#line 13413 ""
+#line 13394 ""
L8:
-#line 13413 ""
+#line 13394 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 13414 ""
+#line 13395 ""
if (*(unsigned char *)durq != ' ') {
-#line 13415 ""
+#line 13396 ""
if (i_indx("+-<>", durq, (ftnlen)4, (ftnlen)1) > 0) {
/* Accidental horizontal shift */
-#line 13419 ""
+#line 13400 ""
chkpm4ac_(lineq, &all_1.iccount, &all_1.nacc[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &moved, (ftnlen)128);
-#line 13420 ""
+#line 13401 ""
if (! moved) {
-#line 13421 ""
+#line 13402 ""
if (*(unsigned char *)durq == '+') {
-#line 13422 ""
+#line 13403 ""
comnotes_1.lastlev += 7;
-#line 13423 ""
+#line 13404 ""
} else if (*(unsigned char *)durq == '-') {
-#line 13424 ""
+#line 13405 ""
comnotes_1.lastlev += -7;
-#line 13425 ""
+#line 13406 ""
}
-#line 13426 ""
+#line 13407 ""
}
-#line 13427 ""
+#line 13408 ""
} else if (i_indx("fsn", durq, (ftnlen)3, (ftnlen)1) > 0)
{
/* if (nacc(ivx,nnl(ivx)) .eq. 0) then */
/* May have set other bits earlier */
-#line 13431 ""
+#line 13412 ""
if (igetbits_(&all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25], &c__2, &c__0) ==
0) {
@@ -31841,208 +32021,208 @@ L8:
/* No accid set yet */
/* nacc(ivx,nnl(ivx)) = index('fsn',durq) */
-#line 13436 ""
+#line 13417 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] |= i_indx("fsn", durq, (
ftnlen)3, (ftnlen)1);
-#line 13438 ""
+#line 13419 ""
} else {
/* Symbol must be repeated, so it's a double */
-#line 13442 ""
+#line 13423 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.nacc[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],2);
-#line 13443 ""
+#line 13424 ""
}
-#line 13444 ""
+#line 13425 ""
} else if (*(unsigned char *)durq == 'i') {
/* Set flag for midi-only accidental */
-#line 13448 ""
+#line 13429 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],17);
-#line 13450 ""
+#line 13431 ""
} else if (*(unsigned char *)durq == 'c') {
/* Set flags for cautionary accidental */
-#line 13454 ""
+#line 13435 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],31);
-#line 13455 ""
+#line 13436 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 1] = bit_set(all_1.iornq[commvl_1.ivx
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 1],31);
-#line 13456 ""
+#line 13437 ""
} else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Force stem direction for non-beamed xtup note */
-#line 13460 ""
+#line 13441 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.islur[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],30);
-#line 13461 ""
+#line 13442 ""
if (*(unsigned char *)durq == 'u') {
-#line 13461 ""
+#line 13442 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.islur[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],17);
-#line 13461 ""
+#line 13442 ""
}
-#line 13463 ""
+#line 13444 ""
} else if (*(unsigned char *)durq == 'e') {
/* Left-shift main xtup note */
-#line 13467 ""
+#line 13448 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.ipl[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],8);
-#line 13468 ""
+#line 13449 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],27);
-#line 13469 ""
+#line 13450 ""
} else if (*(unsigned char *)durq == 'r') {
/* Right-shift main xtup note */
-#line 13473 ""
+#line 13454 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = bit_set(all_1.ipl[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],9);
-#line 13474 ""
+#line 13455 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],20);
-#line 13475 ""
+#line 13456 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double an xtup note to make an unequal xtup */
-#line 13479 ""
+#line 13460 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18);
-#line 13480 ""
+#line 13461 ""
if (*(unsigned char *)durq == 'F') {
-#line 13480 ""
+#line 13461 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.nacc[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],19);
-#line 13480 ""
+#line 13461 ""
}
-#line 13482 ""
+#line 13463 ""
++ndoub;
-#line 13483 ""
+#line 13464 ""
} else if (*(unsigned char *)durq == 'd') {
/* Dotted xtup note */
/* if (btest(irest(ivx,nnl(ivx))-1,2)) then */
-#line 13488 ""
+#line 13469 ""
if (bit_test(all_1.irest[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25],2)) {
/* Move dot on 2nd note of 2-note tremolo */
-#line 13492 ""
+#line 13473 ""
++comcc_1.ndotmv[commvl_1.ivx - 1];
-#line 13493 ""
+#line 13474 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.irest[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],19);
-#line 13494 ""
+#line 13475 ""
g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)
128, (ftnlen)1);
/* Will be + or - */
-#line 13495 ""
+#line 13476 ""
++all_1.iccount;
-#line 13496 ""
+#line 13477 ""
readnum_(lineq, &all_1.iccount, dumq, &
comcc_1.updot[commvl_1.ivx +
comcc_1.ndotmv[commvl_1.ivx - 1] * 24 -
25], (ftnlen)128, (ftnlen)1);
-#line 13498 ""
+#line 13479 ""
if (*(unsigned char *)durq == '-') {
-#line 13498 ""
+#line 13479 ""
comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[
commvl_1.ivx - 1] * 24 - 25] =
-comcc_1.updot[commvl_1.ivx +
comcc_1.ndotmv[commvl_1.ivx - 1] * 24
- 25];
-#line 13498 ""
+#line 13479 ""
}
-#line 13500 ""
+#line 13481 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0)
{
/* Vertical shift also */
-#line 13504 ""
+#line 13485 ""
readnum_(lineq, &all_1.iccount, durq, &
comcc_1.rtdot[commvl_1.ivx +
comcc_1.ndotmv[commvl_1.ivx - 1] * 24
- 25], (ftnlen)128, (ftnlen)1);
-#line 13506 ""
+#line 13487 ""
if (*(unsigned char *)durq == '-') {
-#line 13506 ""
+#line 13487 ""
comcc_1.rtdot[commvl_1.ivx +
comcc_1.ndotmv[commvl_1.ivx - 1] *
24 - 25] = -comcc_1.rtdot[
commvl_1.ivx + comcc_1.ndotmv[
commvl_1.ivx - 1] * 24 - 25];
-#line 13506 ""
+#line 13487 ""
}
-#line 13508 ""
+#line 13489 ""
}
-#line 13509 ""
+#line 13490 ""
--all_1.iccount;
-#line 13510 ""
+#line 13491 ""
} else {
/* Dot for 3:1 pair of xtup notes */
-#line 13514 ""
+#line 13495 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25] = bit_set(all_1.nacc[
commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],27);
-#line 13515 ""
+#line 13496 ""
}
-#line 13516 ""
+#line 13497 ""
} else {
/* Must be an octave number */
-#line 13520 ""
+#line 13501 ""
i__2 = *(unsigned char *)durq - 48;
-#line 13520 ""
+#line 13501 ""
comnotes_1.lastlev = ifnolev_(charq, &i__2, &
cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (
ftnlen)1);
-#line 13522 ""
+#line 13503 ""
}
-#line 13523 ""
+#line 13504 ""
goto L8;
-#line 13524 ""
+#line 13505 ""
}
-#line 13525 ""
+#line 13506 ""
if (itup < ntup) {
/* Last note is handled *after* flowing out of the xtup if block, but still */
@@ -32050,201 +32230,201 @@ L8:
/* Could have problem here if rests & doubled notes are combined in xtup, */
/* since might exit the loop at the wrong place. Worry about it later. */
-#line 13532 ""
+#line 13513 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],0)) {
-#line 13533 ""
+#line 13514 ""
comnotes_1.lastlev = comnotes_1.lastlev - 3 + (
ifnolev_(charq, &c__10, &
cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (
ftnlen)1) - comnotes_1.lastlev + 3) % 7;
-#line 13535 ""
+#line 13516 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25] = comnotes_1.lastlev;
-#line 13536 ""
+#line 13517 ""
}
-#line 13537 ""
+#line 13518 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25] = 0;
-#line 13538 ""
+#line 13519 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set note level for preslur on internal xtup note */
-#line 13542 ""
+#line 13523 ""
setbits_(&all_1.isdat2[all_1.nsdat -
comnotes_1.npreslur], &c__7, &c__19, &
comnotes_1.lastlev);
-#line 13543 ""
+#line 13524 ""
/* L42: */
-#line 13543 ""
+#line 13524 ""
}
-#line 13544 ""
+#line 13525 ""
}
-#line 13545 ""
+#line 13526 ""
if (itup == ntup - ndoub) {
-#line 13545 ""
+#line 13526 ""
goto L12;
-#line 13545 ""
+#line 13526 ""
}
-#line 13546 ""
+#line 13527 ""
/* L6: */
-#line 13546 ""
+#line 13527 ""
}
-#line 13547 ""
+#line 13528 ""
L12:
-#line 13548 ""
+#line 13529 ""
if (comget_1.ornrpt) {
-#line 13549 ""
+#line 13530 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
1] |= all_1.iornq[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 1] & 10026991;
-#line 13551 ""
+#line 13532 ""
if ((all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 1] & 32896) > 0) {
/* This is a trill (bit 7 or 15) so must dup the parameters */
-#line 13555 ""
+#line 13536 ""
++comtrill_1.ntrill;
-#line 13556 ""
+#line 13537 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = commvl_1.ivx;
-#line 13557 ""
+#line 13538 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = all_1.nnl[
commvl_1.ivx - 1];
-#line 13558 ""
+#line 13539 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] =
comtrill_1.xnsktr[comtrill_1.ntrill - 2];
-#line 13559 ""
+#line 13540 ""
}
-#line 13560 ""
+#line 13541 ""
}
/* End of if-block for xtuplet input */
-#line 13564 ""
+#line 13545 ""
} else if (*(unsigned char *)durq == 'm') {
/* Multi-bar rest: next 1 or two digits are # of bars. */
/* For some purposes, pretend its one bar only */
-#line 13569 ""
+#line 13550 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= all_1.lenbar;
-#line 13570 ""
+#line 13551 ""
comgrace_1.ibarmbr = all_1.nbars + 1;
-#line 13571 ""
+#line 13552 ""
comgrace_1.mbrest = 0;
-#line 13572 ""
+#line 13553 ""
comgrace_1.xb4mbr = 0.f;
-#line 13573 ""
+#line 13554 ""
L20:
-#line 13573 ""
+#line 13554 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 13574 ""
+#line 13555 ""
if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57)
{
-#line 13575 ""
+#line 13556 ""
comgrace_1.mbrest = comgrace_1.mbrest * 10 + *(unsigned char *
)durq - 48;
-#line 13576 ""
+#line 13557 ""
goto L20;
-#line 13577 ""
+#line 13558 ""
}
/* durq will either be blank or 'n' */
-#line 13580 ""
+#line 13561 ""
if (*(unsigned char *)durq == 'n') {
/* Get new height */
-#line 13584 ""
+#line 13565 ""
iplmi = 1;
-#line 13585 ""
+#line 13566 ""
g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1)
;
-#line 13586 ""
+#line 13567 ""
if (*(unsigned char *)durq == '-') {
-#line 13587 ""
+#line 13568 ""
iplmi = -1;
-#line 13588 ""
+#line 13569 ""
++all_1.iccount;
-#line 13589 ""
+#line 13570 ""
}
-#line 13590 ""
+#line 13571 ""
readnum_(lineq, &all_1.iccount, durq, &hgt, (ftnlen)128, (
ftnlen)1);
-#line 13591 ""
+#line 13572 ""
r__1 = iplmi * hgt;
-#line 13591 ""
+#line 13572 ""
comignorenats_1.mbrhgt = i_nint(&r__1);
-#line 13592 ""
+#line 13573 ""
comignorenats_1.newmbrhgt = TRUE_;
-#line 13593 ""
+#line 13574 ""
}
-#line 13594 ""
+#line 13575 ""
} else if (i_indx("ul", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Set stem flipper */
-#line 13598 ""
+#line 13579 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],30);
-#line 13599 ""
+#line 13580 ""
if (*(unsigned char *)durq == 'u') {
-#line 13599 ""
+#line 13580 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],17);
-#line 13599 ""
+#line 13580 ""
}
-#line 13601 ""
+#line 13582 ""
goto L2;
-#line 13602 ""
+#line 13583 ""
} else if (*(unsigned char *)durq == 'a') {
/* "Alone", i.e., prohibit beam */
-#line 13606 ""
+#line 13587 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],18);
-#line 13607 ""
+#line 13588 ""
goto L2;
-#line 13608 ""
+#line 13589 ""
} else if (*(unsigned char *)durq == 'r') {
/* Right offset by one notehead */
-#line 13612 ""
+#line 13593 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],9);
-#line 13613 ""
+#line 13594 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],20);
-#line 13614 ""
+#line 13595 ""
goto L2;
-#line 13615 ""
+#line 13596 ""
} else if (*(unsigned char *)durq == 'e') {
/* Left offset by one notehead */
-#line 13619 ""
+#line 13600 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],8);
-#line 13620 ""
+#line 13601 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],27);
-#line 13621 ""
+#line 13602 ""
goto L2;
-#line 13622 ""
+#line 13603 ""
} else if (i_indx("LS", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Stemlength change. Get dstemlen in \internotes. Allowable values are -4 to 27.5 */
@@ -32252,427 +32432,427 @@ L20:
/* interbeams = internotes*2/3. */
-#line 13629 ""
+#line 13610 ""
isign = 1;
-#line 13630 ""
+#line 13611 ""
if (*(unsigned char *)durq == 'S') {
-#line 13630 ""
+#line 13611 ""
isign = -1;
-#line 13630 ""
+#line 13611 ""
}
-#line 13631 ""
+#line 13612 ""
all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],27);
-#line 13632 ""
+#line 13613 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 13633 ""
+#line 13614 ""
if (*(unsigned char *)durq == ':') {
/* End stickyS. Grab data now from prior note, since we have to shut off stickyS. */
-#line 13637 ""
+#line 13618 ""
i__1 = igetbits_(&all_1.mult[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25], &c__6, &c__10);
-#line 13637 ""
+#line 13618 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25], &c__6, &c__10, &i__1);
-#line 13639 ""
+#line 13620 ""
comget_1.stickys = FALSE_;
-#line 13640 ""
+#line 13621 ""
goto L2;
-#line 13641 ""
+#line 13622 ""
}
/* If durq .ne. ':' then iccount is now on the start of the number */
-#line 13645 ""
+#line 13626 ""
readnum_(lineq, &all_1.iccount, durq, &dum, (ftnlen)128, (ftnlen)
1);
-#line 13646 ""
+#line 13627 ""
dum = isign * dum;
-#line 13647 ""
+#line 13628 ""
r__1 = (dum + 4.f) * 2;
-#line 13647 ""
+#line 13628 ""
i__1 = i_nint(&r__1);
-#line 13647 ""
+#line 13628 ""
setbits_(&all_1.mult[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &c__6, &c__10, &i__1);
-#line 13648 ""
+#line 13629 ""
if (*(unsigned char *)durq == ':') {
-#line 13649 ""
+#line 13630 ""
comget_1.stickys = TRUE_;
-#line 13650 ""
+#line 13631 ""
} else {
-#line 13651 ""
+#line 13632 ""
--all_1.iccount;
-#line 13652 ""
+#line 13633 ""
}
-#line 13653 ""
+#line 13634 ""
goto L2;
-#line 13654 ""
+#line 13635 ""
} else if (*(unsigned char *)durq == ',') {
/* 2:1 pattern */
-#line 13658 ""
+#line 13639 ""
idotform = 3;
/* Now flow to duration setting, as if durq=' ' */
-#line 13662 ""
+#line 13643 ""
} else if (*(unsigned char *)durq == '.') {
/* Dotted pattern. Close out note. Mult time by 3/4. */
/* Set time for next note to 1/4. Start the note. */
-#line 13667 ""
+#line 13648 ""
idotform = 1;
-#line 13668 ""
+#line 13649 ""
} else if (*(unsigned char *)durq == 'o') {
/* Suppress rest centering */
-#line 13672 ""
+#line 13653 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],25);
-#line 13673 ""
+#line 13654 ""
goto L2;
-#line 13674 ""
+#line 13655 ""
} else if (*(unsigned char *)durq == 'L') {
/* With keyboard rest option, look left */
/* iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) */
-#line 13679 ""
+#line 13660 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],1);
-#line 13680 ""
+#line 13661 ""
goto L2;
-#line 13681 ""
+#line 13662 ""
} else if (i_indx("DF", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Double note for xtup. Must check here in case "D" came before "x" or on */
/* last note of xtup. Need to flag it in pmxa since affects horiz. spacing. */
-#line 13686 ""
+#line 13667 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],18);
-#line 13687 ""
+#line 13668 ""
if (*(unsigned char *)durq == 'F') {
-#line 13687 ""
+#line 13668 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],19);
-#line 13687 ""
+#line 13668 ""
}
-#line 13689 ""
+#line 13670 ""
goto L2;
-#line 13690 ""
+#line 13671 ""
} else if (*(unsigned char *)durq == 'A') {
/* Accidental option */
-#line 13694 ""
+#line 13675 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 13696 ""
+#line 13677 ""
if (*(unsigned char *)durq == 'o') {
/* Ordered accidentals in a chord. Mark the main note. */
-#line 13700 ""
+#line 13681 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],28);
-#line 13701 ""
+#line 13682 ""
} else {
/* Only other possibility is +-<> . Set tag, reduce iccount and loop to get #'s */
-#line 13705 ""
+#line 13686 ""
all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],29);
-#line 13706 ""
+#line 13687 ""
--all_1.iccount;
-#line 13707 ""
+#line 13688 ""
}
-#line 13708 ""
+#line 13689 ""
goto L2;
-#line 13709 ""
+#line 13690 ""
} else if (*(unsigned char *)durq == 'T') {
-#line 13710 ""
+#line 13691 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 13711 ""
+#line 13692 ""
multtrem = i_indx("1234", durq, (ftnlen)4, (ftnlen)1);
-#line 13712 ""
+#line 13693 ""
if (multtrem == 0) {
-#line 13713 ""
+#line 13694 ""
--all_1.iccount;
-#line 13714 ""
+#line 13695 ""
multtrem = 1;
-#line 13715 ""
+#line 13696 ""
}
-#line 13716 ""
+#line 13697 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],4);
-#line 13717 ""
+#line 13698 ""
i__1 = multtrem - 1;
-#line 13717 ""
+#line 13698 ""
setbits_(&all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25], &c__2, &c__5, &i__1);
-#line 13718 ""
+#line 13699 ""
goto L2;
-#line 13719 ""
+#line 13700 ""
} else if (*(unsigned char *)durq != ' ') {
-#line 13720 ""
- s_wsle(&io___816);
-#line 13720 ""
+#line 13701 ""
+ s_wsle(&io___815);
+#line 13701 ""
do_lio(&c__9, &c__1, "Illegal character in note: ", (ftnlen)27);
-#line 13720 ""
+#line 13701 ""
do_lio(&c__9, &c__1, durq, (ftnlen)1);
-#line 13720 ""
+#line 13701 ""
do_lio(&c__9, &c__1, ", ivx,nn:", (ftnlen)9);
-#line 13720 ""
+#line 13701 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
-#line 13720 ""
+#line 13701 ""
do_lio(&c__3, &c__1, (char *)&all_1.nnl[commvl_1.ivx - 1], (
ftnlen)sizeof(integer));
-#line 13720 ""
+#line 13701 ""
e_wsle();
-#line 13722 ""
+#line 13703 ""
stop1_();
-#line 13723 ""
+#line 13704 ""
}
/* Done with note/rest options. Set level and duration. */
-#line 13727 ""
+#line 13708 ""
if (! bit_test(all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
* 24 - 25],0)) {
-#line 13728 ""
+#line 13709 ""
if (numnum == 2) {
-#line 13729 ""
+#line 13710 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[
all_1.iv - 1] - 1], (ftnlen)1);
-#line 13730 ""
+#line 13711 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = comnotes_1.lastlev;
-#line 13731 ""
+#line 13712 ""
} else {
-#line 13732 ""
+#line 13713 ""
comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq,
&c__10, &cominsttrans_1.itransamt[
cominsttrans_1.instno[all_1.iv - 1] - 1], (ftnlen)1)
- comnotes_1.lastlev + 3) % 7;
-#line 13734 ""
+#line 13715 ""
all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = comnotes_1.lastlev;
-#line 13735 ""
+#line 13716 ""
}
-#line 13736 ""
+#line 13717 ""
for (comnotes_1.npreslur = comnotes_1.npreslur;
comnotes_1.npreslur >= 1; --comnotes_1.npreslur) {
/* Set level for preslur on normal note, non-chord */
-#line 13740 ""
+#line 13721 ""
setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &
c__7, &c__19, &comnotes_1.lastlev);
-#line 13741 ""
+#line 13722 ""
/* L43: */
-#line 13741 ""
+#line 13722 ""
}
/* Only matters if last note, non-rest of xtuplet */
-#line 13745 ""
+#line 13726 ""
++nnb;
-#line 13746 ""
+#line 13727 ""
}
/* Set flag for unbeamed xtup if it just has 1 note */
-#line 13750 ""
+#line 13731 ""
if (inxtup && nnb == 1) {
-#line 13751 ""
+#line 13732 ""
all_1.islur[commvl_1.ivx + note1xtup * 24 - 25] = bit_set(
all_1.islur[commvl_1.ivx + note1xtup * 24 - 25],18);
-#line 13752 ""
+#line 13733 ""
}
-#line 13753 ""
+#line 13734 ""
if (idotform > 0) {
-#line 13754 ""
+#line 13735 ""
if (idotform == 1) {
-#line 13755 ""
+#line 13736 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1) *
3 / 2;
-#line 13756 ""
+#line 13737 ""
} else if (idotform == 2) {
-#line 13757 ""
+#line 13738 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25] / 3;
-#line 13758 ""
+#line 13739 ""
} else if (idotform == 3) {
-#line 13759 ""
+#line 13740 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
-#line 13760 ""
+#line 13741 ""
} else if (idotform == 4) {
-#line 13761 ""
+#line 13742 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = all_1.nodur[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] - 1) * 24 - 25] / 2;
-#line 13762 ""
+#line 13743 ""
}
-#line 13763 ""
+#line 13744 ""
} else if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- 1] * 24 - 25],19)) {
/* Set duration of full-bar rest as pause */
-#line 13767 ""
+#line 13748 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= all_1.lenbar;
/* Use a one-line function to set nnodur. It gives inverse of ifnodur. */
-#line 13771 ""
+#line 13752 ""
i__1 = (integer) (log(all_1.lenbar + .1f) / .69315f) + 48;
-#line 13771 ""
+#line 13752 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 13771 ""
+#line 13752 ""
comnotes_1.nnodur = i_indx("62514x0x37", ch__1, (ftnlen)10, (
ftnlen)1) - 1;
-#line 13773 ""
+#line 13754 ""
} else if (comgrace_1.ibarmbr != all_1.nbars + 1) {
-#line 13774 ""
+#line 13755 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= ifnodur_(&comnotes_1.nnodur, dotq, (ftnlen)1);
-#line 13775 ""
+#line 13756 ""
if (bit_test(all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx -
1] * 24 - 25],3)) {
-#line 13775 ""
+#line 13756 ""
all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = all_1.nodur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25] * 7 / 6;
-#line 13775 ""
+#line 13756 ""
}
-#line 13777 ""
+#line 13758 ""
}
-#line 13778 ""
+#line 13759 ""
if (comnotes_1.shifton && ! bit_test(all_1.irest[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25],16)) {
/* Shift is on, and this is not first shifted note. Check for duration change */
-#line 13782 ""
+#line 13763 ""
if (all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] != all_1.nodur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
- 1] - 1) * 24 - 25]) {
/* Must stop and restart the offset. */
-#line 13786 ""
+#line 13767 ""
all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] - 1) *
24 - 25] = bit_set(all_1.irest[commvl_1.ivx + (
all_1.nnl[commvl_1.ivx - 1] - 1) * 24 - 25],17);
-#line 13787 ""
+#line 13768 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],16);
-#line 13788 ""
+#line 13769 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
-#line 13789 ""
+#line 13770 ""
comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx
- 1] * 24 - 25] = comudsp_1.udoff[commvl_1.ivx + (
comudsp_1.nudoff[commvl_1.ivx - 1] - 1) * 24 - 25];
-#line 13790 ""
+#line 13771 ""
}
-#line 13791 ""
+#line 13772 ""
}
-#line 13792 ""
+#line 13773 ""
all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
-#line 13793 ""
+#line 13774 ""
if (comfb_1.autofbon && comfb_1.tautofb > comtol_1.tol &&
comget_1.fbon) {
/* Check to see if need to terminate auto forced beam */
-#line 13797 ""
+#line 13778 ""
r__1 = all_1.itsofar[commvl_1.ivx - 1] - comfb_1.t1autofb;
-#line 13797 ""
+#line 13778 ""
if (r_mod(&r__1, &comfb_1.tautofb) < comtol_1.tol) {
/* Terminate autofb */
-#line 13801 ""
+#line 13782 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
-#line 13802 ""
+#line 13783 ""
comget_1.fbon = FALSE_;
-#line 13803 ""
+#line 13784 ""
}
-#line 13804 ""
+#line 13785 ""
}
-#line 13805 ""
+#line 13786 ""
if ((all_1.itsofar[commvl_1.ivx - 1] - all_1.lenb0) % all_1.lenbar ==
0) {
/* Finished a bar */
-#line 13809 ""
+#line 13790 ""
++all_1.nbars;
-#line 13810 ""
+#line 13791 ""
all_1.nib[commvl_1.ivx + all_1.nbars * 24 - 25] = all_1.nnl[
commvl_1.ivx - 1];
-#line 13811 ""
+#line 13792 ""
if (all_1.firstgulp && all_1.lenb0 != 0 && all_1.nbars == 1) {
/* Just finished the pickup bar for this voice. */
-#line 13815 ""
+#line 13796 ""
all_1.lenbar = all_1.lenb1;
-#line 13816 ""
+#line 13797 ""
}
-#line 13817 ""
+#line 13798 ""
}
-#line 13818 ""
+#line 13799 ""
if (idotform == 1) {
-#line 13819 ""
+#line 13800 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 13820 ""
+#line 13801 ""
idotform = 2;
-#line 13821 ""
+#line 13802 ""
numnum = 1;
-#line 13822 ""
+#line 13803 ""
goto L28;
-#line 13823 ""
+#line 13804 ""
} else if (idotform == 3) {
-#line 13824 ""
+#line 13805 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 13825 ""
+#line 13806 ""
idotform = 4;
-#line 13826 ""
+#line 13807 ""
numnum = 1;
-#line 13827 ""
+#line 13808 ""
goto L28;
-#line 13828 ""
+#line 13809 ""
}
/* End of sub block for note-rest */
-#line 13832 ""
+#line 13813 ""
} else if (*(unsigned char *)charq == 'z') {
/* Chord note. Must have note name, may have octave#,+,-,s,f,n,d */
@@ -32704,331 +32884,331 @@ L20:
/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
-#line 13863 ""
+#line 13844 ""
++comtrill_1.ncrd;
-#line 13864 ""
+#line 13845 ""
all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
bit_set(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25],10);
-#line 13865 ""
+#line 13846 ""
numnum = 0;
/* icrdat(ncrd) = ior(nnl(ivx)-1,ishft(ivx,8)) */
-#line 13867 ""
+#line 13848 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = all_1.nnl[commvl_1.ivx - 1];
-#line 13868 ""
+#line 13849 ""
i__1 = commvl_1.ivx % 16;
-#line 13868 ""
+#line 13849 ""
setbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__4, &c__8, &i__1)
;
-#line 13869 ""
+#line 13850 ""
if (commvl_1.ivx >= 16) {
-#line 13869 ""
+#line 13850 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],28);
-#line 13869 ""
+#line 13850 ""
}
-#line 13870 ""
+#line 13851 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] = 0;
-#line 13871 ""
+#line 13852 ""
comtrill_1.icrdorn[comtrill_1.ncrd - 1] = 0;
/* Get note name */
-#line 13875 ""
+#line 13856 ""
getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
/* Get optional inputs */
-#line 13879 ""
+#line 13860 ""
L25:
-#line 13879 ""
+#line 13860 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
/* ndx = index('fsn+-<>12345678rediA',durq) */
-#line 13881 ""
+#line 13862 ""
ndx = i_indx("fsn+-<>12345678rediAc", durq, (ftnlen)21, (ftnlen)1);
-#line 13882 ""
+#line 13863 ""
if (ndx == 20) {
/* Expect +|-|<|> , set tag, loop */
-#line 13886 ""
+#line 13867 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],29);
-#line 13887 ""
+#line 13868 ""
goto L25;
-#line 13888 ""
+#line 13869 ""
} else if (ndx > 0) {
-#line 13889 ""
+#line 13870 ""
if (ndx <= 3) {
-#line 13890 ""
+#line 13871 ""
if (! bit_test(comtrill_1.icrdat[comtrill_1.ncrd - 1],19)) {
-#line 13891 ""
+#line 13872 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],19);
-#line 13892 ""
+#line 13873 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |= ndx << 20;
-#line 13893 ""
+#line 13874 ""
} else {
-#line 13894 ""
+#line 13875 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],22);
-#line 13895 ""
+#line 13876 ""
}
-#line 13896 ""
+#line 13877 ""
} else if (ndx == 21) {
/* Set flags for cautionary accidental */
-#line 13900 ""
+#line 13881 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],31);
-#line 13901 ""
+#line 13882 ""
all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 1],31);
-#line 13902 ""
+#line 13883 ""
} else if (ndx <= 7) {
/* +/-/</> Check whether octave or accidental shift */
-#line 13906 ""
+#line 13887 ""
nactmp = 0;
-#line 13907 ""
+#line 13888 ""
chkpm4ac_(lineq, &all_1.iccount, &nactmp, &moved, (ftnlen)128)
;
-#line 13908 ""
+#line 13889 ""
if (moved) {
/* Transfer accidental shift values */
-#line 13912 ""
+#line 13893 ""
i__1 = igetbits_(&nactmp, &c__6, &c__4);
-#line 13912 ""
+#line 13893 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__6, &
c__14, &i__1);
-#line 13913 ""
+#line 13894 ""
i__1 = igetbits_(&nactmp, &c__7, &c__10);
-#line 13913 ""
+#line 13894 ""
setbits_(&comtrill_1.icrdot[comtrill_1.ncrd - 1], &c__7, &
c__20, &i__1);
-#line 13914 ""
+#line 13895 ""
} else {
-#line 13915 ""
+#line 13896 ""
if (*(unsigned char *)durq == '+') {
-#line 13916 ""
+#line 13897 ""
comnotes_1.lastlev += 7;
-#line 13917 ""
+#line 13898 ""
} else if (*(unsigned char *)durq == '-') {
-#line 13918 ""
+#line 13899 ""
comnotes_1.lastlev += -7;
-#line 13919 ""
+#line 13900 ""
}
-#line 13920 ""
+#line 13901 ""
}
-#line 13921 ""
+#line 13902 ""
} else if (*(unsigned char *)durq == 'e') {
-#line 13922 ""
+#line 13903 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],23);
-#line 13923 ""
+#line 13904 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],27);
-#line 13924 ""
+#line 13905 ""
} else if (*(unsigned char *)durq == 'r') {
-#line 13925 ""
+#line 13906 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],24);
-#line 13926 ""
+#line 13907 ""
all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],20);
-#line 13927 ""
+#line 13908 ""
} else if (*(unsigned char *)durq == 'i') {
/* Midi-only accidental on chord note */
-#line 13931 ""
+#line 13912 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],27);
-#line 13932 ""
+#line 13913 ""
} else if (*(unsigned char *)durq == 'd') {
/* Must keep 'd' optional (backward compatibility), unless it is moved! */
-#line 13936 ""
+#line 13917 ""
i__1 = all_1.iccount;
-#line 13936 ""
+#line 13917 ""
if (i_indx("+-", lineq + i__1, (ftnlen)2, all_1.iccount + 1 -
i__1) > 0) {
/* move a dot, unless next char is not part of a number */
-#line 13940 ""
+#line 13921 ""
i__1 = all_1.iccount + 1;
-#line 13940 ""
+#line 13921 ""
if (i_indx("0123456789.", lineq + i__1, (ftnlen)11,
all_1.iccount + 2 - i__1) == 0) {
-#line 13940 ""
+#line 13921 ""
goto L25;
-#line 13940 ""
+#line 13921 ""
}
-#line 13942 ""
+#line 13923 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
comtrill_1.icrdat[comtrill_1.ncrd - 1],26);
-#line 13943 ""
+#line 13924 ""
getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
ftnlen)1);
-#line 13944 ""
+#line 13925 ""
++all_1.iccount;
-#line 13945 ""
+#line 13926 ""
readnum_(lineq, &all_1.iccount, dumq, &fnum, (ftnlen)128,
(ftnlen)1);
-#line 13946 ""
+#line 13927 ""
if (*(unsigned char *)durq == '+') {
-#line 13947 ""
+#line 13928 ""
r__1 = fnum * 10;
-#line 13947 ""
+#line 13928 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= i_nint(&
r__1) + 64;
-#line 13948 ""
+#line 13929 ""
} else {
-#line 13949 ""
+#line 13930 ""
r__1 = fnum * 10;
-#line 13949 ""
+#line 13930 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= -i_nint(&
r__1) + 64;
-#line 13950 ""
+#line 13931 ""
}
-#line 13951 ""
+#line 13932 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Vertical shift specified also */
-#line 13955 ""
+#line 13936 ""
++all_1.iccount;
-#line 13956 ""
+#line 13937 ""
readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)
128, (ftnlen)1);
-#line 13957 ""
+#line 13938 ""
if (*(unsigned char *)dumq == '+') {
-#line 13958 ""
+#line 13939 ""
r__1 = fnum * 10;
-#line 13958 ""
+#line 13939 ""
ifnum = i_nint(&r__1) + 64;
-#line 13959 ""
+#line 13940 ""
} else {
-#line 13960 ""
+#line 13941 ""
r__1 = fnum * 10;
-#line 13960 ""
+#line 13941 ""
ifnum = -i_nint(&r__1) + 64;
-#line 13961 ""
+#line 13942 ""
}
-#line 13962 ""
+#line 13943 ""
} else {
-#line 13963 ""
+#line 13944 ""
ifnum = 64;
-#line 13964 ""
+#line 13945 ""
}
-#line 13965 ""
+#line 13946 ""
comtrill_1.icrdot[comtrill_1.ncrd - 1] |= ifnum << 7;
-#line 13966 ""
+#line 13947 ""
--all_1.iccount;
-#line 13967 ""
+#line 13948 ""
}
-#line 13968 ""
+#line 13949 ""
} else {
/* must be a single digit, save it in ioct */
-#line 13972 ""
+#line 13953 ""
numnum = 1;
-#line 13973 ""
+#line 13954 ""
ioct = ndx - 7;
-#line 13974 ""
+#line 13955 ""
}
-#line 13975 ""
+#line 13956 ""
goto L25;
-#line 13976 ""
+#line 13957 ""
}
-#line 13977 ""
+#line 13958 ""
if (numnum == 1) {
-#line 13978 ""
+#line 13959 ""
comnotes_1.lastlev = ifnolev_(charq, &ioct, &
cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv -
1] - 1], (ftnlen)1);
-#line 13979 ""
+#line 13960 ""
} else {
-#line 13980 ""
+#line 13961 ""
comnotes_1.lastlev = comnotes_1.lastlev - 3 + (ifnolev_(charq, &
c__10, &cominsttrans_1.itransamt[cominsttrans_1.instno[
all_1.iv - 1] - 1], (ftnlen)1) - comnotes_1.lastlev + 3) %
7;
-#line 13982 ""
+#line 13963 ""
}
-#line 13983 ""
+#line 13964 ""
comtrill_1.icrdat[comtrill_1.ncrd - 1] |= comnotes_1.lastlev << 12;
-#line 13984 ""
+#line 13965 ""
for (comnotes_1.npreslur = comnotes_1.npreslur; comnotes_1.npreslur >=
1; --comnotes_1.npreslur) {
-#line 13985 ""
+#line 13966 ""
setbits_(&all_1.isdat2[all_1.nsdat - comnotes_1.npreslur], &c__7,
&c__19, &comnotes_1.lastlev);
/* Set level for chord note. */
/* Initially I assigned the slur(s) to next note, so fix. */
-#line 13990 ""
+#line 13971 ""
all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- 25] = bit_clear(all_1.islur[commvl_1.ivx + (all_1.nnl[
commvl_1.ivx - 1] + 1) * 24 - 25],0);
-#line 13991 ""
+#line 13972 ""
all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
= bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
commvl_1.ivx - 1] * 24 - 25],0);
-#line 13992 ""
+#line 13973 ""
all_1.isdat2[all_1.nsdat - comnotes_1.npreslur] = bit_set(
all_1.isdat2[all_1.nsdat - comnotes_1.npreslur],0);
-#line 13993 ""
+#line 13974 ""
i__1 = igetbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur],
&c__8, &c__3) - 1;
-#line 13993 ""
+#line 13974 ""
setbits_(&all_1.isdat1[all_1.nsdat - comnotes_1.npreslur], &c__8,
&c__3, &i__1);
-#line 13995 ""
+#line 13976 ""
/* L44: */
-#line 13995 ""
+#line 13976 ""
}
-#line 13996 ""
+#line 13977 ""
if (comnotes_1.notcrd) {
/* This is the first chord note in this chord. */
/* Computing MIN */
-#line 14000 ""
+#line 13981 ""
i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25];
-#line 14000 ""
+#line 13981 ""
comtrill_1.minlev = min(i__1,comnotes_1.lastlev);
/* Computing MAX */
-#line 14001 ""
+#line 13982 ""
i__1 = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
24 - 25];
-#line 14001 ""
+#line 13982 ""
comtrill_1.maxlev = max(i__1,comnotes_1.lastlev);
-#line 14002 ""
+#line 13983 ""
} else {
-#line 14003 ""
+#line 13984 ""
comtrill_1.minlev = min(comtrill_1.minlev,comnotes_1.lastlev);
-#line 14004 ""
+#line 13985 ""
comtrill_1.maxlev = max(comtrill_1.maxlev,comnotes_1.lastlev);
-#line 14005 ""
+#line 13986 ""
}
-#line 14006 ""
+#line 13987 ""
comnotes_1.notcrd = FALSE_;
-#line 14007 ""
+#line 13988 ""
} else if (*(unsigned char *)charq == 'G') {
-#line 14008 ""
+#line 13989 ""
getgrace_(&commvl_1.ivx, all_1.nnl, lineq, &all_1.iccount,
all_1.islur, all_1.iornq, all_1.ipl, comnotes_1.ndlev, &
comnotes_1.lastlev, &all_1.iv, &all_1.nv, (ftnlen)128);
@@ -33046,1372 +33226,1394 @@ L25:
/* These data MUST precede note name of first note */
/* nolevg, naccg: lists of levels and accid's, indexed as described above. */
-#line 14024 ""
+#line 14005 ""
} else if (*(unsigned char *)charq == *(unsigned char *)all_1.sq) {
/* Literal TeX string */
-#line 14028 ""
+#line 14009 ""
i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
-#line 14028 ""
+#line 14009 ""
littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, &
all_1.iccount, (ftnlen)128);
-#line 14029 ""
- } else if (*(unsigned char *)charq == '"') {
+#line 14010 ""
+ } else /* if(complicated condition) */ {
+#line 14010 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 14010 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
/* pmxlyr string. Expand "..." to \pmxlyr{...}\ */
-#line 14033 ""
- if (! comlyr_1.inputmlyr) {
-#line 14034 ""
- ictemp = 0;
+#line 14014 ""
+ if (! comlyr_1.inputmlyr) {
+#line 14015 ""
+ ictemp = 0;
/* Writing concatenation */
-#line 14035 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
-#line 14035 ""
- i__3[1] = 1, a__1[1] = all_1.sq;
-#line 14035 ""
- i__3[2] = 1, a__1[2] = all_1.sq;
-#line 14035 ""
- i__3[3] = 15, a__1[3] = "input musixlyr ";
-#line 14035 ""
- i__3[4] = 1, a__1[4] = all_1.sq;
-#line 14035 ""
- s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
-#line 14036 ""
+#line 14016 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14016 ""
+ i__3[1] = 1, a__1[1] = all_1.sq;
+#line 14016 ""
+ i__3[2] = 1, a__1[2] = all_1.sq;
+#line 14016 ""
+ i__3[3] = 15, a__1[3] = "input musixlyr ";
+#line 14016 ""
+ i__3[4] = 1, a__1[4] = all_1.sq;
+#line 14016 ""
+ s_cat(lineqt, a__1, i__3, &c__5, (ftnlen)128);
+#line 14017 ""
+ i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
+#line 14017 ""
+ littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods,
+ lineqt, &ictemp, (ftnlen)128);
+#line 14018 ""
+ comlyr_1.inputmlyr = TRUE_;
+#line 14019 ""
+ }
+#line 14020 ""
+ dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
+#line 14021 ""
+ *(unsigned char *)charq = *(unsigned char *)all_1.sq;
+#line 14022 ""
i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
-#line 14036 ""
+#line 14022 ""
littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods,
- lineqt, &ictemp, (ftnlen)128);
-#line 14037 ""
- comlyr_1.inputmlyr = TRUE_;
-#line 14038 ""
- }
-#line 14039 ""
- dopmxlyr_(lineq, &all_1.iccount, (ftnlen)128);
-#line 14040 ""
- *(unsigned char *)charq = *(unsigned char *)all_1.sq;
-#line 14041 ""
- i__1 = all_1.nnl[commvl_1.ivx - 1] + 1;
-#line 14041 ""
- littex_(all_1.islur, &i__1, &commvl_1.ivx, &comas3_1.topmods, lineq, &
- all_1.iccount, (ftnlen)128);
-#line 14042 ""
- } else if (*(unsigned char *)charq == 'o') {
+ lineq, &all_1.iccount, (ftnlen)128);
+#line 14023 ""
+ } else if (*(unsigned char *)charq == 'o') {
/* Ornament on non-xtup note. Symbol must come AFTER the affected note */
-#line 14046 ""
- if (comnotes_1.notcrd) {
+#line 14027 ""
+ if (comnotes_1.notcrd) {
+#line 14028 ""
+ nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
+ * 24 - 25];
+#line 14029 ""
+ } else {
+#line 14030 ""
+ nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1]
+ , (ftnlen)-12);
+#line 14031 ""
+ }
+#line 14032 ""
+ getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx +
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[
+ commvl_1.ivx - 1], &comget_1.ornrpt, &comgrace_1.noffseg,
+ &all_1.nnl[commvl_1.ivx - 1], &commvl_1.ivx, &c_true, &
+ comnotes_1.notcrd, &nole, (ftnlen)128);
+#line 14035 ""
+ } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
+#line 14036 ""
+ nnlivx = all_1.nnl[commvl_1.ivx - 1];
+#line 14037 ""
+ if (*(unsigned char *)charq == '(' || *(unsigned char *)charq ==
+ '{') {
+
+/* Detect preslur on normal non-chord note */
+
+#line 14041 ""
+ ++nnlivx;
+#line 14042 ""
+ ++comnotes_1.npreslur;
+#line 14043 ""
+ }
+#line 14044 ""
+ all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
+ all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],0);
+#line 14045 ""
+ if (*(unsigned char *)charq == 't') {
+#line 14045 ""
+ all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
+ all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1);
+#line 14045 ""
+ }
#line 14047 ""
- nole = all_1.nolev[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
- 24 - 25];
+ if (commvl_1.ivx <= all_1.nv) {
#line 14048 ""
- } else {
+ kv = 1;
#line 14049 ""
- nole = 127 & lbit_shift(comtrill_1.icrdat[comtrill_1.ncrd - 1], (
- ftnlen)-12);
+ } else {
#line 14050 ""
- }
+ kv = 2;
#line 14051 ""
- getorn_(lineq, &all_1.iccount, &all_1.iornq[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 1], &all_1.iornq[commvl_1.ivx - 1], &
- comget_1.ornrpt, &comgrace_1.noffseg, &all_1.nnl[commvl_1.ivx
- - 1], &commvl_1.ivx, &c_true, &comnotes_1.notcrd, &nole, (
- ftnlen)128);
-#line 14054 ""
- } else if (i_indx("st(){}", charq, (ftnlen)6, (ftnlen)1) > 0) {
+ }
+#line 14052 ""
+ if (comslur_1.fontslur) {
+#line 14053 ""
+ sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
+ all_1.isdat1, all_1.isdat2, all_1.isdat3, &
+ all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[
+ commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128,
+ (ftnlen)1);
#line 14055 ""
- nnlivx = all_1.nnl[commvl_1.ivx - 1];
+ } else {
#line 14056 ""
- if (*(unsigned char *)charq == '(' || *(unsigned char *)charq == '{')
- {
+ spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
+ all_1.isdat1, all_1.isdat2, all_1.isdat3,
+ all_1.isdat4, &all_1.nsdat, &comnotes_1.notcrd, &
+ all_1.nolev[commvl_1.ivx + nnlivx * 24 - 25], charq, (
+ ftnlen)128, (ftnlen)1);
+#line 14058 ""
+ }
+#line 14059 ""
+ } else if (*(unsigned char *)charq == '?') {
-/* Detect preslur on normal non-chord note */
+/* Arpeggio */
-#line 14060 ""
- ++nnlivx;
-#line 14061 ""
- ++comnotes_1.npreslur;
-#line 14062 ""
- }
#line 14063 ""
- all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(all_1.islur[
- commvl_1.ivx + nnlivx * 24 - 25],0);
-#line 14064 ""
- if (*(unsigned char *)charq == 't') {
-#line 14064 ""
- all_1.islur[commvl_1.ivx + nnlivx * 24 - 25] = bit_set(
- all_1.islur[commvl_1.ivx + nnlivx * 24 - 25],1);
-#line 14064 ""
- }
-#line 14066 ""
- if (commvl_1.ivx <= all_1.nv) {
-#line 14067 ""
- kv = 1;
+ if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1]
+ * 24 - 25],10)) {
+
+/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */
+/* of chord, will not set icrdat(25), but iornq(27) */
+
#line 14068 ""
- } else {
+ comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
+ comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
#line 14069 ""
- kv = 2;
+ } else {
#line 14070 ""
- }
+ all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 1] = bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 1],27);
#line 14071 ""
- if (comslur_1.fontslur) {
-#line 14072 ""
- sslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
- all_1.isdat1, all_1.isdat2, all_1.isdat3, &all_1.nsdat, &
- comnotes_1.notcrd, &all_1.nolev[commvl_1.ivx + nnlivx *
- 24 - 25], charq, (ftnlen)128, (ftnlen)1);
-#line 14074 ""
- } else {
+ }
+
+/* Check for shift */
+
#line 14075 ""
- spsslur_(lineq, &all_1.iccount, &all_1.iv, &kv, &nnlivx,
- all_1.isdat1, all_1.isdat2, all_1.isdat3, all_1.isdat4, &
- all_1.nsdat, &comnotes_1.notcrd, &all_1.nolev[
- commvl_1.ivx + nnlivx * 24 - 25], charq, (ftnlen)128, (
- ftnlen)1);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14076 ""
+ if (*(unsigned char *)durq == ' ') {
#line 14077 ""
- }
+ --all_1.iccount;
#line 14078 ""
- } else if (*(unsigned char *)charq == '?') {
+ } else {
-/* Arpeggio */
+/* durq must be "-" */
#line 14082 ""
- if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
- 24 - 25],10)) {
+ ++all_1.iccount;
+#line 14083 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 14084 ""
+ --all_1.iccount;
-/* This is a chordal note. Set a bit in icrdat. But if *main* (spacing) note */
-/* of chord, will not set icrdat(25), but iornq(27) */
+/* record the shift */
-#line 14087 ""
- comtrill_1.icrdat[comtrill_1.ncrd - 1] = bit_set(
- comtrill_1.icrdat[comtrill_1.ncrd - 1],25);
#line 14088 ""
- } else {
+ ++comarpshift_1.numarpshift;
#line 14089 ""
- all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 1] =
- bit_set(all_1.iornq[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 1],27);
+ comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] =
+ commvl_1.ivx;
#line 14090 ""
- }
-
-/* Check for shift */
-
-#line 14094 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14095 ""
- if (*(unsigned char *)durq == ' ') {
-#line 14096 ""
- --all_1.iccount;
-#line 14097 ""
- } else {
+ comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] =
+ all_1.nnl[commvl_1.ivx - 1];
+#line 14091 ""
+ comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum;
+#line 14092 ""
+ }
+#line 14093 ""
+ } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) >
+ 0) {
-/* durq must be "-" */
+/* We have a figure. Must come AFTER the note it goes under */
+#line 14098 ""
+ ivf = 1;
+#line 14099 ""
+ if (commvl_1.ivx > 1) {
+#line 14100 ""
+ if (comfig_1.ivxfig2 == 0) {
#line 14101 ""
- ++all_1.iccount;
+ comfig_1.ivxfig2 = commvl_1.ivx;
#line 14102 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+ } else if (commvl_1.ivx != comfig_1.ivxfig2) {
#line 14103 ""
- --all_1.iccount;
-
-/* record the shift */
-
+ s_wsle(&io___816);
+#line 14103 ""
+ e_wsle();
+#line 14104 ""
+ s_wsle(&io___817);
+#line 14104 ""
+ do_lio(&c__9, &c__1, "Figures not allowed in >1 voice ab"\
+ "ove first", (ftnlen)43);
+#line 14104 ""
+ e_wsle();
+#line 14105 ""
+ s_stop("", (ftnlen)0);
+#line 14106 ""
+ }
#line 14107 ""
- ++comarpshift_1.numarpshift;
+ ivf = 2;
#line 14108 ""
- comarpshift_1.ivarpshift[comarpshift_1.numarpshift - 1] =
- commvl_1.ivx;
+ }
#line 14109 ""
- comarpshift_1.iparpshift[comarpshift_1.numarpshift - 1] =
- all_1.nnl[commvl_1.ivx - 1];
+ nfig1 = comfig_1.nfigs[ivf - 1] + 1;
#line 14110 ""
- comarpshift_1.arpshift[comarpshift_1.numarpshift - 1] = fnum;
-#line 14111 ""
- }
-#line 14112 ""
- } else if (i_indx("0123456789#-nx_", charq, (ftnlen)15, (ftnlen)1) > 0) {
+ getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, &
+ all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx
+ - 1] << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3],
+ &all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[
+ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25],
+ comfig_1.figq + (ivf + (nfig1 << 1) - 3) * 10, &
+ comfig_1.ivupfig[ivf + (nfig1 << 1) - 3], &
+ comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], &comfig_1.nfigs[
+ ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10);
+/* * ivupfig(ivf,nfig1),nfigs(ivf)) */
+#line 14115 ""
+ } else if (*(unsigned char *)charq == '[') {
-/* We have a figure. Must come AFTER the note it goes under */
+/* Start forced beam. Record barno & time since start of inp. blk. Set signal */
-#line 14117 ""
- ivf = 1;
-#line 14118 ""
- if (commvl_1.ivx > 1) {
#line 14119 ""
- if (comfig_1.ivxfig2 == 0) {
+ ++comfb_1.nfb[commvl_1.ivx - 1];
#line 14120 ""
- comfig_1.ivxfig2 = commvl_1.ivx;
+ comget_1.fbon = TRUE_;
#line 14121 ""
- } else if (commvl_1.ivx != comfig_1.ivxfig2) {
-#line 14122 ""
- s_wsle(&io___817);
+ *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
+ commvl_1.ivx - 1] * 24 - 25] = 'x';
#line 14122 ""
- e_wsle();
-#line 14123 ""
- s_wsle(&io___818);
-#line 14123 ""
- do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above "\
- "first", (ftnlen)43);
+ comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 -
+ 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
#line 14123 ""
- e_wsle();
+ nadj = 0;
#line 14124 ""
- s_stop("", (ftnlen)0);
+ if (comfb_1.autofbon) {
#line 14125 ""
- }
+ comfb_1.autofbon = FALSE_;
#line 14126 ""
- ivf = 2;
+ }
#line 14127 ""
- }
+L17:
+#line 14127 ""
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
#line 14128 ""
- nfig1 = comfig_1.nfigs[ivf - 1] + 1;
+ if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) {
#line 14129 ""
- getfig_(&comgrace_1.itoff[ivf + (nfig1 << 1) - 3], charq, lineq, &
- all_1.iccount, &all_1.isfig[ivf + (all_1.nnl[commvl_1.ivx - 1]
- << 1) - 3], &comfig_1.itfig[ivf + (nfig1 << 1) - 3], &
- all_1.itsofar[commvl_1.ivx - 1], &all_1.nodur[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 25], comfig_1.figq + (ivf
- + (nfig1 << 1) - 3) * 10, &comfig_1.ivupfig[ivf + (nfig1 << 1)
- - 3], &comfig_1.ivvfig[ivf + (nfig1 << 1) - 3], &
- comfig_1.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, (ftnlen)10);
-/* * ivupfig(ivf,nfig1),nfigs(ivf)) */
-#line 14134 ""
- } else if (*(unsigned char *)charq == '[') {
+ *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
+ commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)
+ charq;
+#line 14130 ""
+ goto L17;
+#line 14131 ""
+ } else if (*(unsigned char *)charq == 'j') {
-/* Start forced beam. Record barno & time since start of inp. blk. Set signal */
+/* Continuing a jumped beam here */
+
+#line 14135 ""
+ all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
+ 24 - 25] = bit_set(all_1.irest[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],24);
+
+/* Set flag to watch for END of this forced beam, so can set flag rest(30) on */
+/* NEXT note as signal to start a new notes group there. */
-#line 14138 ""
- ++comfb_1.nfb[commvl_1.ivx - 1];
-#line 14139 ""
- comget_1.fbon = TRUE_;
#line 14140 ""
- *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
- commvl_1.ivx - 1] * 24 - 25] = 'x';
+ combjmp_1.isbj2 = TRUE_;
#line 14141 ""
- comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 - 25] =
- (real) all_1.itsofar[commvl_1.ivx - 1];
+ goto L17;
#line 14142 ""
- nadj = 0;
+ } else if (*(unsigned char *)charq == 'h') {
#line 14143 ""
- if (comfb_1.autofbon) {
+ all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
+ 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],2);
#line 14144 ""
- comfb_1.autofbon = FALSE_;
+ goto L17;
#line 14145 ""
- }
-#line 14146 ""
-L17:
-#line 14146 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 14147 ""
- if (i_indx("ulf", charq, (ftnlen)3, (ftnlen)1) > 0) {
-#line 14148 ""
- *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.nfb[
- commvl_1.ivx - 1] * 24 - 25] = *(unsigned char *)charq;
+ } else if (*(unsigned char *)charq == 'm') {
+
+/* Force multiplicity. Next input is digit */
+
#line 14149 ""
- goto L17;
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1)
+ ;
#line 14150 ""
- } else if (*(unsigned char *)charq == 'j') {
+ all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
+ 24 - 25] = bit_set(all_1.islur[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21);
+#line 14151 ""
+ i__1 = *(unsigned char *)charq - 48;
+#line 14151 ""
+ setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
+ - 1] + 1) * 24 - 25], &c__3, &c__22, &i__1);
+#line 14152 ""
+ goto L17;
+#line 14153 ""
+ } else if (*(unsigned char *)charq == ':') {
-/* Continuing a jumped beam here */
+/* Start auto forced beam pattern */
-#line 14154 ""
- all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 25] = bit_set(all_1.irest[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 25],24);
+#line 14157 ""
+ comfb_1.autofbon = TRUE_;
-/* Set flag to watch for END of this forced beam, so can set flag rest(30) on */
-/* NEXT note as signal to start a new notes group there. */
+/* When forced later beam ends, check whether tautofv <=0; if so set it. */
-#line 14159 ""
- combjmp_1.isbj2 = TRUE_;
-#line 14160 ""
- goto L17;
#line 14161 ""
- } else if (*(unsigned char *)charq == 'h') {
+ comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]);
#line 14162 ""
- all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 25],2);
+ comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1];
#line 14163 ""
- goto L17;
+ goto L17;
#line 14164 ""
- } else if (*(unsigned char *)charq == 'm') {
+ } else if (*(unsigned char *)charq != ' ') {
-/* Force multiplicity. Next input is digit */
+/* Must be '+/-' for height or slope shift */
#line 14168 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 14169 ""
- all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 25] = bit_set(all_1.islur[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 25],21);
-#line 14170 ""
- i__1 = *(unsigned char *)charq - 48;
-#line 14170 ""
- setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
- + 1) * 24 - 25], &c__3, &c__22, &i__1);
-#line 14171 ""
- goto L17;
-#line 14172 ""
- } else if (*(unsigned char *)charq == ':') {
+ ++nadj;
-/* Start auto forced beam pattern */
+/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */
+#line 14172 ""
+ ++all_1.iccount;
+#line 14173 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 14174 ""
+ --all_1.iccount;
+#line 14175 ""
+ iadj = i_nint(&fnum);
+#line 14176 ""
+ if (*(unsigned char *)charq == '-') {
#line 14176 ""
- comfb_1.autofbon = TRUE_;
+ iadj = -iadj;
+#line 14176 ""
+ }
+#line 14177 ""
+ if (nadj == 1) {
-/* When forced later beam ends, check whether tautofv <=0; if so set it. */
+/* This is a level shift. Note if 0 was entered, iadj = 30 */
-#line 14180 ""
- comfb_1.tautofb = (real) (-all_1.itsofar[commvl_1.ivx - 1]);
#line 14181 ""
- comfb_1.t1autofb = (real) all_1.itsofar[commvl_1.ivx - 1];
+ i__1 = iadj + 30;
+#line 14181 ""
+ setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__11,
+ &i__1);
#line 14182 ""
- goto L17;
-#line 14183 ""
- } else if (*(unsigned char *)charq != ' ') {
+ } else if (nadj == 2) {
-/* Must be '+/-' for height or slope shift */
+/* Must be a slope shift */
+#line 14186 ""
+ i__1 = iadj + 30;
+#line 14186 ""
+ setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] + 1) * 24 - 25], &c__6, &c__17,
+ &i__1);
#line 14187 ""
- ++nadj;
+ } else {
-/* nadj = 1,2, or 3 for normal start level, slope, or beam-thk start level. */
+/* Beam-thk fine tune */
#line 14191 ""
- ++all_1.iccount;
+ setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] + 1) * 24 - 25], &c__2, &c__27,
+ &iadj);
#line 14192 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+ }
#line 14193 ""
- --all_1.iccount;
+ goto L17;
#line 14194 ""
- iadj = i_nint(&fnum);
-#line 14195 ""
- if (*(unsigned char *)charq == '-') {
-#line 14195 ""
- iadj = -iadj;
-#line 14195 ""
}
+#line 14195 ""
+ } else if (*(unsigned char *)charq == ']') {
#line 14196 ""
- if (nadj == 1) {
-
-/* This is a level shift. Note if 0 was entered, iadj = 30 */
-
-#line 14200 ""
- i__1 = iadj + 30;
+ if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) {
+#line 14197 ""
+ comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] +
+ comfb_1.tautofb;
+#line 14198 ""
+ }
+#line 14199 ""
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
#line 14200 ""
- setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
- 1] + 1) * 24 - 25], &c__6, &c__11, &i__1);
-#line 14201 ""
- } else if (nadj == 2) {
+ if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) {
-/* Must be a slope shift */
+/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */
+#line 14204 ""
+ comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] *
+ 24 - 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
#line 14205 ""
- i__1 = iadj + 30;
-#line 14205 ""
- setbits_(&all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
- 1] + 1) * 24 - 25], &c__6, &c__17, &i__1);
+ comget_1.fbon = FALSE_;
#line 14206 ""
- } else {
+ if (*(unsigned char *)charq == 'j') {
+#line 14207 ""
+ all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
+ 24 - 25] = bit_set(all_1.irest[commvl_1.ivx +
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],23);
+#line 14208 ""
+ }
+#line 14209 ""
+ if (combjmp_1.isbj2) {
-/* Beam-thk fine tune */
+/* This is the end of a fb segment of a jump beam. Set flag on NEXT note to */
+/* force start of new notes group, provided this is not last note in bar. */
-#line 14210 ""
- setbits_(&all_1.islur[commvl_1.ivx + (all_1.nnl[commvl_1.ivx
- - 1] + 1) * 24 - 25], &c__2, &c__27, &iadj);
-#line 14211 ""
- }
-#line 14212 ""
- goto L17;
-#line 14213 ""
- }
#line 14214 ""
- } else if (*(unsigned char *)charq == ']') {
-#line 14215 ""
- if (comfb_1.autofbon && comfb_1.tautofb < comtol_1.tol) {
+ if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) {
+#line 14214 ""
+ all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
+ 1] + 1) * 24 - 25] = bit_set(all_1.irest[
+ commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] +
+ 1) * 24 - 25],30);
+#line 14214 ""
+ }
#line 14216 ""
- comfb_1.tautofb = all_1.itsofar[commvl_1.ivx - 1] +
- comfb_1.tautofb;
+ combjmp_1.isbj2 = FALSE_;
#line 14217 ""
- }
+ }
#line 14218 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 14219 ""
- if (i_indx("j ", charq, (ftnlen)2, (ftnlen)1) > 0) {
+ } else if (*(unsigned char *)charq == '[') {
-/* Since ']' comes AFTER note, itsofar has been updated. Set ending signal. */
+/* Multiplicity down-up signal */
+#line 14222 ""
+ all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 25] = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25],20);
#line 14223 ""
- comfb_1.t2fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1] * 24 -
- 25] = (real) all_1.itsofar[commvl_1.ivx - 1];
-#line 14224 ""
- comget_1.fbon = FALSE_;
-#line 14225 ""
- if (*(unsigned char *)charq == 'j') {
-#line 14226 ""
- all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
- 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 25],23);
+ } else if (*(unsigned char *)charq == '-') {
+
+/* Set signals for gap in single-slope beam [...]-[...] */
+
#line 14227 ""
- }
+ all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 25] = bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25],20);
#line 14228 ""
- if (combjmp_1.isbj2) {
+ all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
+ 24 - 25] = bit_set(all_1.nacc[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],21);
-/* This is the end of a fb segment of a jump beam. Set flag on NEXT note to */
-/* force start of new notes group, provided this is not last note in bar. */
+/* Next two characters must be "[ ". Skip over them. */
+#line 14232 ""
+ all_1.iccount += 2;
#line 14233 ""
- if (all_1.itsofar[commvl_1.ivx - 1] % all_1.lenbar != 0) {
-#line 14233 ""
- all_1.irest[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] +
- 1) * 24 - 25] = bit_set(all_1.irest[commvl_1.ivx
- + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],30)
- ;
-#line 14233 ""
- }
-#line 14235 ""
- combjmp_1.isbj2 = FALSE_;
-#line 14236 ""
}
+#line 14234 ""
+ } else if (*(unsigned char *)charq == 'D') {
+#line 14235 ""
+ getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[
+ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &
+ all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
+ 24 - 1], lineq, &all_1.iccount, (ftnlen)128);
#line 14237 ""
- } else if (*(unsigned char *)charq == '[') {
+ } else if (*(unsigned char *)charq == 'h') {
-/* Multiplicity down-up signal */
+/* Heading or height. For heading, only OK if at start of block */
+/* Check whether at beginning of a block */
-#line 14241 ""
- all_1.islur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
- = bit_set(all_1.islur[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 25],20);
#line 14242 ""
- } else if (*(unsigned char *)charq == '-') {
-
-/* Set signals for gap in single-slope beam [...]-[...] */
-
+ if (all_1.iv != 1 || all_1.nnl[0] != 0) {
+#line 14243 ""
+ s_wsle(&io___819);
+#line 14243 ""
+ do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of "\
+ "block", (ftnlen)41);
+#line 14243 ""
+ e_wsle();
+#line 14244 ""
+ stop1_();
+#line 14245 ""
+ }
#line 14246 ""
- all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25] =
- bit_set(all_1.nacc[commvl_1.ivx + all_1.nnl[commvl_1.ivx
- - 1] * 24 - 25],20);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14247 ""
- all_1.nacc[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 25] = bit_set(all_1.nacc[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 25],21);
+ comhead_1.ihdvrt = 0;
+#line 14248 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-/* Next two characters must be "[ ". Skip over them. */
+/* Vertical offset */
-#line 14251 ""
- all_1.iccount += 2;
#line 14252 ""
- }
+ ++all_1.iccount;
#line 14253 ""
- } else if (*(unsigned char *)charq == 'D') {
+ readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
+ ftnlen)1);
#line 14254 ""
- getdyn_(&commvl_1.ivx, &all_1.nnl[commvl_1.ivx - 1], &all_1.irest[
- commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25], &
- all_1.iornq[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
- 1], lineq, &all_1.iccount, (ftnlen)128);
+ comhead_1.ihdvrt = fnum + .1f;
+#line 14255 ""
+ if (*(unsigned char *)durq == '-') {
+#line 14255 ""
+ comhead_1.ihdvrt = -comhead_1.ihdvrt;
+#line 14255 ""
+ }
#line 14256 ""
- } else if (*(unsigned char *)charq == 'h') {
+ *(unsigned char *)durq = *(unsigned char *)charq;
+#line 14257 ""
+ }
+#line 14258 ""
+ if (*(unsigned char *)durq != ' ') {
-/* Heading or height. For heading, only OK if at start of block */
-/* Check whether at beginning of a block */
+/* Height symbol. Read past (until next blank) */
-#line 14261 ""
- if (all_1.iv != 1 || all_1.nnl[0] != 0) {
-#line 14262 ""
- s_wsle(&io___820);
#line 14262 ""
- do_lio(&c__9, &c__1, "You entered \"h\" not at beginning of block"
- , (ftnlen)41);
+L3:
#line 14262 ""
- e_wsle();
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14263 ""
- stop1_();
+ if (*(unsigned char *)durq != ' ') {
+#line 14263 ""
+ goto L3;
+#line 14263 ""
+ }
#line 14264 ""
- }
-#line 14265 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14266 ""
- comhead_1.ihdvrt = 0;
-#line 14267 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+ } else {
-/* Vertical offset */
+/* Set flag for header & read it in */
+#line 14268 ""
+ comhead_1.ihdht = 16;
+#line 14269 ""
+ getbuf_(comhead_1.headrq, (ftnlen)80);
+#line 14270 ""
+ all_1.iccount = 128;
#line 14271 ""
- ++all_1.iccount;
-#line 14272 ""
- readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 14273 ""
- comhead_1.ihdvrt = fnum + .1f;
-#line 14274 ""
- if (*(unsigned char *)durq == '-') {
-#line 14274 ""
- comhead_1.ihdvrt = -comhead_1.ihdvrt;
-#line 14274 ""
}
-#line 14275 ""
- *(unsigned char *)durq = *(unsigned char *)charq;
-#line 14276 ""
- }
+#line 14272 ""
+ } else if (*(unsigned char *)charq == 'L') {
+
+/* Linebreak, already handled some in pmxa, but need to get data for */
+/* shortened line or coda lengths */
+
#line 14277 ""
- if (*(unsigned char *)durq != ' ') {
+ ++all_1.iccount;
+#line 14278 ""
+ if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'C') {
-/* Height symbol. Read past (until next blank) */
+/* Coda, get length */
-#line 14281 ""
-L3:
-#line 14281 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14282 ""
- if (*(unsigned char *)durq != ' ') {
#line 14282 ""
- goto L3;
-#line 14282 ""
- }
+ ++all_1.iccount;
#line 14283 ""
- } else {
+ readnum_(lineq, &all_1.iccount, durq, &comshort_1.codafrac, (
+ ftnlen)128, (ftnlen)1);
+#line 14284 ""
+ comshort_1.ishort = 3;
+#line 14285 ""
+ if (*(unsigned char *)durq == 'n') {
+#line 14285 ""
+ comshort_1.nocodabn = TRUE_;
+#line 14285 ""
+ }
+#line 14286 ""
+ return 0;
+#line 14287 ""
+ }
-/* Set flag for header & read it in */
+/* Get line number */
-#line 14287 ""
- comhead_1.ihdht = 16;
-#line 14288 ""
- getbuf_(comhead_1.headrq, (ftnlen)80);
-#line 14289 ""
- all_1.iccount = 128;
-#line 14290 ""
- }
#line 14291 ""
- } else if (*(unsigned char *)charq == 'L') {
+ readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (
+ ftnlen)1);
+#line 14292 ""
+L48:
+/* Allow transfer up from below if S follows M */
+#line 14293 ""
+ if (*(unsigned char *)durq == 'S') {
-/* Linebreak, already handled some in pmxa, but need to get data for */
-/* shortened line or coda lengths */
+/* Shortened line, get shortening fraction */
-#line 14296 ""
- ++all_1.iccount;
#line 14297 ""
- if (*(unsigned char *)&lineq[all_1.iccount - 1] == 'C') {
-
-/* Coda, get length */
-
+ ++all_1.iccount;
+#line 14298 ""
+ readnum_(lineq, &all_1.iccount, durq, &comshort_1.shortfrac, (
+ ftnlen)128, (ftnlen)1);
+#line 14299 ""
+ comshort_1.ishort = 1;
+#line 14300 ""
+ comshort_1.codafrac = 0.f;
#line 14301 ""
- ++all_1.iccount;
-#line 14302 ""
- readnum_(lineq, &all_1.iccount, durq, &comshort_1.codafrac, (
- ftnlen)128, (ftnlen)1);
-#line 14303 ""
- comshort_1.ishort = 3;
-#line 14304 ""
- if (*(unsigned char *)durq == 'n') {
-#line 14304 ""
- comshort_1.nocodabn = TRUE_;
-#line 14304 ""
}
-#line 14305 ""
- return 0;
-#line 14306 ""
- }
-/* Get line number */
+/* Begin check for movement break */
+#line 14305 ""
+ if (*(unsigned char *)durq == 'P') {
+#line 14306 ""
+ ++all_1.iccount;
+#line 14307 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 14308 ""
+ }
+#line 14309 ""
+ if (*(unsigned char *)durq == 'M') {
#line 14310 ""
- readnum_(lineq, &all_1.iccount, durq, &fmovbrk, (ftnlen)128, (ftnlen)
- 1);
+ comget_1.movbrk = i_nint(&fmovbrk);
#line 14311 ""
-L48:
-/* Allow transfer up from below if S follows M */
+ comget_1.movgap = 0;
#line 14312 ""
- if (*(unsigned char *)durq == 'S') {
+ comget_1.parmov = -1.f;
+#line 14313 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14314 ""
+L31:
+#line 14314 ""
+ if (*(unsigned char *)durq == '+') {
-/* Shortened line, get shortening fraction */
+/* Get vertical space (\internotes) */
-#line 14316 ""
- ++all_1.iccount;
-#line 14317 ""
- readnum_(lineq, &all_1.iccount, durq, &comshort_1.shortfrac, (
- ftnlen)128, (ftnlen)1);
#line 14318 ""
- comshort_1.ishort = 1;
+ ++all_1.iccount;
#line 14319 ""
- comshort_1.codafrac = 0.f;
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 14320 ""
- }
-
-/* Begin check for movement break */
-
+ comget_1.movgap = i_nint(&fnum);
+#line 14321 ""
+ goto L31;
+#line 14322 ""
+ } else if (*(unsigned char *)durq == 'i') {
+#line 14323 ""
+ ++all_1.iccount;
#line 14324 ""
- if (*(unsigned char *)durq == 'P') {
+ readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, (
+ ftnlen)128, (ftnlen)1);
#line 14325 ""
- ++all_1.iccount;
+ goto L31;
#line 14326 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+ } else if (*(unsigned char *)durq == 'c') {
#line 14327 ""
- }
+ comnotes_1.nobar1 = TRUE_;
#line 14328 ""
- if (*(unsigned char *)durq == 'M') {
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14329 ""
- comget_1.movbrk = i_nint(&fmovbrk);
+ goto L31;
#line 14330 ""
- comget_1.movgap = 0;
-#line 14331 ""
- comget_1.parmov = -1.f;
-#line 14332 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14333 ""
-L31:
-#line 14333 ""
- if (*(unsigned char *)durq == '+') {
+ } else if (*(unsigned char *)durq == 'r') {
-/* Get vertical space (\internotes) */
+/* "rename" can be set on or off. */
+#line 14334 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 14335 ""
+ comnvi_1.rename = *(unsigned char *)durq == '+';
+#line 14336 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14337 ""
- ++all_1.iccount;
+ goto L31;
#line 14338 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 14339 ""
- comget_1.movgap = i_nint(&fnum);
-#line 14340 ""
- goto L31;
-#line 14341 ""
- } else if (*(unsigned char *)durq == 'i') {
-#line 14342 ""
- ++all_1.iccount;
+ } else if (*(unsigned char *)durq == 'n') {
+
+/* Change # of voices. Input ninow, iiorig(1...ninow). Will use names, */
+/* staves per inst. and clefs corr. to iiorig in original list of instruments. */
+
#line 14343 ""
- readnum_(lineq, &all_1.iccount, durq, &comget_1.parmov, (
- ftnlen)128, (ftnlen)1);
+ nvold = all_1.nv;
#line 14344 ""
- goto L31;
+ all_1.nv = 0;
#line 14345 ""
- } else if (*(unsigned char *)durq == 'c') {
+ comnvi_1.rename = TRUE_;
#line 14346 ""
- comnotes_1.nobar1 = TRUE_;
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14347 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (*(unsigned char *)durq == ':') {
#line 14348 ""
- goto L31;
+ all_1.iccount += 2;
#line 14349 ""
- } else if (*(unsigned char *)durq == 'r') {
-
-/* "rename" can be set on or off. */
-
+ i__1 = all_1.iccount - 2;
+#line 14349 ""
+ ici__1.icierr = 0;
+#line 14349 ""
+ ici__1.iciend = 0;
+#line 14349 ""
+ ici__1.icirnum = 1;
+#line 14349 ""
+ ici__1.icirlen = all_1.iccount - i__1;
+#line 14349 ""
+ ici__1.iciunit = lineq + i__1;
+#line 14349 ""
+ ici__1.icifmt = "(i2)";
+#line 14349 ""
+ s_rsfi(&ici__1);
+#line 14349 ""
+ do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
+ sizeof(integer));
+#line 14349 ""
+ e_rsfi();
+#line 14350 ""
+ } else {
+#line 14351 ""
+ comnotes_1.ninow = *(unsigned char *)durq - 48;
+#line 14352 ""
+ }
#line 14353 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ iiv = 0;
#line 14354 ""
- comnvi_1.rename = *(unsigned char *)durq == '+';
+ i__1 = comnotes_1.ninow;
+#line 14354 ""
+ for (iinow = 1; iinow <= i__1; ++iinow) {
#line 14355 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14356 ""
- goto L31;
+ if (*(unsigned char *)durq == ':') {
#line 14357 ""
- } else if (*(unsigned char *)durq == 'n') {
-
-/* Change # of voices. Input ninow, iiorig(1...ninow). Will use names, */
-/* staves per inst. and clefs corr. to iiorig in original list of instruments. */
-
+ all_1.iccount += 2;
+#line 14358 ""
+ i__2 = all_1.iccount - 2;
+#line 14358 ""
+ ici__1.icierr = 0;
+#line 14358 ""
+ ici__1.iciend = 0;
+#line 14358 ""
+ ici__1.icirnum = 1;
+#line 14358 ""
+ ici__1.icirlen = all_1.iccount - i__2;
+#line 14358 ""
+ ici__1.iciunit = lineq + i__2;
+#line 14358 ""
+ ici__1.icifmt = "(i2)";
+#line 14358 ""
+ s_rsfi(&ici__1);
+#line 14358 ""
+ do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1],
+ (ftnlen)sizeof(integer));
+#line 14358 ""
+ e_rsfi();
+#line 14359 ""
+ } else {
+#line 14360 ""
+ comnvi_1.iiorig[iinow - 1] = *(unsigned char *)
+ durq - 48;
+#line 14361 ""
+ }
#line 14362 ""
- nvold = all_1.nv;
+ comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[
+ comnvi_1.iiorig[iinow - 1] - 1];
#line 14363 ""
- all_1.nv = 0;
+ all_1.nv += comnvi_1.nspern[iinow - 1];
#line 14364 ""
- comnvi_1.rename = TRUE_;
+ *(unsigned char *)&all_1.sepsymq[iiv +
+ comnvi_1.nspern[iinow - 1] - 1] = '&';
#line 14365 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (comnvi_1.nspern[iinow - 1] > 1) {
#line 14366 ""
- if (*(unsigned char *)durq == ':') {
+ i__2 = comnvi_1.nspern[iinow - 1] - 1;
+#line 14366 ""
+ for (iis = 1; iis <= i__2; ++iis) {
#line 14367 ""
- all_1.iccount += 2;
-#line 14368 ""
- i__1 = all_1.iccount - 2;
-#line 14368 ""
- ici__1.icierr = 0;
-#line 14368 ""
- ici__1.iciend = 0;
-#line 14368 ""
- ici__1.icirnum = 1;
-#line 14368 ""
- ici__1.icirlen = all_1.iccount - i__1;
+ *(unsigned char *)&all_1.sepsymq[iiv + iis -
+ 1] = '|';
#line 14368 ""
- ici__1.iciunit = lineq + i__1;
-#line 14368 ""
- ici__1.icifmt = "(i2)";
-#line 14368 ""
- s_rsfi(&ici__1);
-#line 14368 ""
- do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)sizeof(
- integer));
+/* L64: */
#line 14368 ""
- e_rsfi();
+ }
#line 14369 ""
- } else {
+ }
#line 14370 ""
- comnotes_1.ninow = *(unsigned char *)durq - 48;
+ iiv += comnvi_1.nspern[iinow - 1];
+#line 14371 ""
+/* L63: */
#line 14371 ""
- }
-#line 14372 ""
- iiv = 0;
-#line 14373 ""
- i__1 = comnotes_1.ninow;
-#line 14373 ""
- for (iinow = 1; iinow <= i__1; ++iinow) {
-#line 14374 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
- ftnlen)1);
-#line 14375 ""
- if (*(unsigned char *)durq == ':') {
-#line 14376 ""
- all_1.iccount += 2;
-#line 14377 ""
- i__2 = all_1.iccount - 2;
-#line 14377 ""
- ici__1.icierr = 0;
-#line 14377 ""
- ici__1.iciend = 0;
-#line 14377 ""
- ici__1.icirnum = 1;
-#line 14377 ""
- ici__1.icirlen = all_1.iccount - i__2;
-#line 14377 ""
- ici__1.iciunit = lineq + i__2;
-#line 14377 ""
- ici__1.icifmt = "(i2)";
-#line 14377 ""
- s_rsfi(&ici__1);
-#line 14377 ""
- do_fio(&c__1, (char *)&comnvi_1.iiorig[iinow - 1], (
- ftnlen)sizeof(integer));
-#line 14377 ""
- e_rsfi();
-#line 14378 ""
- } else {
-#line 14379 ""
- comnvi_1.iiorig[iinow - 1] = *(unsigned char *)durq -
- 48;
-#line 14380 ""
}
-#line 14381 ""
- comnvi_1.nspern[iinow - 1] = comnvi_1.nsperi[
- comnvi_1.iiorig[iinow - 1] - 1];
+
+/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */
+
+/* if (islast) then */
+/* if (ninow .lt. 10) then */
+/* write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */
+/* else */
+/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */
+/* end if */
+/* end if */
#line 14382 ""
- all_1.nv += comnvi_1.nspern[iinow - 1];
+ if (all_1.nv == 1 && nvold > 1) {
+#line 14383 ""
+ if (comlast_1.islast) {
+#line 14383 ""
+ s_wsfe(&io___824);
+/* Writing concatenation */
+#line 14383 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
#line 14383 ""
- *(unsigned char *)&all_1.sepsymq[iiv + comnvi_1.nspern[
- iinow - 1] - 1] = '&';
+ i__5[1] = 11, a__2[1] = "nostartrule";
+#line 14383 ""
+ s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
+#line 14383 ""
+ do_fio(&c__1, ch__2, (ftnlen)12);
+#line 14383 ""
+ e_wsfe();
+#line 14383 ""
+ }
#line 14384 ""
- if (comnvi_1.nspern[iinow - 1] > 1) {
+ } else if (all_1.nv > 1 && nvold == 1) {
#line 14385 ""
- i__2 = comnvi_1.nspern[iinow - 1] - 1;
+ if (comlast_1.islast) {
#line 14385 ""
- for (iis = 1; iis <= i__2; ++iis) {
+ s_wsfe(&io___825);
+/* Writing concatenation */
+#line 14385 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14385 ""
+ i__5[1] = 9, a__2[1] = "startrule";
+#line 14385 ""
+ s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14385 ""
+ do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14385 ""
+ e_wsfe();
+#line 14385 ""
+ }
#line 14386 ""
- *(unsigned char *)&all_1.sepsymq[iiv + iis - 1] =
- '|';
-#line 14387 ""
-/* L64: */
+ }
#line 14387 ""
- }
+ iiv = 0;
#line 14388 ""
- }
+ i__1 = comnotes_1.ninow;
+#line 14388 ""
+ for (iinow = 1; iinow <= i__1; ++iinow) {
#line 14389 ""
- iiv += comnvi_1.nspern[iinow - 1];
-#line 14390 ""
-/* L63: */
+ i__2 = comnvi_1.nspern[iinow - 1];
+#line 14389 ""
+ for (iis = 1; iis <= i__2; ++iis) {
#line 14390 ""
- }
+ ++iiv;
-/* 120818 Per Rainer's suggestion, defer changing \nbinstruments until issuing \newmovement */
+/* May not really need to re-enter clefs, but it's easier to program since */
+/* clef names are not saved but are needed in newvoice to set ncmidcc. */
-/* if (islast) then */
-/* if (ninow .lt. 10) then */
-/* write(11,'(a)')sq//'newnoi{'//chax(ninow+48)//'}%' */
-/* else */
-/* write(11,'(a8,i2,a2)')sq//'newnoi{',ninow,'}%' */
-/* end if */
-/* end if */
-#line 14401 ""
- if (all_1.nv == 1 && nvold > 1) {
-#line 14402 ""
- if (comlast_1.islast) {
-#line 14402 ""
- s_wsfe(&io___825);
+#line 14395 ""
+ getchar_(lineq, &all_1.iccount, comclefq_1.clefq
+ + (iiv - 1), (ftnlen)128, (ftnlen)1);
+#line 14396 ""
+ newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &
+ c_true, (ftnlen)1);
+#line 14397 ""
+ if (comnvi_1.nspern[iinow - 1] == 1) {
+#line 14398 ""
+ i__4 = numclef_(comclefq_1.clefq + (iiv - 1),
+ (ftnlen)1) + 48;
+#line 14398 ""
+ chax_(ch__1, (ftnlen)1, &i__4);
+#line 14398 ""
+ s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1);
+#line 14399 ""
+ lclf = 1;
+#line 14400 ""
+ } else if (iis == 1) {
/* Writing concatenation */
+#line 14401 ""
+ i__5[0] = 1, a__2[0] = "{";
+#line 14401 ""
+ i__4 = numclef_(comclefq_1.clefq + (iiv - 1),
+ (ftnlen)1) + 48;
+#line 14401 ""
+ chax_(ch__1, (ftnlen)1, &i__4);
+#line 14401 ""
+ i__5[1] = 1, a__2[1] = ch__1;
+#line 14401 ""
+ s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
#line 14402 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14402 ""
- i__5[1] = 11, a__2[1] = "nostartrule";
-#line 14402 ""
- s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
-#line 14402 ""
- do_fio(&c__1, ch__2, (ftnlen)12);
-#line 14402 ""
- e_wsfe();
-#line 14402 ""
- }
+ lclf = 2;
#line 14403 ""
- } else if (all_1.nv > 1 && nvold == 1) {
-#line 14404 ""
- if (comlast_1.islast) {
-#line 14404 ""
- s_wsfe(&io___826);
+ } else if (iis < comnvi_1.nspern[iinow - 1]) {
/* Writing concatenation */
#line 14404 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
+ i__5[0] = lclf, a__2[0] = hdlndq;
#line 14404 ""
- i__5[1] = 9, a__2[1] = "startrule";
+ i__4 = numclef_(comclefq_1.clefq + (iiv - 1),
+ (ftnlen)1) + 48;
#line 14404 ""
- s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+ chax_(ch__1, (ftnlen)1, &i__4);
#line 14404 ""
- do_fio(&c__1, ch__3, (ftnlen)10);
+ i__5[1] = 1, a__2[1] = ch__1;
#line 14404 ""
- e_wsfe();
-#line 14404 ""
- }
+ s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
#line 14405 ""
- }
+ ++lclf;
#line 14406 ""
- iiv = 0;
+ } else {
+/* Writing concatenation */
+#line 14407 ""
+ i__6[0] = lclf, a__3[0] = hdlndq;
#line 14407 ""
- i__1 = comnotes_1.ninow;
+ i__4 = numclef_(comclefq_1.clefq + (iiv - 1),
+ (ftnlen)1) + 48;
#line 14407 ""
- for (iinow = 1; iinow <= i__1; ++iinow) {
-#line 14408 ""
- i__2 = comnvi_1.nspern[iinow - 1];
-#line 14408 ""
- for (iis = 1; iis <= i__2; ++iis) {
+ chax_(ch__1, (ftnlen)1, &i__4);
+#line 14407 ""
+ i__6[1] = 1, a__3[1] = ch__1;
+#line 14407 ""
+ i__6[2] = 1, a__3[2] = "}";
+#line 14407 ""
+ s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
#line 14409 ""
- ++iiv;
+ lclf += 2;
+#line 14410 ""
+ }
+#line 14411 ""
+/* L61: */
+#line 14411 ""
+ }
-/* May not really need to re-enter clefs, but it's easier to program since */
-/* clef names are not saved but are needed in newvoice to set ncmidcc. */
+/* setstaffs & setclef go by instrument, not voice */
-#line 14414 ""
- getchar_(lineq, &all_1.iccount, comclefq_1.clefq + (
- iiv - 1), (ftnlen)128, (ftnlen)1);
#line 14415 ""
- newvoice_(&iiv, comclefq_1.clefq + (iiv - 1), &c_true,
- (ftnlen)1);
+ if (comlast_1.islast) {
#line 14416 ""
- if (comnvi_1.nspern[iinow - 1] == 1) {
+ if (iinow < 10) {
#line 14417 ""
- i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
- ftnlen)1) + 48;
+ s_wsfe(&io___828);
+/* Writing concatenation */
#line 14417 ""
- chax_(ch__1, (ftnlen)1, &i__4);
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14417 ""
+ i__3[1] = 9, a__1[1] = "setstaffs";
+#line 14417 ""
+ i__2 = iinow + 48;
+#line 14417 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 14417 ""
+ i__3[2] = 1, a__1[2] = ch__1;
#line 14417 ""
- s_copy(hdlndq, ch__1, (ftnlen)59, (ftnlen)1);
-#line 14418 ""
- lclf = 1;
+ i__4 = comnvi_1.nspern[iinow - 1] + 48;
+#line 14417 ""
+ chax_(ch__5, (ftnlen)1, &i__4);
+#line 14417 ""
+ i__3[3] = 1, a__1[3] = ch__5;
+#line 14417 ""
+ i__3[4] = 1, a__1[4] = "%";
+#line 14417 ""
+ s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13);
+#line 14417 ""
+ do_fio(&c__1, ch__4, (ftnlen)13);
+#line 14417 ""
+ e_wsfe();
#line 14419 ""
- } else if (iis == 1) {
-/* Writing concatenation */
-#line 14420 ""
- i__5[0] = 1, a__2[0] = "{";
-#line 14420 ""
- i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
- ftnlen)1) + 48;
-#line 14420 ""
- chax_(ch__1, (ftnlen)1, &i__4);
-#line 14420 ""
- i__5[1] = 1, a__2[1] = ch__1;
-#line 14420 ""
- s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
+ s_wsfe(&io___829);
+/* Writing concatenation */
+#line 14419 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14419 ""
+ i__3[1] = 7, a__1[1] = "setclef";
+#line 14419 ""
+ i__2 = iinow + 48;
+#line 14419 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 14419 ""
+ i__3[2] = 1, a__1[2] = ch__1;
+#line 14419 ""
+ i__3[3] = lclf, a__1[3] = hdlndq;
+#line 14419 ""
+ i__3[4] = 1, a__1[4] = "%";
+#line 14419 ""
+ s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69);
+#line 14419 ""
+ do_fio(&c__1, ch__6, lclf + 10);
+#line 14419 ""
+ e_wsfe();
#line 14421 ""
- lclf = 2;
+ if (comfig_1.fullsize[comnvi_1.iiorig[iinow -
+ 1] - 1] > .9f) {
#line 14422 ""
- } else if (iis < comnvi_1.nspern[iinow - 1]) {
-/* Writing concatenation */
-#line 14423 ""
- i__5[0] = lclf, a__2[0] = hdlndq;
-#line 14423 ""
- i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
- ftnlen)1) + 48;
-#line 14423 ""
- chax_(ch__1, (ftnlen)1, &i__4);
-#line 14423 ""
- i__5[1] = 1, a__2[1] = ch__1;
-#line 14423 ""
- s_cat(hdlndq, a__2, i__5, &c__2, (ftnlen)59);
-#line 14424 ""
- ++lclf;
-#line 14425 ""
- } else {
+ s_wsfe(&io___830);
/* Writing concatenation */
-#line 14426 ""
- i__6[0] = lclf, a__3[0] = hdlndq;
-#line 14426 ""
- i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (
- ftnlen)1) + 48;
-#line 14426 ""
- chax_(ch__1, (ftnlen)1, &i__4);
-#line 14426 ""
- i__6[1] = 1, a__3[1] = ch__1;
-#line 14426 ""
- i__6[2] = 1, a__3[2] = "}";
-#line 14426 ""
- s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
-#line 14428 ""
- lclf += 2;
-#line 14429 ""
- }
-#line 14430 ""
-/* L61: */
-#line 14430 ""
- }
+#line 14422 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14422 ""
+ i__3[1] = 7, a__1[1] = "setsize";
+#line 14422 ""
+ i__2 = iinow + 48;
+#line 14422 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 14422 ""
+ i__3[2] = 1, a__1[2] = ch__1;
+#line 14422 ""
+ i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14422 ""
+ i__3[4] = 12, a__1[4] = "normalvalue%";
+#line 14422 ""
+ s_cat(ch__7, a__1, i__3, &c__5, (ftnlen)
+ 22);
+#line 14422 ""
+ do_fio(&c__1, ch__7, (ftnlen)22);
+#line 14422 ""
+ e_wsfe();
-/* setstaffs & setclef go by instrument, not voice */
+/* 140526 Account for staff size specs when noinst changes. May be confusion */
+/* here if more than one staff per instrument */
+#line 14428 ""
+ } else if (comfig_1.fullsize[comnvi_1.iiorig[
+ iinow - 1] - 1] > .7f) {
+#line 14429 ""
+ s_wsfe(&io___831);
+/* Writing concatenation */
+#line 14429 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14429 ""
+ i__3[1] = 7, a__1[1] = "setsize";
+#line 14429 ""
+ i__2 = iinow + 48;
+#line 14429 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 14429 ""
+ i__3[2] = 1, a__1[2] = ch__1;
+#line 14429 ""
+ i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14429 ""
+ i__3[4] = 11, a__1[4] = "smallvalue%";
+#line 14429 ""
+ s_cat(ch__8, a__1, i__3, &c__5, (ftnlen)
+ 21);
+#line 14429 ""
+ do_fio(&c__1, ch__8, (ftnlen)21);
+#line 14429 ""
+ e_wsfe();
+#line 14431 ""
+ } else {
+#line 14432 ""
+ s_wsfe(&io___832);
+/* Writing concatenation */
+#line 14432 ""
+ i__3[0] = 1, a__1[0] = all_1.sq;
+#line 14432 ""
+ i__3[1] = 7, a__1[1] = "setsize";
+#line 14432 ""
+ i__2 = iinow + 48;
+#line 14432 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 14432 ""
+ i__3[2] = 1, a__1[2] = ch__1;
+#line 14432 ""
+ i__3[3] = 1, a__1[3] = all_1.sq;
+#line 14432 ""
+ i__3[4] = 10, a__1[4] = "tinyvalue%";
+#line 14432 ""
+ s_cat(ch__9, a__1, i__3, &c__5, (ftnlen)
+ 20);
+#line 14432 ""
+ do_fio(&c__1, ch__9, (ftnlen)20);
+#line 14432 ""
+ e_wsfe();
#line 14434 ""
- if (comlast_1.islast) {
+ }
#line 14435 ""
- if (iinow < 10) {
+ } else {
#line 14436 ""
- s_wsfe(&io___829);
+ s_wsfe(&io___833);
/* Writing concatenation */
#line 14436 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
+ i__5[0] = 1, a__2[0] = all_1.sq;
#line 14436 ""
- i__3[1] = 9, a__1[1] = "setstaffs";
+ i__5[1] = 10, a__2[1] = "setstaffs{";
#line 14436 ""
- i__2 = iinow + 48;
+ s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
#line 14436 ""
- chax_(ch__1, (ftnlen)1, &i__2);
+ do_fio(&c__1, ch__10, (ftnlen)11);
#line 14436 ""
- i__3[2] = 1, a__1[2] = ch__1;
+ do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
+ integer));
+/* Writing concatenation */
#line 14436 ""
- i__4 = comnvi_1.nspern[iinow - 1] + 48;
+ i__6[0] = 1, a__3[0] = "}";
#line 14436 ""
- chax_(ch__5, (ftnlen)1, &i__4);
+ i__2 = comnvi_1.nspern[iinow - 1] + 48;
#line 14436 ""
- i__3[3] = 1, a__1[3] = ch__5;
+ chax_(ch__1, (ftnlen)1, &i__2);
#line 14436 ""
- i__3[4] = 1, a__1[4] = "%";
+ i__6[1] = 1, a__3[1] = ch__1;
#line 14436 ""
- s_cat(ch__4, a__1, i__3, &c__5, (ftnlen)13);
+ i__6[2] = 1, a__3[2] = "%";
#line 14436 ""
- do_fio(&c__1, ch__4, (ftnlen)13);
+ s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3);
#line 14436 ""
- e_wsfe();
+ do_fio(&c__1, ch__11, (ftnlen)3);
+#line 14436 ""
+ e_wsfe();
#line 14438 ""
- s_wsfe(&io___830);
+ s_wsfe(&io___834);
/* Writing concatenation */
#line 14438 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
+ i__5[0] = 1, a__2[0] = all_1.sq;
#line 14438 ""
- i__3[1] = 7, a__1[1] = "setclef";
+ i__5[1] = 8, a__2[1] = "setclef{";
#line 14438 ""
- i__2 = iinow + 48;
+ s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
#line 14438 ""
- chax_(ch__1, (ftnlen)1, &i__2);
+ do_fio(&c__1, ch__12, (ftnlen)9);
#line 14438 ""
- i__3[2] = 1, a__1[2] = ch__1;
+ do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
+ integer));
+/* Writing concatenation */
#line 14438 ""
- i__3[3] = lclf, a__1[3] = hdlndq;
+ i__6[0] = 1, a__3[0] = "}";
#line 14438 ""
- i__3[4] = 1, a__1[4] = "%";
+ i__6[1] = lclf, a__3[1] = hdlndq;
#line 14438 ""
- s_cat(ch__6, a__1, i__3, &c__5, (ftnlen)69);
+ i__6[2] = 1, a__3[2] = "%";
#line 14438 ""
- do_fio(&c__1, ch__6, lclf + 10);
+ s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61);
#line 14438 ""
- e_wsfe();
+ do_fio(&c__1, ch__13, lclf + 2);
+#line 14438 ""
+ e_wsfe();
#line 14440 ""
- if (comfig_1.fullsize[comnvi_1.iiorig[iinow - 1]
- - 1] > .9f) {
-#line 14441 ""
- s_wsfe(&io___831);
-/* Writing concatenation */
-#line 14441 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
-#line 14441 ""
- i__3[1] = 7, a__1[1] = "setsize";
-#line 14441 ""
- i__2 = iinow + 48;
-#line 14441 ""
- chax_(ch__1, (ftnlen)1, &i__2);
-#line 14441 ""
- i__3[2] = 1, a__1[2] = ch__1;
-#line 14441 ""
- i__3[3] = 1, a__1[3] = all_1.sq;
-#line 14441 ""
- i__3[4] = 12, a__1[4] = "normalvalue%";
-#line 14441 ""
- s_cat(ch__7, a__1, i__3, &c__5, (ftnlen)22);
-#line 14441 ""
- do_fio(&c__1, ch__7, (ftnlen)22);
+ }
#line 14441 ""
- e_wsfe();
+ }
+#line 14442 ""
+/* L60: */
+#line 14442 ""
+ }
-/* 140526 Account for staff size specs when noinst changes. May be confusion */
-/* here if more than one staff per instrument */
+/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */
+#line 14446 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14447 ""
- } else if (comfig_1.fullsize[comnvi_1.iiorig[
- iinow - 1] - 1] > .7f) {
-#line 14448 ""
- s_wsfe(&io___832);
-/* Writing concatenation */
-#line 14448 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
-#line 14448 ""
- i__3[1] = 7, a__1[1] = "setsize";
-#line 14448 ""
- i__2 = iinow + 48;
-#line 14448 ""
- chax_(ch__1, (ftnlen)1, &i__2);
-#line 14448 ""
- i__3[2] = 1, a__1[2] = ch__1;
-#line 14448 ""
- i__3[3] = 1, a__1[3] = all_1.sq;
-#line 14448 ""
- i__3[4] = 11, a__1[4] = "smallvalue%";
-#line 14448 ""
- s_cat(ch__8, a__1, i__3, &c__5, (ftnlen)21);
-#line 14448 ""
- do_fio(&c__1, ch__8, (ftnlen)21);
+ goto L31;
#line 14448 ""
- e_wsfe();
+ } else if (*(unsigned char *)durq == 'S') {
+#line 14449 ""
+ goto L48;
#line 14450 ""
- } else {
-#line 14451 ""
- s_wsfe(&io___833);
-/* Writing concatenation */
-#line 14451 ""
- i__3[0] = 1, a__1[0] = all_1.sq;
-#line 14451 ""
- i__3[1] = 7, a__1[1] = "setsize";
-#line 14451 ""
- i__2 = iinow + 48;
-#line 14451 ""
- chax_(ch__1, (ftnlen)1, &i__2);
-#line 14451 ""
- i__3[2] = 1, a__1[2] = ch__1;
-#line 14451 ""
- i__3[3] = 1, a__1[3] = all_1.sq;
-#line 14451 ""
- i__3[4] = 10, a__1[4] = "tinyvalue%";
-#line 14451 ""
- s_cat(ch__9, a__1, i__3, &c__5, (ftnlen)20);
-#line 14451 ""
- do_fio(&c__1, ch__9, (ftnlen)20);
-#line 14451 ""
- e_wsfe();
-#line 14453 ""
- }
+ }
+
+/* Write instrument names */
+
#line 14454 ""
- } else {
-#line 14455 ""
- s_wsfe(&io___834);
-/* Writing concatenation */
-#line 14455 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14455 ""
- i__5[1] = 10, a__2[1] = "setstaffs{";
+ if (! comnvi_1.rename) {
#line 14455 ""
- s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+ i__1 = comnotes_1.ninow;
#line 14455 ""
- do_fio(&c__1, ch__10, (ftnlen)11);
-#line 14455 ""
- do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
- integer));
-/* Writing concatenation */
-#line 14455 ""
- i__6[0] = 1, a__3[0] = "}";
-#line 14455 ""
- i__2 = comnvi_1.nspern[iinow - 1] + 48;
-#line 14455 ""
- chax_(ch__1, (ftnlen)1, &i__2);
-#line 14455 ""
- i__6[1] = 1, a__3[1] = ch__1;
-#line 14455 ""
- i__6[2] = 1, a__3[2] = "%";
-#line 14455 ""
- s_cat(ch__11, a__3, i__6, &c__3, (ftnlen)3);
-#line 14455 ""
- do_fio(&c__1, ch__11, (ftnlen)3);
-#line 14455 ""
- e_wsfe();
-#line 14457 ""
- s_wsfe(&io___835);
-/* Writing concatenation */
-#line 14457 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14457 ""
- i__5[1] = 8, a__2[1] = "setclef{";
-#line 14457 ""
- s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
-#line 14457 ""
- do_fio(&c__1, ch__12, (ftnlen)9);
-#line 14457 ""
- do_fio(&c__1, (char *)&iinow, (ftnlen)sizeof(
- integer));
-/* Writing concatenation */
-#line 14457 ""
- i__6[0] = 1, a__3[0] = "}";
-#line 14457 ""
- i__6[1] = lclf, a__3[1] = hdlndq;
-#line 14457 ""
- i__6[2] = 1, a__3[2] = "%";
-#line 14457 ""
- s_cat(ch__13, a__3, i__6, &c__3, (ftnlen)61);
-#line 14457 ""
- do_fio(&c__1, ch__13, lclf + 2);
+ for (iinst = 1; iinst <= i__1; ++iinst) {
+#line 14456 ""
+ if (comlast_1.islast) {
#line 14457 ""
- e_wsfe();
+ if (iinst < 10) {
+#line 14458 ""
+ s_wsfe(&io___836);
+/* Writing concatenation */
+#line 14458 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14458 ""
+ i__5[1] = 7, a__2[1] = "setname";
+#line 14458 ""
+ s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
+#line 14458 ""
+ do_fio(&c__1, ch__14, (ftnlen)8);
+#line 14458 ""
+ do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
+ integer));
+#line 14458 ""
+ do_fio(&c__1, "{}%", (ftnlen)3);
+#line 14458 ""
+ e_wsfe();
#line 14459 ""
- }
+ } else {
#line 14460 ""
- }
-#line 14461 ""
-/* L60: */
+ s_wsfe(&io___837);
+/* Writing concatenation */
+#line 14460 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14460 ""
+ i__5[1] = 8, a__2[1] = "setname{";
+#line 14460 ""
+ s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14460 ""
+ do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14460 ""
+ do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
+ integer));
+#line 14460 ""
+ do_fio(&c__1, "}{}%", (ftnlen)4);
+#line 14460 ""
+ e_wsfe();
#line 14461 ""
- }
-
-/* Loop back up, this may not be last option in M. Note flow out if durq=' ' */
-
+ }
+#line 14462 ""
+ }
+#line 14463 ""
+/* L62: */
+#line 14463 ""
+ }
+#line 14464 ""
+ } else {
#line 14465 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ i__1 = comnotes_1.ninow;
+#line 14465 ""
+ for (iinst = 1; iinst <= i__1; ++iinst) {
#line 14466 ""
- goto L31;
+ if (comlast_1.islast) {
#line 14467 ""
- } else if (*(unsigned char *)durq == 'S') {
+ if (iinst < 10) {
#line 14468 ""
- goto L48;
-#line 14469 ""
- }
-
-/* Write instrument names */
-
-#line 14473 ""
- if (! comnvi_1.rename) {
-#line 14474 ""
- i__1 = comnotes_1.ninow;
-#line 14474 ""
- for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 14475 ""
- if (comlast_1.islast) {
-#line 14476 ""
- if (iinst < 10) {
-#line 14477 ""
- s_wsfe(&io___837);
-/* Writing concatenation */
-#line 14477 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14477 ""
- i__5[1] = 7, a__2[1] = "setname";
-#line 14477 ""
- s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
-#line 14477 ""
- do_fio(&c__1, ch__14, (ftnlen)8);
-#line 14477 ""
- do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
- integer));
-#line 14477 ""
- do_fio(&c__1, "{}%", (ftnlen)3);
-#line 14477 ""
- e_wsfe();
-#line 14478 ""
- } else {
-#line 14479 ""
- s_wsfe(&io___838);
+ s_wsfe(&io___838);
/* Writing concatenation */
-#line 14479 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14479 ""
- i__5[1] = 8, a__2[1] = "setname{";
-#line 14479 ""
- s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
-#line 14479 ""
- do_fio(&c__1, ch__12, (ftnlen)9);
-#line 14479 ""
- do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
- integer));
-#line 14479 ""
- do_fio(&c__1, "}{}%", (ftnlen)4);
-#line 14479 ""
- e_wsfe();
-#line 14480 ""
- }
-#line 14481 ""
- }
-#line 14482 ""
-/* L62: */
-#line 14482 ""
- }
-#line 14483 ""
- } else {
-#line 14484 ""
- i__1 = comnotes_1.ninow;
-#line 14484 ""
- for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 14485 ""
- if (comlast_1.islast) {
-#line 14486 ""
- if (iinst < 10) {
-#line 14487 ""
- s_wsfe(&io___839);
-/* Writing concatenation */
-#line 14487 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14487 ""
- i__5[1] = 7, a__2[1] = "setname";
-#line 14487 ""
- s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
-#line 14487 ""
- do_fio(&c__1, ch__14, (ftnlen)8);
-#line 14487 ""
- do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
- integer));
-/* Writing concatenation */
-#line 14487 ""
- i__6[0] = 1, a__3[0] = "{";
-#line 14487 ""
- i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1]
- - 1], a__3[1] = comtop_1.inameq + (
- comnvi_1.iiorig[iinst - 1] - 1) * 79;
-#line 14487 ""
- i__6[2] = 2, a__3[2] = "}%";
-#line 14487 ""
- s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82);
-#line 14487 ""
- do_fio(&c__1, ch__15, comtop_1.lnam[
- comnvi_1.iiorig[iinst - 1] - 1] + 3);
-#line 14487 ""
- e_wsfe();
-#line 14489 ""
- } else {
-#line 14490 ""
- s_wsfe(&io___840);
+#line 14468 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14468 ""
+ i__5[1] = 7, a__2[1] = "setname";
+#line 14468 ""
+ s_cat(ch__14, a__2, i__5, &c__2, (ftnlen)8);
+#line 14468 ""
+ do_fio(&c__1, ch__14, (ftnlen)8);
+#line 14468 ""
+ do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
+ integer));
/* Writing concatenation */
-#line 14490 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14490 ""
- i__5[1] = 8, a__2[1] = "setname{";
-#line 14490 ""
- s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
-#line 14490 ""
- do_fio(&c__1, ch__12, (ftnlen)9);
-#line 14490 ""
- do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
- integer));
+#line 14468 ""
+ i__6[0] = 1, a__3[0] = "{";
+#line 14468 ""
+ i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst
+ - 1] - 1], a__3[1] = comtop_1.inameq
+ + (comnvi_1.iiorig[iinst - 1] - 1) *
+ 79;
+#line 14468 ""
+ i__6[2] = 2, a__3[2] = "}%";
+#line 14468 ""
+ s_cat(ch__15, a__3, i__6, &c__3, (ftnlen)82);
+#line 14468 ""
+ do_fio(&c__1, ch__15, comtop_1.lnam[
+ comnvi_1.iiorig[iinst - 1] - 1] + 3);
+#line 14468 ""
+ e_wsfe();
+#line 14470 ""
+ } else {
+#line 14471 ""
+ s_wsfe(&io___839);
+/* Writing concatenation */
+#line 14471 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14471 ""
+ i__5[1] = 8, a__2[1] = "setname{";
+#line 14471 ""
+ s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14471 ""
+ do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14471 ""
+ do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
+ integer));
/* Writing concatenation */
-#line 14490 ""
- i__6[0] = 2, a__3[0] = "}{";
-#line 14490 ""
- i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1]
- - 1], a__3[1] = comtop_1.inameq + (
- comnvi_1.iiorig[iinst - 1] - 1) * 79;
-#line 14490 ""
- i__6[2] = 2, a__3[2] = "}%";
-#line 14490 ""
- s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83);
-#line 14490 ""
- do_fio(&c__1, ch__16, comtop_1.lnam[
- comnvi_1.iiorig[iinst - 1] - 1] + 4);
-#line 14490 ""
- e_wsfe();
-#line 14492 ""
+#line 14471 ""
+ i__6[0] = 2, a__3[0] = "}{";
+#line 14471 ""
+ i__6[1] = comtop_1.lnam[comnvi_1.iiorig[iinst
+ - 1] - 1], a__3[1] = comtop_1.inameq
+ + (comnvi_1.iiorig[iinst - 1] - 1) *
+ 79;
+#line 14471 ""
+ i__6[2] = 2, a__3[2] = "}%";
+#line 14471 ""
+ s_cat(ch__16, a__3, i__6, &c__3, (ftnlen)83);
+#line 14471 ""
+ do_fio(&c__1, ch__16, comtop_1.lnam[
+ comnvi_1.iiorig[iinst - 1] - 1] + 4);
+#line 14471 ""
+ e_wsfe();
+#line 14473 ""
+ }
+#line 14474 ""
}
-#line 14493 ""
- }
-#line 14494 ""
+#line 14475 ""
/* L65: */
-#line 14494 ""
- }
-#line 14495 ""
- if (comshort_1.ishort != 4 && comshort_1.ishort != 2) {
-#line 14495 ""
- comnvi_1.rename = FALSE_;
-#line 14495 ""
- }
+#line 14475 ""
+ }
+#line 14476 ""
+ if (comshort_1.ishort != 4 && comshort_1.ishort != 2) {
+#line 14476 ""
+ comnvi_1.rename = FALSE_;
+#line 14476 ""
+ }
/* Reset later and rewrite setname{} in shortening case mcm, since if */
/* written here it will be inside {{...}} and will be ignored */
-#line 14500 ""
+#line 14481 ""
+ }
+#line 14482 ""
}
-#line 14501 ""
- }
-#line 14502 ""
- } else if (*(unsigned char *)charq == '|') {
+#line 14483 ""
+ } else if (*(unsigned char *)charq == '|') {
/* End of bar symbol. Check about end of bar hardspace. */
-#line 14506 ""
- if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
- + 1) * 24 - 1],26)) {
+#line 14487 ""
+ if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx -
+ 1] + 1) * 24 - 1],26)) {
/* There was a hardspace followed by a bar line. Remove it from the hardspace */
/* list, store with shifts instead, set special bit. Need to repeat this code */
/* at '/'. */
-#line 14512 ""
- all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
- = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 25],18);
-#line 14513 ""
- ++comudsp_1.nudoff[commvl_1.ivx - 1];
-#line 14514 ""
- comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
- * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
-#line 14515 ""
- --comudsp_1.nudsp;
-#line 14516 ""
- all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 1],26);
-#line 14517 ""
- }
-#line 14518 ""
- } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) {
+#line 14493 ""
+ all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 25] = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25],18);
+#line 14494 ""
+ ++comudsp_1.nudoff[commvl_1.ivx - 1];
+#line 14495 ""
+ comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx
+ - 1] * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
+#line 14496 ""
+ --comudsp_1.nudsp;
+#line 14497 ""
+ all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
+ 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26);
+#line 14498 ""
+ }
+#line 14499 ""
+ } else if (i_indx("wS", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Width symbol or new nsyst. Read past (until blank) */
-#line 14522 ""
+#line 14503 ""
L4:
-#line 14522 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14523 ""
- if (*(unsigned char *)durq != ' ') {
-#line 14523 ""
- goto L4;
-#line 14523 ""
- }
-#line 14524 ""
- } else if (*(unsigned char *)charq == 'l') {
+#line 14503 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14504 ""
+ if (*(unsigned char *)durq != ' ') {
+#line 14504 ""
+ goto L4;
+#line 14504 ""
+ }
+#line 14505 ""
+ } else if (*(unsigned char *)charq == 'l') {
/* Lower string. Only OK if at start of block */
/* Check whether at beginning of a block */
-#line 14529 ""
- if (all_1.iv != 1 || all_1.nnl[0] != 0) {
-#line 14530 ""
- s_wsle(&io___841);
-#line 14530 ""
- do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of block"
- , (ftnlen)41);
-#line 14530 ""
- e_wsle();
-#line 14531 ""
- stop1_();
-#line 14532 ""
- }
+#line 14510 ""
+ if (all_1.iv != 1 || all_1.nnl[0] != 0) {
+#line 14511 ""
+ s_wsle(&io___840);
+#line 14511 ""
+ do_lio(&c__9, &c__1, "You entered \"l\" not at beginning of "\
+ "block", (ftnlen)41);
+#line 14511 ""
+ e_wsle();
+#line 14512 ""
+ stop1_();
+#line 14513 ""
+ }
/* Set flag for lower string & read it in */
-#line 14536 ""
- comhead_1.lower = TRUE_;
-#line 14537 ""
- getbuf_(comhead_1.lowerq, (ftnlen)80);
-#line 14538 ""
- all_1.iccount = 128;
-#line 14539 ""
- } else if (*(unsigned char *)charq == 'm') {
+#line 14517 ""
+ comhead_1.lower = TRUE_;
+#line 14518 ""
+ getbuf_(comhead_1.lowerq, (ftnlen)80);
+#line 14519 ""
+ all_1.iccount = 128;
+#line 14520 ""
+ } else if (*(unsigned char *)charq == 'm') {
/* Meter change. Only allow at beginning of block. */
/* mtrnuml, mtrdenl (logical) and p (printable) will be input. */
@@ -34419,602 +34621,610 @@ L4:
/* Check whether at beginning of a block */
+#line 14528 ""
+ if (all_1.iv != 1 || all_1.nnl[0] != 0) {
+#line 14529 ""
+ s_wsle(&io___841);
+#line 14529 ""
+ do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of "\
+ "block", (ftnlen)41);
+#line 14529 ""
+ e_wsle();
+#line 14530 ""
+ stop1_();
+#line 14531 ""
+ }
+#line 14532 ""
+ readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl,
+ (ftnlen)128);
+#line 14533 ""
+ readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, (
+ ftnlen)128);
+#line 14534 ""
+ lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
+#line 14535 ""
+ if (all_1.mtrdenl == 2) {
+#line 14535 ""
+ lenbeat = 16;
+#line 14535 ""
+ }
+#line 14536 ""
+ all_1.lenbar = all_1.mtrnuml * lenbeat;
+#line 14537 ""
+ if (all_1.mtrdenl == 2) {
+#line 14537 ""
+ all_1.lenbar <<= 1;
+#line 14537 ""
+ }
+#line 14538 ""
+ all_1.lenb1 = all_1.lenbar;
+#line 14539 ""
+ all_1.lenb0 = 0;
+#line 14540 ""
+ if (commidi_1.ismidi) {
+#line 14540 ""
+ midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
+#line 14540 ""
+ }
+#line 14541 ""
+ } else if (*(unsigned char *)charq == 'C') {
+
+/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
+
+#line 14545 ""
+ if (all_1.nnl[all_1.iv - 1] > 0) {
+#line 14545 ""
+ ++comcc_1.ncc[all_1.iv - 1];
+#line 14545 ""
+ }
+#line 14546 ""
+ comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (
+ real) all_1.itsofar[all_1.iv - 1];
#line 14547 ""
- if (all_1.iv != 1 || all_1.nnl[0] != 0) {
+ isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1)
+ * 24 - 25],11);
#line 14548 ""
- s_wsle(&io___842);
-#line 14548 ""
- do_lio(&c__9, &c__1, "You entered \"m\" not at beginning of block"
- , (ftnlen)41);
-#line 14548 ""
- e_wsle();
-#line 14549 ""
- stop1_();
-#line 14550 ""
- }
-#line 14551 ""
- readmeter_(lineq, &all_1.iccount, &all_1.mtrnuml, &all_1.mtrdenl, (
- ftnlen)128);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+
+/* Store clef number, or 7 if clef number = 9 (French violin clef) */
+
+/* Computing MIN */
#line 14552 ""
- readmeter_(lineq, &all_1.iccount, &all_1.mtrnmp, &all_1.mtrdnp, (
- ftnlen)128);
+ i__1 = numclef_(durq, (ftnlen)1);
+#line 14552 ""
+ isl |= min(i__1,7) << 12;
#line 14553 ""
- lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
-#line 14554 ""
- if (all_1.mtrdenl == 2) {
+ comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] =
+ ncmidf_(durq, (ftnlen)1);
#line 14554 ""
- lenbeat = 16;
-#line 14554 ""
- }
+ if (*(unsigned char *)durq == '8') {
#line 14555 ""
- all_1.lenbar = all_1.mtrnuml * lenbeat;
-#line 14556 ""
- if (all_1.mtrdenl == 2) {
-#line 14556 ""
- all_1.lenbar <<= 1;
+ all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25]
+ = bit_set(all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv -
+ 1] + 1) * 24 - 25],2);
#line 14556 ""
- }
+ cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1]
+ - 1] += 7;
#line 14557 ""
- all_1.lenb1 = all_1.lenbar;
+ comnotes_1.lastlev += 7;
#line 14558 ""
- all_1.lenb0 = 0;
-#line 14559 ""
- if (commidi_1.ismidi) {
-#line 14559 ""
- midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
+ if (all_1.nnl[all_1.iv - 1] == 0) {
#line 14559 ""
- }
+ comnotes_1.ndlev[all_1.iv - 1] += 7;
#line 14560 ""
- } else if (*(unsigned char *)charq == 'C') {
+ comnotes_1.ndlev[all_1.iv + 23] += 7;
+#line 14561 ""
+ }
+#line 14562 ""
+ } else {
-/* Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. */
+/* This won't work if you really had an octave transposition with some */
+/* other clef. Need a check on whether prior clef was an octave clef. */
-#line 14564 ""
- if (all_1.nnl[all_1.iv - 1] > 0) {
-#line 14564 ""
- ++comcc_1.ncc[all_1.iv - 1];
-#line 14564 ""
- }
-#line 14565 ""
- comcc_1.tcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] = (real)
- all_1.itsofar[all_1.iv - 1];
-#line 14566 ""
- isl = bit_set(all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) *
- 24 - 25],11);
#line 14567 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-
-/* Store clef number, or 7 if clef number = 9 (French violin clef) */
-
-/* Computing MIN */
-#line 14571 ""
- i__1 = numclef_(durq, (ftnlen)1);
+ if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv -
+ 1] - 1] == 7) {
+#line 14568 ""
+ cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv -
+ 1] - 1] += -7;
+#line 14569 ""
+ comnotes_1.lastlev += -7;
+#line 14570 ""
+ if (all_1.nnl[all_1.iv - 1] == 0) {
#line 14571 ""
- isl |= min(i__1,7) << 12;
+ comnotes_1.ndlev[all_1.iv - 1] += -7;
#line 14572 ""
- comcc_1.ncmidcc[all_1.iv + comcc_1.ncc[all_1.iv - 1] * 24 - 25] =
- ncmidf_(durq, (ftnlen)1);
+ comnotes_1.ndlev[all_1.iv + 23] += -7;
#line 14573 ""
- if (*(unsigned char *)durq == '8') {
+ }
#line 14574 ""
- all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] =
- bit_set(all_1.ipl[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1)
- * 24 - 25],2);
+ }
#line 14575 ""
- cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1] - 1]
- += 7;
-#line 14576 ""
- comnotes_1.lastlev += 7;
-#line 14577 ""
- if (all_1.nnl[all_1.iv - 1] == 0) {
-#line 14578 ""
- comnotes_1.ndlev[all_1.iv - 1] += 7;
-#line 14579 ""
- comnotes_1.ndlev[all_1.iv + 23] += 7;
-#line 14580 ""
}
-#line 14581 ""
- } else {
-/* This won't work if you really had an octave transposition with some */
-/* other clef. Need a check on whether prior clef was an octave clef. */
+/* Set marker on note with lowest voice # starting at same time. */
+#line 14579 ""
+ if (all_1.iv == 1) {
+#line 14580 ""
+ isl = bit_set(isl,15);
+#line 14581 ""
+ } else {
+#line 14582 ""
+ i__1 = all_1.iv;
+#line 14582 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 14583 ""
+ nnliiv = all_1.nnl[iiv - 1];
+#line 14584 ""
+ if (iiv == all_1.iv) {
+#line 14584 ""
+ ++nnliiv;
+#line 14584 ""
+ }
+#line 14585 ""
+ itother = 0;
#line 14586 ""
- if (cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1]
- - 1] == 7) {
+ i__2 = nnliiv;
+#line 14586 ""
+ for (iip = 1; iip <= i__2; ++iip) {
#line 14587 ""
- cominsttrans_1.itransamt[cominsttrans_1.instno[all_1.iv - 1]
- - 1] += -7;
+ if (itother < all_1.itsofar[all_1.iv - 1]) {
#line 14588 ""
- comnotes_1.lastlev += -7;
+ itother += all_1.nodur[iiv + iip * 24 - 25];
#line 14589 ""
- if (all_1.nnl[all_1.iv - 1] == 0) {
+ goto L14;
#line 14590 ""
- comnotes_1.ndlev[all_1.iv - 1] += -7;
+ } else if (itother == all_1.itsofar[all_1.iv - 1]) {
#line 14591 ""
- comnotes_1.ndlev[all_1.iv + 23] += -7;
+ all_1.islur[iiv + iip * 24 - 25] = bit_set(
+ all_1.islur[iiv + iip * 24 - 25],15);
#line 14592 ""
- }
+ goto L15;
#line 14593 ""
- }
+ }
#line 14594 ""
- }
+L14:
+#line 14594 ""
+ ;
+#line 14594 ""
+ }
+#line 14595 ""
+/* L13: */
+#line 14595 ""
+ }
+#line 14596 ""
+L15:
+#line 14597 ""
+ ;
+#line 14597 ""
+ }
-/* Set marker on note with lowest voice # starting at same time. */
+/* Need 'or' since may have set bit 15 in the above loop */
-#line 14598 ""
- if (all_1.iv == 1) {
-#line 14599 ""
- isl = bit_set(isl,15);
-#line 14600 ""
- } else {
-#line 14601 ""
- i__1 = all_1.iv;
#line 14601 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
+ all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] =
+ isl | all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1)
+ * 24 - 25];
#line 14602 ""
- nnliiv = all_1.nnl[iiv - 1];
-#line 14603 ""
- if (iiv == all_1.iv) {
-#line 14603 ""
- ++nnliiv;
-#line 14603 ""
- }
-#line 14604 ""
- itother = 0;
-#line 14605 ""
- i__2 = nnliiv;
-#line 14605 ""
- for (iip = 1; iip <= i__2; ++iip) {
+ } else if (*(unsigned char *)charq == 'R') {
+
+/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */
+
#line 14606 ""
- if (itother < all_1.itsofar[all_1.iv - 1]) {
-#line 14607 ""
- itother += all_1.nodur[iiv + iip * 24 - 25];
-#line 14608 ""
- goto L14;
-#line 14609 ""
- } else if (itother == all_1.itsofar[all_1.iv - 1]) {
+L10:
+#line 14606 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+
+/* Save designator in case it's a terminal Rr or Rd */
+
#line 14610 ""
- all_1.islur[iiv + iip * 24 - 25] = bit_set(
- all_1.islur[iiv + iip * 24 - 25],15);
+ if (*(unsigned char *)durq == 'l') {
#line 14611 ""
- goto L15;
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],5);
#line 14612 ""
- }
-#line 14613 ""
-L14:
-#line 14613 ""
- ;
+ goto L10;
#line 14613 ""
- }
+ } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) {
#line 14614 ""
-/* L13: */
-#line 14614 ""
- }
+ if (*(unsigned char *)durq == 'r') {
#line 14615 ""
-L15:
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6);
#line 14616 ""
- ;
-#line 14616 ""
- }
-
-/* Need 'or' since may have set bit 15 in the above loop */
-
+ } else if (*(unsigned char *)durq == 'd') {
+#line 14617 ""
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8);
+#line 14618 ""
+ } else if (*(unsigned char *)durq == 'D') {
+#line 14619 ""
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26);
#line 14620 ""
- all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 - 25] = isl
- | all_1.islur[all_1.iv + (all_1.nnl[all_1.iv - 1] + 1) * 24 -
- 25];
+ } else if (*(unsigned char *)durq == 'b') {
#line 14621 ""
- } else if (*(unsigned char *)charq == 'R') {
-
-/* Repeats. set bits 5, 6, and/or 8 of islur(1,ip+1) */
-
-#line 14625 ""
-L10:
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25);
+#line 14622 ""
+ } else if (*(unsigned char *)durq == 'z') {
+/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */
+#line 14624 ""
+ all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
+ all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24],0);
#line 14625 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-
-/* Save designator in case it's a terminal Rr or Rd */
-
+ }
+#line 14626 ""
+ comget_1.rptprev = TRUE_;
+#line 14627 ""
+ *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq;
+#line 14628 ""
+ goto L10;
#line 14629 ""
- if (*(unsigned char *)durq == 'l') {
+ }
#line 14630 ""
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.islur[(
- all_1.nnl[0] + 1) * 24 - 24],5);
-#line 14631 ""
- goto L10;
-#line 14632 ""
- } else if (i_indx("rdDbz", durq, (ftnlen)5, (ftnlen)1) > 0) {
-#line 14633 ""
- if (*(unsigned char *)durq == 'r') {
+ } else if (*(unsigned char *)charq == 'V') {
+
+/* Ending */
+
#line 14634 ""
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],6);
+ nnnl = all_1.nnl[0] + 1;
#line 14635 ""
- } else if (*(unsigned char *)durq == 'd') {
+ lvoltxt = 0;
#line 14636 ""
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],8);
+L11:
+#line 14636 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14637 ""
- } else if (*(unsigned char *)durq == 'D') {
-#line 14638 ""
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],26);
-#line 14639 ""
- } else if (*(unsigned char *)durq == 'b') {
-#line 14640 ""
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(
- all_1.islur[(all_1.nnl[0] + 1) * 24 - 24],25);
+ if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq ==
+ 'x') {
+
+/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */
+
#line 14641 ""
- } else if (*(unsigned char *)durq == 'z') {
-/* iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) */
+ all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
+ 24],9);
+#line 14642 ""
+ if (*(unsigned char *)durq == 'b') {
+#line 14642 ""
+ all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl *
+ 24 - 24],10);
+#line 14642 ""
+ }
#line 14643 ""
- all_1.ipl[(all_1.nnl[0] + 1) * 24 - 24] = bit_set(all_1.ipl[(
- all_1.nnl[0] + 1) * 24 - 24],0);
+ goto L11;
#line 14644 ""
- }
-#line 14645 ""
- comget_1.rptprev = TRUE_;
-#line 14646 ""
- *(unsigned char *)comget_1.rptfq1 = *(unsigned char *)durq;
-#line 14647 ""
- goto L10;
+ } else if (*(unsigned char *)durq != ' ') {
+
+/* Start volta; Get text */
+
#line 14648 ""
- }
-#line 14649 ""
- } else if (*(unsigned char *)charq == 'V') {
+ if (lvoltxt == 0) {
-/* Ending */
+/* First character for text */
+#line 14652 ""
+ lvoltxt = 1;
#line 14653 ""
- nnnl = all_1.nnl[0] + 1;
+ all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl *
+ 24 - 24],7);
#line 14654 ""
- lvoltxt = 0;
-#line 14655 ""
-L11:
+ ++comgrace_1.nvolt;
#line 14655 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20,
+ durq, (ftnlen)20, (ftnlen)1);
#line 14656 ""
- if (*(unsigned char *)durq == 'b' || *(unsigned char *)durq == 'x') {
-
-/* End Volta, set bit9, and bit10 on if 'b' (end w/ box) */
-
+ } else {
+/* Writing concatenation */
+#line 14657 ""
+ i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + (
+ comgrace_1.nvolt - 1) * 20;
+#line 14657 ""
+ i__5[1] = 1, a__2[1] = durq;
+#line 14657 ""
+ s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20,
+ a__2, i__5, &c__2, (ftnlen)20);
+#line 14658 ""
+ ++lvoltxt;
+#line 14659 ""
+ }
#line 14660 ""
- all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 - 24],
- 9);
-#line 14661 ""
- if (*(unsigned char *)durq == 'b') {
-#line 14661 ""
- all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
- 24],10);
+ goto L11;
#line 14661 ""
}
#line 14662 ""
- goto L11;
+ } else if (*(unsigned char *)charq == 'B') {
#line 14663 ""
- } else if (*(unsigned char *)durq != ' ') {
+ combc_1.bcspec = ! combc_1.bcspec;
+#line 14664 ""
+ } else if (*(unsigned char *)charq == 'P') {
-/* Start volta; Get text */
+/* Page numbers. Print stuff right now. */
-#line 14667 ""
- if (lvoltxt == 0) {
+#line 14668 ""
+ npg1 = 0;
-/* First character for text */
+/* Will use ltopnam to signal whether there's a centered heading */
-#line 14671 ""
- lvoltxt = 1;
#line 14672 ""
- all_1.islur[nnnl * 24 - 24] = bit_set(all_1.islur[nnnl * 24 -
- 24],7);
+ ltopnam = 0;
#line 14673 ""
- ++comgrace_1.nvolt;
+ ipg1r = 0;
#line 14674 ""
- s_copy(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, durq,
- (ftnlen)20, (ftnlen)1);
+L16:
+#line 14674 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14675 ""
- } else {
-/* Writing concatenation */
-#line 14676 ""
- i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + (
- comgrace_1.nvolt - 1) * 20;
-#line 14676 ""
- i__5[1] = 1, a__2[1] = durq;
+ if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57)
+ {
#line 14676 ""
- s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__2,
- i__5, &c__2, (ftnlen)20);
+ npg1 = npg1 * 10 + *(unsigned char *)durq - 48;
#line 14677 ""
- ++lvoltxt;
+ goto L16;
#line 14678 ""
- }
+ } else if (*(unsigned char *)durq == 'l') {
#line 14679 ""
- goto L11;
+ if (npg1 == 0 || npg1 % 2 == 1) {
+#line 14679 ""
+ ipg1r = 1;
+#line 14679 ""
+ }
#line 14680 ""
- }
+ goto L16;
#line 14681 ""
- } else if (*(unsigned char *)charq == 'B') {
+ } else if (*(unsigned char *)durq == 'r') {
+#line 14682 ""
+ if (npg1 > 0 && npg1 % 2 == 0) {
+#line 14682 ""
+ ipg1r = 1;
#line 14682 ""
- combc_1.bcspec = ! combc_1.bcspec;
+ }
#line 14683 ""
- } else if (*(unsigned char *)charq == 'P') {
-
-/* Page numbers. Print stuff right now. */
-
-#line 14687 ""
- npg1 = 0;
+ goto L16;
+#line 14684 ""
+ } else if (*(unsigned char *)durq == 'c') {
-/* Will use ltopnam to signal whether there's a centered heading */
+/* Top-centered name. Assume this is last option. Read the name. */
+/* May surround name in double quotes (to allow blanks). */
+#line 14689 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14690 ""
+ if (*(unsigned char *)durq == ' ') {
#line 14691 ""
- ltopnam = 0;
+ ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60);
#line 14692 ""
- ipg1r = 0;
-#line 14693 ""
-L16:
+ } else {
#line 14693 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ namstrt = all_1.iccount;
#line 14694 ""
- if (*(unsigned char *)durq >= 48 && *(unsigned char *)durq <= 57) {
-#line 14695 ""
- npg1 = npg1 * 10 + *(unsigned char *)durq - 48;
-#line 14696 ""
- goto L16;
-#line 14697 ""
- } else if (*(unsigned char *)durq == 'l') {
-#line 14698 ""
- if (npg1 == 0 || npg1 % 2 == 1) {
-#line 14698 ""
- ipg1r = 1;
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 14694 ""
+ if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0])
+ {
+
+/* Using quote delimiters. */
+
#line 14698 ""
- }
+ quoted = TRUE_;
#line 14699 ""
- goto L16;
+ ++namstrt;
#line 14700 ""
- } else if (*(unsigned char *)durq == 'r') {
-#line 14701 ""
- if (npg1 > 0 && npg1 % 2 == 0) {
-#line 14701 ""
- ipg1r = 1;
+ } else {
#line 14701 ""
- }
+ quoted = FALSE_;
#line 14702 ""
- goto L16;
+ }
#line 14703 ""
- } else if (*(unsigned char *)durq == 'c') {
+ for (all_1.iccount = namstrt + 1; all_1.iccount <= 128;
+ ++all_1.iccount) {
+#line 14704 ""
+ i__1 = all_1.iccount - 2;
+#line 14704 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 14704 ""
+ chax_(ch__5, (ftnlen)1, &c__92);
+#line 14704 ""
+ if (quoted && *(unsigned char *)&lineq[all_1.iccount
+ - 1] == *(unsigned char *)&ch__1[0] && s_cmp(
+ lineq + i__1, ch__5, all_1.iccount - 1 - i__1,
+ (ftnlen)1) != 0 || ! quoted && *(unsigned
+ char *)&lineq[all_1.iccount - 1] == ' ') {
+#line 14704 ""
+ goto L36;
+#line 14704 ""
+ }
-/* Top-centered name. Assume this is last option. Read the name. */
-/* May surround name in double quotes (to allow blanks). */
+/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */
-#line 14708 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14709 ""
- if (*(unsigned char *)durq == ' ') {
-#line 14710 ""
- ltopnam = lenstr_(comtrans_1.cheadq, &c__60, (ftnlen)60);
#line 14711 ""
- } else {
+/* L35: */
+#line 14711 ""
+ }
+#line 14712 ""
+ s_wsle(&io___850);
+#line 14712 ""
+ do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", (
+ ftnlen)31);
#line 14712 ""
- namstrt = all_1.iccount;
+ e_wsle();
#line 14713 ""
- if (*(unsigned char *)durq == '"') {
-
-/* Using quote delimiters. */
-
+ stop1_();
+#line 14714 ""
+L36:
+#line 14715 ""
+ ltopnam = all_1.iccount - namstrt;
+#line 14716 ""
+ s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)
+ 60, all_1.iccount - 1 - (namstrt - 1));
#line 14717 ""
- quoted = TRUE_;
-#line 14718 ""
- ++namstrt;
-#line 14719 ""
- } else {
-#line 14720 ""
- quoted = FALSE_;
-#line 14721 ""
- }
-#line 14722 ""
- for (all_1.iccount = namstrt + 1; all_1.iccount <= 128;
- ++all_1.iccount) {
-/* if ((quoted .and. lineq(iccount:iccount) .eq. '"') .or. */
-#line 14724 ""
- i__1 = all_1.iccount - 2;
-#line 14724 ""
- if (quoted && *(unsigned char *)&lineq[all_1.iccount - 1]
- == '"' && s_cmp(lineq + i__1, "\\", all_1.iccount
- - 1 - i__1, (ftnlen)1) != 0 || ! quoted && *(
- unsigned char *)&lineq[all_1.iccount - 1] == ' ')
- {
-#line 14724 ""
- goto L36;
-#line 14724 ""
- }
-
-/* On exit, iccount is OK, and name is in (namstrt:iccount-1) */
-
-#line 14731 ""
-/* L35: */
-#line 14731 ""
}
-#line 14732 ""
- s_wsle(&io___851);
-#line 14732 ""
- do_lio(&c__9, &c__1, "Awww, cmon, should not be here.", (
- ftnlen)31);
-#line 14732 ""
- e_wsle();
-#line 14733 ""
- stop1_();
-#line 14734 ""
-L36:
-#line 14735 ""
- ltopnam = all_1.iccount - namstrt;
-#line 14736 ""
- s_copy(comtrans_1.cheadq, lineq + (namstrt - 1), (ftnlen)60,
- all_1.iccount - 1 - (namstrt - 1));
-#line 14737 ""
+#line 14718 ""
}
-#line 14738 ""
- }
/* Done getting data, now assemble the command */
-#line 14742 ""
- if (npg1 == 0) {
-#line 14742 ""
- npg1 = 1;
-#line 14742 ""
- }
+#line 14722 ""
+ if (npg1 == 0) {
+#line 14722 ""
+ npg1 = 1;
+#line 14722 ""
+ }
/* 2/23/03 Don't use \atnextline if on first page and only one system */
/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */
/* Writing concatenation */
-#line 14747 ""
- i__7[0] = 1, a__4[0] = all_1.sq;
-#line 14747 ""
- i__7[1] = 3, a__4[1] = "def";
-#line 14747 ""
- i__7[2] = 1, a__4[2] = all_1.sq;
-#line 14747 ""
- i__7[3] = 11, a__4[3] = "atnextline{";
-#line 14747 ""
- i__7[4] = 1, a__4[4] = all_1.sq;
-#line 14747 ""
- i__7[5] = 10, a__4[5] = "toppageno{";
-#line 14747 ""
- s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59);
-#line 14748 ""
- lhead = 27;
+#line 14727 ""
+ i__7[0] = 1, a__4[0] = all_1.sq;
+#line 14727 ""
+ i__7[1] = 3, a__4[1] = "def";
+#line 14727 ""
+ i__7[2] = 1, a__4[2] = all_1.sq;
+#line 14727 ""
+ i__7[3] = 11, a__4[3] = "atnextline{";
+#line 14727 ""
+ i__7[4] = 1, a__4[4] = all_1.sq;
+#line 14727 ""
+ i__7[5] = 10, a__4[5] = "toppageno{";
+#line 14727 ""
+ s_cat(hdlndq, a__4, i__7, &c__6, (ftnlen)59);
+#line 14728 ""
+ lhead = 27;
/* else */
/* hdlndq = sq//'toppageno{' */
/* lhead = 11 */
/* end if */
-#line 14753 ""
- if (npg1 < 10) {
+#line 14733 ""
+ if (npg1 < 10) {
/* Note we are overwriting the last "{" */
-#line 14757 ""
- ici__1.icierr = 0;
-#line 14757 ""
- ici__1.icirnum = 1;
-#line 14757 ""
- ici__1.icirlen = 1;
-#line 14757 ""
- ici__1.iciunit = hdlndq + (lhead - 1);
-#line 14757 ""
- ici__1.icifmt = "(i1)";
-#line 14757 ""
- s_wsfi(&ici__1);
-#line 14757 ""
- do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
-#line 14757 ""
- e_wsfi();
-#line 14758 ""
- } else if (npg1 < 100) {
-#line 14759 ""
- lhead += 3;
-#line 14760 ""
- i__1 = lhead - 3;
-#line 14760 ""
- ici__1.icierr = 0;
-#line 14760 ""
- ici__1.icirnum = 1;
-#line 14760 ""
- ici__1.icirlen = lhead - i__1;
-#line 14760 ""
- ici__1.iciunit = hdlndq + i__1;
-#line 14760 ""
- ici__1.icifmt = "(i2,a1)";
-#line 14760 ""
- s_wsfi(&ici__1);
-#line 14760 ""
- do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
-#line 14760 ""
- do_fio(&c__1, "}", (ftnlen)1);
-#line 14760 ""
- e_wsfi();
-#line 14761 ""
- } else {
-#line 14762 ""
- lhead += 4;
-#line 14763 ""
- i__1 = lhead - 4;
-#line 14763 ""
- ici__1.icierr = 0;
-#line 14763 ""
- ici__1.icirnum = 1;
-#line 14763 ""
- ici__1.icirlen = lhead - i__1;
-#line 14763 ""
- ici__1.iciunit = hdlndq + i__1;
-#line 14763 ""
- ici__1.icifmt = "(i3,a1)";
-#line 14763 ""
- s_wsfi(&ici__1);
-#line 14763 ""
- do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
-#line 14763 ""
- do_fio(&c__1, "}", (ftnlen)1);
-#line 14763 ""
- e_wsfi();
-#line 14764 ""
- }
-/* Writing concatenation */
-#line 14765 ""
- i__6[0] = lhead, a__3[0] = hdlndq;
-#line 14765 ""
- i__1 = ipg1r + 48;
-#line 14765 ""
- chax_(ch__1, (ftnlen)1, &i__1);
-#line 14765 ""
- i__6[1] = 1, a__3[1] = ch__1;
-#line 14765 ""
- i__6[2] = 1, a__3[2] = "{";
-#line 14765 ""
- s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
-#line 14766 ""
- lhead += 2;
-/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */
-#line 14768 ""
- if (ltopnam == 0) {
-#line 14769 ""
- if (comlast_1.islast) {
-#line 14769 ""
- s_wsfe(&io___853);
-/* Writing concatenation */
-#line 14769 ""
- i__5[0] = lhead, a__2[0] = hdlndq;
-#line 14769 ""
- i__5[1] = 3, a__2[1] = "}}%";
-#line 14769 ""
- s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62);
-#line 14769 ""
- do_fio(&c__1, ch__17, lhead + 3);
-#line 14769 ""
- e_wsfe();
-#line 14769 ""
+#line 14737 ""
+ ici__1.icierr = 0;
+#line 14737 ""
+ ici__1.icirnum = 1;
+#line 14737 ""
+ ici__1.icirlen = 1;
+#line 14737 ""
+ ici__1.iciunit = hdlndq + (lhead - 1);
+#line 14737 ""
+ ici__1.icifmt = "(i1)";
+#line 14737 ""
+ s_wsfi(&ici__1);
+#line 14737 ""
+ do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14737 ""
+ e_wsfi();
+#line 14738 ""
+ } else if (npg1 < 100) {
+#line 14739 ""
+ lhead += 3;
+#line 14740 ""
+ i__1 = lhead - 3;
+#line 14740 ""
+ ici__1.icierr = 0;
+#line 14740 ""
+ ici__1.icirnum = 1;
+#line 14740 ""
+ ici__1.icirlen = lhead - i__1;
+#line 14740 ""
+ ici__1.iciunit = hdlndq + i__1;
+#line 14740 ""
+ ici__1.icifmt = "(i2,a1)";
+#line 14740 ""
+ s_wsfi(&ici__1);
+#line 14740 ""
+ do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14740 ""
+ do_fio(&c__1, "}", (ftnlen)1);
+#line 14740 ""
+ e_wsfi();
+#line 14741 ""
+ } else {
+#line 14742 ""
+ lhead += 4;
+#line 14743 ""
+ i__1 = lhead - 4;
+#line 14743 ""
+ ici__1.icierr = 0;
+#line 14743 ""
+ ici__1.icirnum = 1;
+#line 14743 ""
+ ici__1.icirlen = lhead - i__1;
+#line 14743 ""
+ ici__1.iciunit = hdlndq + i__1;
+#line 14743 ""
+ ici__1.icifmt = "(i3,a1)";
+#line 14743 ""
+ s_wsfi(&ici__1);
+#line 14743 ""
+ do_fio(&c__1, (char *)&npg1, (ftnlen)sizeof(integer));
+#line 14743 ""
+ do_fio(&c__1, "}", (ftnlen)1);
+#line 14743 ""
+ e_wsfi();
+#line 14744 ""
}
-#line 14770 ""
- } else {
-#line 14771 ""
- if (comlast_1.islast) {
-#line 14771 ""
- s_wsfe(&io___854);
/* Writing concatenation */
-#line 14771 ""
- i__6[0] = lhead, a__3[0] = hdlndq;
-#line 14771 ""
- i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq;
-#line 14771 ""
- i__6[2] = 3, a__3[2] = "}}%";
-#line 14771 ""
- s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122);
-#line 14771 ""
- do_fio(&c__1, ch__18, lhead + ltopnam + 3);
-#line 14771 ""
- e_wsfe();
-#line 14771 ""
+#line 14745 ""
+ i__6[0] = lhead, a__3[0] = hdlndq;
+#line 14745 ""
+ i__1 = ipg1r + 48;
+#line 14745 ""
+ chax_(ch__1, (ftnlen)1, &i__1);
+#line 14745 ""
+ i__6[1] = 1, a__3[1] = ch__1;
+#line 14745 ""
+ i__6[2] = 1, a__3[2] = "{";
+#line 14745 ""
+ s_cat(hdlndq, a__3, i__6, &c__3, (ftnlen)59);
+#line 14746 ""
+ lhead += 2;
+/* if (ipage.gt.1 .or. nsystp(1).gt.1) then */
+#line 14748 ""
+ if (ltopnam == 0) {
+#line 14749 ""
+ if (comlast_1.islast) {
+#line 14749 ""
+ s_wsfe(&io___852);
+/* Writing concatenation */
+#line 14749 ""
+ i__5[0] = lhead, a__2[0] = hdlndq;
+#line 14749 ""
+ i__5[1] = 3, a__2[1] = "}}%";
+#line 14749 ""
+ s_cat(ch__17, a__2, i__5, &c__2, (ftnlen)62);
+#line 14749 ""
+ do_fio(&c__1, ch__17, lhead + 3);
+#line 14749 ""
+ e_wsfe();
+#line 14749 ""
+ }
+#line 14750 ""
+ } else {
+#line 14751 ""
+ if (comlast_1.islast) {
+#line 14751 ""
+ s_wsfe(&io___853);
+/* Writing concatenation */
+#line 14751 ""
+ i__6[0] = lhead, a__3[0] = hdlndq;
+#line 14751 ""
+ i__6[1] = ltopnam, a__3[1] = comtrans_1.cheadq;
+#line 14751 ""
+ i__6[2] = 3, a__3[2] = "}}%";
+#line 14751 ""
+ s_cat(ch__18, a__3, i__6, &c__3, (ftnlen)122);
+#line 14751 ""
+ do_fio(&c__1, ch__18, lhead + ltopnam + 3);
+#line 14751 ""
+ e_wsfe();
+#line 14751 ""
+ }
+#line 14753 ""
}
-#line 14773 ""
- }
/* else */
/* if (ltopnam .eq. 0) then */
/* if (islast) write(11,'(a)')hdlndq(1:lhead)//'}%' */
@@ -35023,1009 +35233,1036 @@ L36:
/* * write(11,'(a)')hdlndq(1:lhead)//cheadq(1:ltopnam)//'}%' */
/* end if */
/* end if */
-#line 14782 ""
- } else if (*(unsigned char *)charq == 'W') {
+#line 14762 ""
+ } else if (*(unsigned char *)charq == 'W') {
/* Just eat the number that must follow, it was used in pmxa */
+#line 14766 ""
+ ++all_1.iccount;
+#line 14767 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
+ 1);
+#line 14768 ""
+ } else if (*(unsigned char *)charq == 'T') {
+#line 14769 ""
+ comtitl_1.headlog = TRUE_;
+#line 14770 ""
+ comtitl_1.inhead = 0;
+#line 14771 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14772 ""
+ if (*(unsigned char *)durq == 'i') {
+#line 14773 ""
+ getbuf_(comtitl_1.instrq, (ftnlen)120);
+
+/* A kluge for parts from separate score file for later movements. */
+
+#line 14777 ""
+ if (*(unsigned char *)comtitl_1.instrq == ' ') {
+#line 14777 ""
+ comtitl_1.headlog = FALSE_;
+#line 14777 ""
+ }
+#line 14778 ""
+ s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (
+ ftnlen)60);
+#line 14779 ""
+ } else if (*(unsigned char *)durq == 't') {
+#line 14780 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+
+/* Optionally can include extra vertical \internotes above inbothd */
+
+#line 14784 ""
+ if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) {
+#line 14785 ""
+ ipm = 1;
#line 14786 ""
- ++all_1.iccount;
-#line 14787 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 14788 ""
- } else if (*(unsigned char *)charq == 'T') {
-#line 14789 ""
- comtitl_1.headlog = TRUE_;
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
+
+/* Don't trust readnum to round this negative integer properly */
+
#line 14790 ""
- comtitl_1.inhead = 0;
+ ++all_1.iccount;
#line 14791 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (*(unsigned char *)durq == '-') {
+#line 14791 ""
+ ipm = -1;
+#line 14791 ""
+ }
#line 14792 ""
- if (*(unsigned char *)durq == 'i') {
+ }
#line 14793 ""
- getbuf_(comtitl_1.instrq, (ftnlen)120);
-
-/* A kluge for parts from separate score file for later movements. */
-
-#line 14797 ""
- if (*(unsigned char *)comtitl_1.instrq == ' ') {
-#line 14797 ""
- comtitl_1.headlog = FALSE_;
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
+#line 14794 ""
+ comtitl_1.inhead = ipm * i_nint(&fnum);
+#line 14795 ""
+ }
+#line 14796 ""
+ getbuf_(comtitl_1.titleq, (ftnlen)120);
#line 14797 ""
- }
+ } else {
#line 14798 ""
- s_copy(comtrans_1.cheadq, comtitl_1.instrq, (ftnlen)60, (ftnlen)
- 60);
+ getbuf_(comtitl_1.compoq, (ftnlen)120);
#line 14799 ""
- } else if (*(unsigned char *)durq == 't') {
+ }
#line 14800 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ comtitl_1.inhead += cominbot_1.inbothd;
+#line 14801 ""
+ all_1.iccount = 128;
+#line 14802 ""
+ } else if (*(unsigned char *)charq == 'A') {
-/* Optionally can include extra vertical \internotes above inbothd */
+/* Accidental handling etc. */
-#line 14804 ""
- if (i_indx("-+0123456789", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 14805 ""
- ipm = 1;
#line 14806 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-
-/* Don't trust readnum to round this negative integer properly */
-
+L27:
+#line 14806 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14807 ""
+ if (*(unsigned char *)durq == 'r') {
+#line 14808 ""
+ if (comlast_1.islast) {
+#line 14809 ""
+ commidi_1.relacc = TRUE_;
#line 14810 ""
- ++all_1.iccount;
-#line 14811 ""
- if (*(unsigned char *)durq == '-') {
-#line 14811 ""
- ipm = -1;
+ s_wsfe(&io___854);
+/* Writing concatenation */
+#line 14810 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14810 ""
+ i__5[1] = 14, a__2[1] = "relativeaccid%";
+#line 14810 ""
+ s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15);
+#line 14810 ""
+ do_fio(&c__1, ch__19, (ftnlen)15);
+#line 14810 ""
+ e_wsfe();
#line 14811 ""
- }
-#line 14812 ""
}
+#line 14812 ""
+ } else if (*(unsigned char *)durq == 's') {
#line 14813 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
- ftnlen)1);
+ spfacs_1.bacfac = 1e6f;
#line 14814 ""
- comtitl_1.inhead = ipm * i_nint(&fnum);
+ } else if (*(unsigned char *)durq == 'b') {
#line 14815 ""
- }
+ if (comlast_1.islast) {
+#line 14815 ""
+ s_wsfe(&io___855);
+/* Writing concatenation */
+#line 14815 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14815 ""
+ i__5[1] = 9, a__2[1] = "bigaccid%";
+#line 14815 ""
+ s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14815 ""
+ do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14815 ""
+ e_wsfe();
+#line 14815 ""
+ }
#line 14816 ""
- getbuf_(comtitl_1.titleq, (ftnlen)120);
+ spfacs_1.accfac = spfacs_1.bacfac;
#line 14817 ""
- } else {
+ } else if (*(unsigned char *)durq == 'a') {
#line 14818 ""
- getbuf_(comtitl_1.compoq, (ftnlen)120);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14819 ""
- }
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
#line 14820 ""
- comtitl_1.inhead += cominbot_1.inbothd;
+ --all_1.iccount;
#line 14821 ""
- all_1.iccount = 128;
+ } else if (*(unsigned char *)durq == 'i') {
#line 14822 ""
- } else if (*(unsigned char *)charq == 'A') {
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+#line 14823 ""
+ readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, (
+ ftnlen)1);
+#line 14824 ""
+ if (! all_1.firstgulp) {
+#line 14824 ""
+ comget_1.fintstf = tintstf;
+#line 14824 ""
+ }
-/* Accidental handling etc. */
+/* Local corrections for first page were handled by pmxa */
-#line 14826 ""
-L27:
-#line 14826 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14827 ""
- if (*(unsigned char *)durq == 'r') {
#line 14828 ""
- if (comlast_1.islast) {
+ --all_1.iccount;
#line 14829 ""
- commidi_1.relacc = TRUE_;
-#line 14830 ""
- s_wsfe(&io___855);
-/* Writing concatenation */
-#line 14830 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14830 ""
- i__5[1] = 14, a__2[1] = "relativeaccid%";
-#line 14830 ""
- s_cat(ch__19, a__2, i__5, &c__2, (ftnlen)15);
-#line 14830 ""
- do_fio(&c__1, ch__19, (ftnlen)15);
+ } else if (*(unsigned char *)durq == 'I') {
#line 14830 ""
- e_wsfe();
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14831 ""
- }
+ readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (
+ ftnlen)128, (ftnlen)1);
#line 14832 ""
- } else if (*(unsigned char *)durq == 's') {
+ --all_1.iccount;
#line 14833 ""
- spfacs_1.bacfac = 1e6f;
+ } else if (*(unsigned char *)durq == 'd') {
#line 14834 ""
- } else if (*(unsigned char *)durq == 'b') {
-#line 14835 ""
- if (comlast_1.islast) {
-#line 14835 ""
- s_wsfe(&io___856);
-/* Writing concatenation */
-#line 14835 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
+ comarp_1.lowdot = TRUE_;
#line 14835 ""
- i__5[1] = 9, a__2[1] = "bigaccid%";
-#line 14835 ""
- s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
-#line 14835 ""
- do_fio(&c__1, ch__3, (ftnlen)10);
-#line 14835 ""
- e_wsfe();
-#line 14835 ""
- }
-#line 14836 ""
- spfacs_1.accfac = spfacs_1.bacfac;
+ } else if (*(unsigned char *)durq == 'o') {
#line 14837 ""
- } else if (*(unsigned char *)durq == 'a') {
+ } else if (*(unsigned char *)durq == 'S') {
#line 14838 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ i__1 = comkeys_2.noinst;
+#line 14838 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
#line 14839 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
#line 14840 ""
- --all_1.iccount;
+ if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) {
#line 14841 ""
- } else if (*(unsigned char *)durq == 'i') {
+ comfig_1.fullsize[iiv - 1] = .8f;
#line 14842 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ } else if (*(unsigned char *)durq == 't') {
#line 14843 ""
- readnum_(lineq, &all_1.iccount, durq, &tintstf, (ftnlen)128, (
- ftnlen)1);
-#line 14844 ""
- if (! all_1.firstgulp) {
+ comfig_1.fullsize[iiv - 1] = .64f;
#line 14844 ""
- comget_1.fintstf = tintstf;
-#line 14844 ""
- }
-
-/* Local corrections for first page were handled by pmxa */
-
+ } else {
+/* fullsize(ivx) = 1.0 */
+#line 14846 ""
+ comfig_1.fullsize[iiv - 1] = 1.f;
+#line 14847 ""
+ }
+#line 14848 ""
+/* L50: */
#line 14848 ""
- --all_1.iccount;
+ }
#line 14849 ""
- } else if (*(unsigned char *)durq == 'I') {
-#line 14850 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14851 ""
- readnum_(lineq, &all_1.iccount, durq, &comget_1.gintstf, (ftnlen)
- 128, (ftnlen)1);
-#line 14852 ""
- --all_1.iccount;
+ } else if (*(unsigned char *)durq == 'e') {
+
+/* Line-spacing equalization */
+
#line 14853 ""
- } else if (*(unsigned char *)durq == 'd') {
-#line 14854 ""
- comarp_1.lowdot = TRUE_;
-#line 14855 ""
- } else if (*(unsigned char *)durq == 'o') {
-#line 14857 ""
- } else if (*(unsigned char *)durq == 'S') {
-#line 14858 ""
- i__1 = comkeys_2.noinst;
-#line 14858 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
+ comget_1.equalize = TRUE_;
+
+/* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */
+/* But it causes problems with some older scores and when excerpts are combined */
+/* with LaTeX. So as of 2.352 we write it here. */
+
#line 14859 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 14860 ""
- if (i_indx("-s", durq, (ftnlen)2, (ftnlen)1) > 0) {
+ s_wsfe(&io___857);
+/* Writing concatenation */
+#line 14859 ""
+ i__8[0] = 1, a__5[0] = all_1.sq;
+#line 14859 ""
+ i__8[1] = 6, a__5[1] = "global";
+#line 14859 ""
+ i__8[2] = 1, a__5[2] = all_1.sq;
+#line 14859 ""
+ i__8[3] = 19, a__5[3] = "parskip 0pt plus 12";
+#line 14859 ""
+ i__8[4] = 1, a__5[4] = all_1.sq;
+#line 14859 ""
+ i__8[5] = 19, a__5[5] = "Interligne minus 99";
+#line 14859 ""
+ i__8[6] = 1, a__5[6] = all_1.sq;
+#line 14859 ""
+ i__8[7] = 11, a__5[7] = "Interligne%";
+#line 14859 ""
+ s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59);
+#line 14859 ""
+ do_fio(&c__1, ch__20, (ftnlen)59);
+#line 14859 ""
+ e_wsfe();
#line 14861 ""
- comfig_1.fullsize[iiv - 1] = .8f;
+ s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1);
#line 14862 ""
- } else if (*(unsigned char *)durq == 't') {
+ lentemp = 1;
+#line 14863 ""
+ i__1 = all_1.nv - 1;
#line 14863 ""
- comfig_1.fullsize[iiv - 1] = .64f;
+ for (iiv = 2; iiv <= i__1; ++iiv) {
+/* Writing concatenation */
#line 14864 ""
- } else {
-/* fullsize(ivx) = 1.0 */
+ i__5[0] = lentemp, a__2[0] = tempq;
+#line 14864 ""
+ i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1);
+#line 14864 ""
+ s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24);
+#line 14865 ""
+ ++lentemp;
+#line 14866 ""
+/* L51: */
#line 14866 ""
- comfig_1.fullsize[iiv - 1] = 1.f;
-#line 14867 ""
}
-#line 14868 ""
-/* L50: */
-#line 14868 ""
- }
-#line 14869 ""
- } else if (*(unsigned char *)durq == 'e') {
+#line 14867 ""
+ s_wsfe(&io___860);
+/* Writing concatenation */
+#line 14867 ""
+ i__9[0] = 1, a__6[0] = all_1.sq;
+#line 14867 ""
+ i__9[1] = 3, a__6[1] = "def";
+#line 14867 ""
+ i__9[2] = 1, a__6[2] = all_1.sq;
+#line 14867 ""
+ i__9[3] = 8, a__6[3] = "upstrut{";
+#line 14867 ""
+ i__9[4] = 1, a__6[4] = all_1.sq;
+#line 14867 ""
+ i__9[5] = 6, a__6[5] = "znotes";
+#line 14867 ""
+ i__9[6] = lentemp, a__6[6] = tempq;
+#line 14867 ""
+ i__9[7] = 1, a__6[7] = all_1.sq;
+#line 14867 ""
+ i__9[8] = 10, a__6[8] = "zcharnote{";
+#line 14867 ""
+ i__9[9] = 1, a__6[9] = all_1.sq;
+#line 14867 ""
+ i__9[10] = 9, a__6[10] = "upamt}{~}";
+#line 14867 ""
+ i__9[11] = 1, a__6[11] = all_1.sq;
+#line 14867 ""
+ i__9[12] = 4, a__6[12] = "en}%";
+#line 14867 ""
+ s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70);
+#line 14867 ""
+ do_fio(&c__1, ch__21, lentemp + 46);
+#line 14867 ""
+ e_wsfe();
+#line 14870 ""
+ } else if (*(unsigned char *)durq == 'v') {
-/* Line-spacing equalization */
+/* Toggle usevshrink */
-#line 14873 ""
- comget_1.equalize = TRUE_;
+#line 14874 ""
+ comlast_1.usevshrink = ! comlast_1.usevshrink;
+#line 14875 ""
+ } else if (*(unsigned char *)durq == 'p') {
-/* The following redefinition of \parskip was put into pmx.tex in version 2.25 or so. */
-/* But it causes problems with some older scores and when excerpts are combined */
-/* with LaTeX. So as of 2.352 we write it here. */
+/* Postscript slurs. fontslur is already false (set in g1etnote) */
#line 14879 ""
- s_wsfe(&io___858);
+ if (! comslur_1.wrotepsslurdefaults) {
+
+/* Set postscrirpt slur adjustment defaults */
+
+#line 14883 ""
+ s_wsfe(&io___861);
/* Writing concatenation */
-#line 14879 ""
- i__8[0] = 1, a__5[0] = all_1.sq;
-#line 14879 ""
- i__8[1] = 6, a__5[1] = "global";
-#line 14879 ""
- i__8[2] = 1, a__5[2] = all_1.sq;
-#line 14879 ""
- i__8[3] = 19, a__5[3] = "parskip 0pt plus 12";
-#line 14879 ""
- i__8[4] = 1, a__5[4] = all_1.sq;
-#line 14879 ""
- i__8[5] = 19, a__5[5] = "Interligne minus 99";
-#line 14879 ""
- i__8[6] = 1, a__5[6] = all_1.sq;
-#line 14879 ""
- i__8[7] = 11, a__5[7] = "Interligne%";
-#line 14879 ""
- s_cat(ch__20, a__5, i__8, &c__8, (ftnlen)59);
-#line 14879 ""
- do_fio(&c__1, ch__20, (ftnlen)59);
-#line 14879 ""
- e_wsfe();
-#line 14881 ""
- s_copy(tempq, all_1.sepsymq, (ftnlen)24, (ftnlen)1);
-#line 14882 ""
- lentemp = 1;
#line 14883 ""
- i__1 = all_1.nv - 1;
+ i__7[0] = 1, a__4[0] = all_1.sq;
+#line 14883 ""
+ i__7[1] = 12, a__4[1] = "Nosluradjust";
+#line 14883 ""
+ i__7[2] = 1, a__4[2] = all_1.sq;
+#line 14883 ""
+ i__7[3] = 11, a__4[3] = "Notieadjust";
#line 14883 ""
- for (iiv = 2; iiv <= i__1; ++iiv) {
-/* Writing concatenation */
-#line 14884 ""
- i__5[0] = lentemp, a__2[0] = tempq;
-#line 14884 ""
- i__5[1] = 1, a__2[1] = all_1.sepsymq + (iiv - 1);
-#line 14884 ""
- s_cat(tempq, a__2, i__5, &c__2, (ftnlen)24);
+ i__7[4] = 1, a__4[4] = all_1.sq;
+#line 14883 ""
+ i__7[5] = 10, a__4[5] = "nohalfties";
+#line 14883 ""
+ s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36);
+#line 14883 ""
+ do_fio(&c__1, ch__22, (ftnlen)36);
+#line 14883 ""
+ e_wsfe();
#line 14885 ""
- ++lentemp;
-#line 14886 ""
-/* L51: */
+ comslur_1.wrotepsslurdefaults = TRUE_;
#line 14886 ""
- }
-#line 14887 ""
- s_wsfe(&io___861);
-/* Writing concatenation */
-#line 14887 ""
- i__9[0] = 1, a__6[0] = all_1.sq;
-#line 14887 ""
- i__9[1] = 3, a__6[1] = "def";
-#line 14887 ""
- i__9[2] = 1, a__6[2] = all_1.sq;
-#line 14887 ""
- i__9[3] = 8, a__6[3] = "upstrut{";
-#line 14887 ""
- i__9[4] = 1, a__6[4] = all_1.sq;
-#line 14887 ""
- i__9[5] = 6, a__6[5] = "znotes";
-#line 14887 ""
- i__9[6] = lentemp, a__6[6] = tempq;
-#line 14887 ""
- i__9[7] = 1, a__6[7] = all_1.sq;
-#line 14887 ""
- i__9[8] = 10, a__6[8] = "zcharnote{";
-#line 14887 ""
- i__9[9] = 1, a__6[9] = all_1.sq;
-#line 14887 ""
- i__9[10] = 9, a__6[10] = "upamt}{~}";
-#line 14887 ""
- i__9[11] = 1, a__6[11] = all_1.sq;
-#line 14887 ""
- i__9[12] = 4, a__6[12] = "en}%";
-#line 14887 ""
- s_cat(ch__21, a__6, i__9, &c__13, (ftnlen)70);
-#line 14887 ""
- do_fio(&c__1, ch__21, lentemp + 46);
+ }
#line 14887 ""
- e_wsfe();
-#line 14890 ""
- } else if (*(unsigned char *)durq == 'v') {
+L52:
+#line 14888 ""
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
+/* might be "+", "-", "h" or */
+#line 14889 ""
+ if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-/* Toggle usevshrink */
+/* Characters to change defaults for ps slurs */
+#line 14893 ""
+ g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
+ ftnlen)1);
+/* charq will be "s,t,h,c */
#line 14894 ""
- comlast_1.usevshrink = ! comlast_1.usevshrink;
+ if (*(unsigned char *)durq == '+') {
#line 14895 ""
- } else if (*(unsigned char *)durq == 'p') {
-
-/* Postscript slurs. fontslur is already false (set in g1etnote) */
-
+ if (*(unsigned char *)charq == 's') {
+#line 14896 ""
+ s_wsfe(&io___862);
+/* Writing concatenation */
+#line 14896 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14896 ""
+ i__5[1] = 10, a__2[1] = "Sluradjust";
+#line 14896 ""
+ s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+#line 14896 ""
+ do_fio(&c__1, ch__10, (ftnlen)11);
+#line 14896 ""
+ e_wsfe();
+#line 14897 ""
+ } else if (*(unsigned char *)charq == 't') {
+#line 14898 ""
+ s_wsfe(&io___863);
+/* Writing concatenation */
+#line 14898 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14898 ""
+ i__5[1] = 9, a__2[1] = "Tieadjust";
+#line 14898 ""
+ s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
+#line 14898 ""
+ do_fio(&c__1, ch__3, (ftnlen)10);
+#line 14898 ""
+ e_wsfe();
#line 14899 ""
- if (! comslur_1.wrotepsslurdefaults) {
-
-/* Set postscrirpt slur adjustment defaults */
-
-#line 14903 ""
- s_wsfe(&io___862);
+ } else if (*(unsigned char *)charq == 'h') {
+#line 14900 ""
+ s_wsfe(&io___864);
/* Writing concatenation */
+#line 14900 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14900 ""
+ i__5[1] = 8, a__2[1] = "halfties";
+#line 14900 ""
+ s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
+#line 14900 ""
+ do_fio(&c__1, ch__12, (ftnlen)9);
+#line 14900 ""
+ e_wsfe();
+#line 14901 ""
+ } else {
+#line 14902 ""
+ comslur_1.slurcurve += 1;
#line 14903 ""
- i__7[0] = 1, a__4[0] = all_1.sq;
-#line 14903 ""
- i__7[1] = 12, a__4[1] = "Nosluradjust";
-#line 14903 ""
- i__7[2] = 1, a__4[2] = all_1.sq;
-#line 14903 ""
- i__7[3] = 11, a__4[3] = "Notieadjust";
-#line 14903 ""
- i__7[4] = 1, a__4[4] = all_1.sq;
-#line 14903 ""
- i__7[5] = 10, a__4[5] = "nohalfties";
-#line 14903 ""
- s_cat(ch__22, a__4, i__7, &c__6, (ftnlen)36);
-#line 14903 ""
- do_fio(&c__1, ch__22, (ftnlen)36);
-#line 14903 ""
- e_wsfe();
+ if (comslur_1.slurcurve > 3.1f) {
+#line 14904 ""
+ printl_("WARNING!", (ftnlen)8);
#line 14905 ""
- comslur_1.wrotepsslurdefaults = TRUE_;
-#line 14906 ""
- }
+ printl_("Default slur curvature advanced pas"\
+ "t HH, resetting", (ftnlen)50);
#line 14907 ""
-L52:
+ comslur_1.slurcurve = 3.f;
#line 14908 ""
- g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-/* might be "+", "-", "h" or */
+ }
#line 14909 ""
- if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-
-/* Characters to change defaults for ps slurs */
-
+ }
+#line 14910 ""
+ } else {
+#line 14911 ""
+ if (*(unsigned char *)charq == 's') {
+#line 14912 ""
+ s_wsfe(&io___865);
+/* Writing concatenation */
+#line 14912 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14912 ""
+ i__5[1] = 12, a__2[1] = "Nosluradjust";
+#line 14912 ""
+ s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13);
+#line 14912 ""
+ do_fio(&c__1, ch__4, (ftnlen)13);
+#line 14912 ""
+ e_wsfe();
#line 14913 ""
- g1etchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)
- 1);
-/* charq will be "s,t,h,c */
+ } else if (*(unsigned char *)charq == 't') {
#line 14914 ""
- if (*(unsigned char *)durq == '+') {
+ s_wsfe(&io___866);
+/* Writing concatenation */
+#line 14914 ""
+ i__5[0] = 1, a__2[0] = all_1.sq;
+#line 14914 ""
+ i__5[1] = 11, a__2[1] = "Notieadjust";
+#line 14914 ""
+ s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
+#line 14914 ""
+ do_fio(&c__1, ch__2, (ftnlen)12);
+#line 14914 ""
+ e_wsfe();
#line 14915 ""
- if (*(unsigned char *)charq == 's') {
+ } else if (*(unsigned char *)charq == 'h') {
#line 14916 ""
- s_wsfe(&io___863);
+ s_wsfe(&io___867);
/* Writing concatenation */
#line 14916 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
+ i__5[0] = 1, a__2[0] = all_1.sq;
#line 14916 ""
- i__5[1] = 10, a__2[1] = "Sluradjust";
+ i__5[1] = 10, a__2[1] = "nohalfties";
#line 14916 ""
- s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
+ s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
#line 14916 ""
- do_fio(&c__1, ch__10, (ftnlen)11);
+ do_fio(&c__1, ch__10, (ftnlen)11);
#line 14916 ""
- e_wsfe();
+ e_wsfe();
#line 14917 ""
- } else if (*(unsigned char *)charq == 't') {
-#line 14918 ""
- s_wsfe(&io___864);
-/* Writing concatenation */
-#line 14918 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14918 ""
- i__5[1] = 9, a__2[1] = "Tieadjust";
-#line 14918 ""
- s_cat(ch__3, a__2, i__5, &c__2, (ftnlen)10);
-#line 14918 ""
- do_fio(&c__1, ch__3, (ftnlen)10);
+ } else {
#line 14918 ""
- e_wsfe();
+ comslur_1.slurcurve += -1;
#line 14919 ""
- } else if (*(unsigned char *)charq == 'h') {
+ if (comslur_1.slurcurve < -1.1f) {
#line 14920 ""
- s_wsfe(&io___865);
-/* Writing concatenation */
-#line 14920 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14920 ""
- i__5[1] = 8, a__2[1] = "halfties";
-#line 14920 ""
- s_cat(ch__12, a__2, i__5, &c__2, (ftnlen)9);
-#line 14920 ""
- do_fio(&c__1, ch__12, (ftnlen)9);
-#line 14920 ""
- e_wsfe();
+ printl_("WARNING!", (ftnlen)8);
#line 14921 ""
- } else {
-#line 14922 ""
- comslur_1.slurcurve += 1;
+ printl_("Default slur curvature decremented "\
+ "below f, resetting", (ftnlen)53);
#line 14923 ""
- if (comslur_1.slurcurve > 3.1f) {
+ comslur_1.slurcurve = -1.f;
#line 14924 ""
- printl_("WARNING!", (ftnlen)8);
+ }
#line 14925 ""
- printl_("Default slur curvature advanced past HH"\
- ", resetting", (ftnlen)50);
-#line 14927 ""
- comslur_1.slurcurve = 3.f;
-#line 14928 ""
}
-#line 14929 ""
+#line 14926 ""
}
-#line 14930 ""
- } else {
-#line 14931 ""
- if (*(unsigned char *)charq == 's') {
-#line 14932 ""
- s_wsfe(&io___866);
-/* Writing concatenation */
-#line 14932 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14932 ""
- i__5[1] = 12, a__2[1] = "Nosluradjust";
-#line 14932 ""
- s_cat(ch__4, a__2, i__5, &c__2, (ftnlen)13);
-#line 14932 ""
- do_fio(&c__1, ch__4, (ftnlen)13);
+#line 14927 ""
+ goto L52;
+/* Check for another set of default changes */
+#line 14928 ""
+ } else if (*(unsigned char *)durq == 'l') {
+
+/* Set optional linebreak ties */
+
#line 14932 ""
- e_wsfe();
+ comnotes_1.optlinebreakties = TRUE_;
#line 14933 ""
- } else if (*(unsigned char *)charq == 't') {
-#line 14934 ""
- s_wsfe(&io___867);
-/* Writing concatenation */
-#line 14934 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
+ goto L52;
#line 14934 ""
- i__5[1] = 11, a__2[1] = "Notieadjust";
-#line 14934 ""
- s_cat(ch__2, a__2, i__5, &c__2, (ftnlen)12);
-#line 14934 ""
- do_fio(&c__1, ch__2, (ftnlen)12);
-#line 14934 ""
- e_wsfe();
-#line 14935 ""
- } else if (*(unsigned char *)charq == 'h') {
-#line 14936 ""
- s_wsfe(&io___868);
-/* Writing concatenation */
-#line 14936 ""
- i__5[0] = 1, a__2[0] = all_1.sq;
-#line 14936 ""
- i__5[1] = 10, a__2[1] = "nohalfties";
-#line 14936 ""
- s_cat(ch__10, a__2, i__5, &c__2, (ftnlen)11);
-#line 14936 ""
- do_fio(&c__1, ch__10, (ftnlen)11);
-#line 14936 ""
- e_wsfe();
-#line 14937 ""
- } else {
+ } else if (*(unsigned char *)durq == 'h') {
+
+/* Set flag to write header special on every page */
+
#line 14938 ""
- comslur_1.slurcurve += -1;
+ comnotes_1.headerspecial = TRUE_;
#line 14939 ""
- if (comslur_1.slurcurve < -1.1f) {
+ goto L52;
#line 14940 ""
- printl_("WARNING!", (ftnlen)8);
+ } else {
#line 14941 ""
- printl_("Default slur curvature decremented belo"\
- "w f, resetting", (ftnlen)53);
-#line 14943 ""
- comslur_1.slurcurve = -1.f;
-#line 14944 ""
- }
-#line 14945 ""
- }
-#line 14946 ""
+ --all_1.iccount;
+#line 14942 ""
}
+#line 14943 ""
+ } else if (*(unsigned char *)durq == 'K') {
+
+/* Toggle keyboard rest placement flag */
+
#line 14947 ""
- goto L52;
-/* Check for another set of default changes */
+ comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests;
#line 14948 ""
- } else if (*(unsigned char *)durq == 'l') {
+ } else if (*(unsigned char *)durq == 'c') {
+#line 14949 ""
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
-/* Set optional linebreak ties */
+/* Just eat the input; it was used in pmxa */
-#line 14952 ""
- comnotes_1.optlinebreakties = TRUE_;
#line 14953 ""
- goto L52;
+ goto L27;
#line 14954 ""
- } else if (*(unsigned char *)durq == 'h') {
-
-/* Set flag to write header special on every page */
-
+ } else if (*(unsigned char *)durq == 'V') {
+#line 14955 ""
+ combottop_1.bottopgap = TRUE_;
+#line 14956 ""
+ combottop_1.topamt = 0.f;
+#line 14957 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14958 ""
- comnotes_1.headerspecial = TRUE_;
+ pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2)
+ ;
#line 14959 ""
- goto L52;
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
#line 14960 ""
- } else {
+ readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, (
+ ftnlen)128, (ftnlen)1);
#line 14961 ""
- --all_1.iccount;
+ combottop_1.botamt *= pmfac;
#line 14962 ""
- }
+ pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2)
+ ;
#line 14963 ""
- } else if (*(unsigned char *)durq == 'K') {
-
-/* Toggle keyboard rest placement flag */
-
+ g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1)
+ ;
+#line 14964 ""
+ readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, (
+ ftnlen)128, (ftnlen)1);
+#line 14965 ""
+ combottop_1.topamt *= pmfac;
+#line 14966 ""
+ --all_1.iccount;
#line 14967 ""
- comkbdrests_1.kbdrests = ! comkbdrests_1.kbdrests;
+ goto L27;
#line 14968 ""
- } else if (*(unsigned char *)durq == 'c') {
+ }
#line 14969 ""
- g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) {
-/* Just eat the input; it was used in pmxa */
+/* Override default part names for scor2prt, or normal include file. */
+/* Just bypass rest of input line */
-#line 14973 ""
- goto L27;
#line 14974 ""
- } else if (*(unsigned char *)durq == 'V') {
+ all_1.iccount = 128;
#line 14975 ""
- combottop_1.bottopgap = TRUE_;
+ } else if (*(unsigned char *)durq != ' ') {
#line 14976 ""
- combottop_1.topamt = 0.f;
+ goto L27;
#line 14977 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ }
#line 14978 ""
- pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2);
+ } else if (*(unsigned char *)charq == 'K') {
#line 14979 ""
- g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+L77:
#line 14980 ""
- readnum_(lineq, &all_1.iccount, durq, &combottop_1.botamt, (
- ftnlen)128, (ftnlen)1);
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
#line 14981 ""
- combottop_1.botamt *= pmfac;
+ if (*(unsigned char *)durq == 'n') {
#line 14982 ""
- pmfac = (real) (i_indx("- +", durq, (ftnlen)3, (ftnlen)1) - 2);
+ comignorenats_1.ignorenats = TRUE_;
#line 14983 ""
- g1etchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ goto L77;
#line 14984 ""
- readnum_(lineq, &all_1.iccount, durq, &combottop_1.topamt, (
- ftnlen)128, (ftnlen)1);
+ }
#line 14985 ""
- combottop_1.topamt *= pmfac;
-#line 14986 ""
- --all_1.iccount;
-#line 14987 ""
- goto L27;
-#line 14988 ""
- }
+ if (*(unsigned char *)durq != 'i') {
+
+/* Normal, full-score key change and/or transposition */
+
#line 14989 ""
- if (i_indx("NR", durq, (ftnlen)2, (ftnlen)1) > 0) {
+ num1 = 44 - *(unsigned char *)durq;
+#line 14990 ""
+ ++all_1.iccount;
+#line 14991 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (
+ ftnlen)1);
+#line 14992 ""
+ num1 *= i_nint(&fnum);
-/* Override default part names for scor2prt, or normal include file. */
-/* Just bypass rest of input line */
+/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */
-#line 14994 ""
- all_1.iccount = 128;
-#line 14995 ""
- } else if (*(unsigned char *)durq != ' ') {
#line 14996 ""
- goto L27;
+ ++all_1.iccount;
#line 14997 ""
- }
+ readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
+ ftnlen)1);
#line 14998 ""
- } else if (*(unsigned char *)charq == 'K') {
+ if (commidi_1.ismidi) {
#line 14999 ""
-L77:
+ commidisig_1.midisig = i_nint(&fnum);
#line 15000 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15001 ""
- if (*(unsigned char *)durq == 'n') {
+ if (*(unsigned char *)durq == '-') {
+#line 15000 ""
+ commidisig_1.midisig = -commidisig_1.midisig;
+#line 15000 ""
+ }
+/* 130317 */
#line 15002 ""
- comignorenats_1.ignorenats = TRUE_;
+ commidisig_1.midisig += comtop_1.idsig;
#line 15003 ""
- goto L77;
-#line 15004 ""
- }
+ midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1);
#line 15005 ""
- if (*(unsigned char *)durq != 'i') {
+ }
+/* 70 continue */
+#line 15007 ""
+ if (num1 == 0) {
-/* Normal, full-score key change and/or transposition */
+/* Key change, not transposition. */
-#line 15009 ""
- num1 = 44 - *(unsigned char *)durq;
-#line 15010 ""
- ++all_1.iccount;
#line 15011 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+ all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1)
+ * 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28);
#line 15012 ""
- num1 *= i_nint(&fnum);
-
-/* On exit, durq='+','-'. But only need isig if after start, else done in pmxa */
-
+ comtop_1.lastisig = comtop_1.isig;
+#line 15013 ""
+ comtop_1.isig = i_nint(&fnum);
+#line 15014 ""
+ if (*(unsigned char *)durq == '-') {
+#line 15014 ""
+ comtop_1.isig = -comtop_1.isig;
+#line 15014 ""
+ }
+#line 15015 ""
+ comtop_1.isig += comtop_1.idsig;
#line 15016 ""
- ++all_1.iccount;
+ if (commidi_1.ismidi) {
+#line 15016 ""
+ midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1);
+#line 15016 ""
+ }
#line 15017 ""
- readnum_(lineq, &all_1.iccount, charq, &fnum, (ftnlen)128, (
- ftnlen)1);
-#line 15018 ""
- if (commidi_1.ismidi) {
-#line 15019 ""
- commidisig_1.midisig = i_nint(&fnum);
-#line 15020 ""
- if (*(unsigned char *)durq == '-') {
-#line 15020 ""
- commidisig_1.midisig = -commidisig_1.midisig;
-#line 15020 ""
- }
-/* 130317 */
-#line 15022 ""
- commidisig_1.midisig += comtop_1.idsig;
+ } else {
+
+/* num1 .ne. 0, so transposition, so must be at beginning. isig came with K... */
+/* but was passed to pmxb through pmxtex.dat. isig0 comes from setup data */
+/* (signature before transposition). idsig must be added to future key changes. */
+
#line 15023 ""
- midievent_("k", &commidisig_1.midisig, &c__0, (ftnlen)1);
+ jv = 0;
+#line 15024 ""
+ while(jv < 24) {
#line 15025 ""
- }
-/* 70 continue */
+ ++jv;
+#line 15026 ""
+ cominsttrans_1.itransamt[jv - 1] = num1;
#line 15027 ""
- if (num1 == 0) {
+ }
+#line 15028 ""
+ comtop_1.idsig = comtop_1.isig - comtop_1.isig0;
+#line 15029 ""
+ }
+#line 15030 ""
+ } else {
-/* Key change, not transposition. */
+/* Instrument specific transposition. */
-#line 15031 ""
- all_1.ipl[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
- 24 - 25] = bit_set(all_1.ipl[commvl_1.ivx + (
- all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25],28);
-#line 15032 ""
- comtop_1.lastisig = comtop_1.isig;
-#line 15033 ""
- comtop_1.isig = i_nint(&fnum);
#line 15034 ""
- if (*(unsigned char *)durq == '-') {
-#line 15034 ""
- comtop_1.isig = -comtop_1.isig;
-#line 15034 ""
- }
-#line 15035 ""
- comtop_1.isig += comtop_1.idsig;
-#line 15036 ""
- if (commidi_1.ismidi) {
-#line 15036 ""
- midievent_("k", &comtop_1.isig, &c__0, (ftnlen)1);
-#line 15036 ""
- }
-#line 15037 ""
- } else {
+ getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, &
+ all_1.iccount, &ibaroff, &all_1.nbars, &
+ comkeys_2.noinst, (ftnlen)128);
-/* num1 .ne. 0, so transposition, so must be at beginning. isig came with K... */
-/* but was passed to pmxb through pmxtex.dat. isig0 comes from setup data */
-/* (signature before transposition). idsig must be added to future key changes. */
+/* The sig parameters will have been set 1st time but that's OK */
+
+#line 15039 ""
+ }
+#line 15040 ""
+ } else /* if(complicated condition) */ {
+#line 15040 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 15040 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0]) {
+#line 15041 ""
+ if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] + 1) * 24 - 1],26)) {
+
+/* There was a hardspace followed by end of block. Remove it from the hardspace */
+/* list, store with shifts instead, set special bit. This code also at '|' */
-#line 15043 ""
- jv = 0;
-#line 15044 ""
- while(jv < 24) {
-#line 15045 ""
- ++jv;
#line 15046 ""
- cominsttrans_1.itransamt[jv - 1] = num1;
+ all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
+ 24 - 25] = bit_set(all_1.irest[commvl_1.ivx +
+ all_1.nnl[commvl_1.ivx - 1] * 24 - 25],18);
#line 15047 ""
- }
+ ++comudsp_1.nudoff[commvl_1.ivx - 1];
#line 15048 ""
- comtop_1.idsig = comtop_1.isig - comtop_1.isig0;
+ comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[
+ commvl_1.ivx - 1] * 24 - 25] = comudsp_1.udsp[
+ comudsp_1.nudsp - 1];
#line 15049 ""
- }
+ --comudsp_1.nudsp;
#line 15050 ""
- } else {
+ all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] +
+ 1) * 24 - 1] = bit_clear(all_1.iornq[commvl_1.ivx
+ + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1],26);
+#line 15051 ""
+ }
+#line 15052 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-/* Instrument specific transposition. */
+/* Save ending note level: */
-#line 15054 ""
- getitransinfo_(&c_false, &combibarcnt_1.ibarcnt, lineq, &
- all_1.iccount, &ibaroff, &all_1.nbars, &comkeys_2.noinst,
- (ftnlen)128);
+#line 15056 ""
+ if (commvl_1.ivx <= all_1.nv) {
-/* The sig parameters will have been set 1st time but that's OK */
+/* This is the first line of music on this staff. If previous block had only 1 */
+/* voice, save last pitch from line 1 of prev. block to line 2, in case a */
+/* 2nd line is started just below */
-#line 15059 ""
- }
-#line 15060 ""
- } else if (*(unsigned char *)charq == '/') {
-#line 15061 ""
- if (bit_test(all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1]
- + 1) * 24 - 1],26)) {
+#line 15062 ""
+ if (! comnotes_1.was2[all_1.iv - 1]) {
+#line 15062 ""
+ comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[
+ all_1.iv - 1];
+#line 15062 ""
+ }
+#line 15063 ""
+ comnotes_1.was2[all_1.iv - 1] = FALSE_;
+#line 15064 ""
+ comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev;
+#line 15065 ""
+ } else {
-/* There was a hardspace followed by end of block. Remove it from the hardspace */
-/* list, store with shifts instead, set special bit. This code also at '|' */
+/* This is the 2nd line of music on this staff. */
-#line 15066 ""
- all_1.irest[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
- = bit_set(all_1.irest[commvl_1.ivx + all_1.nnl[
- commvl_1.ivx - 1] * 24 - 25],18);
-#line 15067 ""
- ++comudsp_1.nudoff[commvl_1.ivx - 1];
-#line 15068 ""
- comudsp_1.udoff[commvl_1.ivx + comudsp_1.nudoff[commvl_1.ivx - 1]
- * 24 - 25] = comudsp_1.udsp[comudsp_1.nudsp - 1];
#line 15069 ""
- --comudsp_1.nudsp;
+ comnotes_1.was2[all_1.iv - 1] = TRUE_;
#line 15070 ""
- all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) * 24
- - 1] = bit_clear(all_1.iornq[commvl_1.ivx + (all_1.nnl[
- commvl_1.ivx - 1] + 1) * 24 - 1],26);
+ comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev;
#line 15071 ""
- }
+ }
#line 15072 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
+ if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) {
-/* Save ending note level: */
+/* End of input block */
#line 15076 ""
- if (commvl_1.ivx <= all_1.nv) {
+ *loop = FALSE_;
+#line 15077 ""
+ } else {
-/* This is the first line of music on this staff. If previous block had only 1 */
-/* voice, save last pitch from line 1 of prev. block to line 2, in case a */
-/* 2nd line is started just below */
+/* Start a new line of music */
+#line 15081 ""
+ if (all_1.lenb0 != 0 && all_1.firstgulp) {
+#line 15081 ""
+ all_1.lenbar = all_1.lenb0;
+#line 15081 ""
+ }
#line 15082 ""
- if (! comnotes_1.was2[all_1.iv - 1]) {
-#line 15082 ""
- comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.ndlev[all_1.iv -
- 1];
-#line 15082 ""
- }
+ all_1.nbars = 0;
#line 15083 ""
- comnotes_1.was2[all_1.iv - 1] = FALSE_;
-#line 15084 ""
- comnotes_1.ndlev[all_1.iv - 1] = comnotes_1.lastlev;
-#line 15085 ""
- } else {
+ if (*(unsigned char *)durq == ' ') {
-/* This is the 2nd line of music on this staff. */
+/* New line of music is on next staff */
+#line 15087 ""
+ ++all_1.iv;
+#line 15088 ""
+ commvl_1.ivx = all_1.iv;
#line 15089 ""
- comnotes_1.was2[all_1.iv - 1] = TRUE_;
-#line 15090 ""
- comnotes_1.ndlev[all_1.iv + 23] = comnotes_1.lastlev;
-#line 15091 ""
- }
-#line 15092 ""
- if (*(unsigned char *)durq == ' ' && all_1.iv == all_1.nv) {
+ } else {
-/* End of input block */
+/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */
+#line 15093 ""
+ commvl_1.ivx = all_1.nv + 1;
+#line 15094 ""
+ i__1 = all_1.nv;
+#line 15094 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 15095 ""
+ if (commvl_1.nvmx[iiv - 1] == 2) {
+#line 15095 ""
+ ++commvl_1.ivx;
+#line 15095 ""
+ }
+#line 15096 ""
+/* L23: */
#line 15096 ""
- *loop = FALSE_;
+ }
#line 15097 ""
- } else {
-
-/* Start a new line of music */
-
-#line 15101 ""
- if (all_1.lenb0 != 0 && all_1.firstgulp) {
-#line 15101 ""
- all_1.lenbar = all_1.lenb0;
+ commvl_1.nvmx[all_1.iv - 1] = 2;
+#line 15098 ""
+ commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx;
+#line 15099 ""
+ all_1.itsofar[commvl_1.ivx - 1] = 0;
+#line 15100 ""
+ all_1.nnl[commvl_1.ivx - 1] = 0;
#line 15101 ""
- }
+ comfb_1.nfb[commvl_1.ivx - 1] = 0;
#line 15102 ""
- all_1.nbars = 0;
+ comudsp_1.nudoff[commvl_1.ivx - 1] = 0;
#line 15103 ""
- if (*(unsigned char *)durq == ' ') {
-
-/* New line of music is on next staff */
-
+ comcc_1.ndotmv[commvl_1.ivx - 1] = 0;
+#line 15104 ""
+ for (j = 1; j <= 200; ++j) {
+#line 15105 ""
+ all_1.irest[commvl_1.ivx + j * 24 - 25] = 0;
+#line 15106 ""
+ all_1.islur[commvl_1.ivx + j * 24 - 25] = 0;
#line 15107 ""
- ++all_1.iv;
+ all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0;
#line 15108 ""
- commvl_1.ivx = all_1.iv;
+ all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0;
#line 15109 ""
- } else {
+ all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0;
+#line 15110 ""
+ all_1.mult[commvl_1.ivx + j * 24 - 25] = 0;
+#line 15111 ""
+/* L24: */
+#line 15111 ""
+ }
-/* durq must be 2nd '/'. New line of music is on same staff. Set up for it */
+/* Go back and lower the rests in voice "a" that don't have over-ridden heights */
-#line 15113 ""
- commvl_1.ivx = all_1.nv + 1;
-#line 15114 ""
- i__1 = all_1.nv;
-#line 15114 ""
- for (iiv = 1; iiv <= i__1; ++iiv) {
-#line 15115 ""
- if (commvl_1.nvmx[iiv - 1] == 2) {
#line 15115 ""
- ++commvl_1.ivx;
+ i__1 = all_1.nnl[all_1.iv - 1];
#line 15115 ""
- }
+ for (j = 1; j <= i__1; ++j) {
#line 15116 ""
-/* L23: */
+ if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],
+ 0) && all_1.nolev[all_1.iv + j * 24 - 25]
+ == 0) {
#line 15116 ""
- }
-#line 15117 ""
- commvl_1.nvmx[all_1.iv - 1] = 2;
+ all_1.nolev[all_1.iv + j * 24 - 25] = -4;
+#line 15116 ""
+ }
#line 15118 ""
- commvl_1.ivmx[all_1.iv + 23] = commvl_1.ivx;
+/* L26: */
+#line 15118 ""
+ }
#line 15119 ""
- all_1.itsofar[commvl_1.ivx - 1] = 0;
+ }
#line 15120 ""
- all_1.nnl[commvl_1.ivx - 1] = 0;
+ }
#line 15121 ""
- comfb_1.nfb[commvl_1.ivx - 1] = 0;
+ all_1.iccount = 128;
#line 15122 ""
- comudsp_1.nudoff[commvl_1.ivx - 1] = 0;
-#line 15123 ""
- comcc_1.ndotmv[commvl_1.ivx - 1] = 0;
-#line 15124 ""
- for (j = 1; j <= 200; ++j) {
-#line 15125 ""
- all_1.irest[commvl_1.ivx + j * 24 - 25] = 0;
-#line 15126 ""
- all_1.islur[commvl_1.ivx + j * 24 - 25] = 0;
-#line 15127 ""
- all_1.nacc[commvl_1.ivx + j * 24 - 25] = 0;
+ } else if (*(unsigned char *)charq == 'X') {
+
+/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */
+/* which only happens for normal X at block start, and we took special measures to */
+/* keep group shifts for crossing block boundaries. */
+
+/* Computing MAX */
#line 15128 ""
- all_1.iornq[commvl_1.ivx + j * 24 - 1] = 0;
-#line 15129 ""
- all_1.ipl[commvl_1.ivx + j * 24 - 25] = 0;
-#line 15130 ""
- all_1.mult[commvl_1.ivx + j * 24 - 25] = 0;
-#line 15131 ""
-/* L24: */
+ i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1];
+#line 15128 ""
+ getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(
+ i__1,i__2) * 24 - 25], &comnotes_1.shifton, &
+ comask_1.wheadpt, &all_1.iornq[commvl_1.ivx + (
+ all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 1], &
+ commvl_1.ivx, &all_1.irest[commvl_1.ivx + (all_1.nnl[
+ commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[
+ commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (
+ ftnlen)128, (ftnlen)1);
#line 15131 ""
- }
+ } else if (*(unsigned char *)charq == 'I') {
-/* Go back and lower the rests in voice "a" that don't have over-ridden heights */
+/* Midi controls. */
#line 15135 ""
- i__1 = all_1.nnl[all_1.iv - 1];
-#line 15135 ""
- for (j = 1; j <= i__1; ++j) {
-#line 15136 ""
- if (bit_test(all_1.irest[all_1.iv + j * 24 - 25],0) &&
- all_1.nolev[all_1.iv + j * 24 - 25] == 0) {
-#line 15136 ""
- all_1.nolev[all_1.iv + j * 24 - 25] = -4;
-#line 15136 ""
- }
-#line 15138 ""
-/* L26: */
-#line 15138 ""
- }
-#line 15139 ""
- }
-#line 15140 ""
- }
+ getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, &
+ combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &
+ all_1.lenbar, &all_1.mtrdenl, &all_1.nv, &c_false, (
+ ftnlen)128);
+#line 15137 ""
+ } else if (*(unsigned char *)charq == 'M') {
+
+/* Macro action */
+
#line 15141 ""
- all_1.iccount = 128;
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1)
+ ;
#line 15142 ""
- } else if (*(unsigned char *)charq == 'X') {
+ if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
-/* 3rd arg is only for termination of group shifts. Use "max" to avoid zero index, */
-/* which only happens for normal X at block start, and we took special measures to */
-/* keep group shifts for crossing block boundaries. */
+/* Record or save a macro. Get the number of the macro. */
-/* Computing MAX */
-#line 15148 ""
- i__1 = 1, i__2 = all_1.nnl[commvl_1.ivx - 1];
+#line 15146 ""
+ getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (
+ ftnlen)1);
+#line 15147 ""
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 15148 ""
- getx_(lineq, &all_1.iccount, &all_1.irest[commvl_1.ivx + max(i__1,
- i__2) * 24 - 25], &comnotes_1.shifton, &comask_1.wheadpt, &
- all_1.iornq[commvl_1.ivx + (all_1.nnl[commvl_1.ivx - 1] + 1) *
- 24 - 1], &commvl_1.ivx, &all_1.irest[commvl_1.ivx + (
- all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[
- commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen)
- 128, (ftnlen)1);
+ commac_1.macnum = i_nint(&fnum);
+#line 15149 ""
+ commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum)
+ ;
+#line 15150 ""
+ if (*(unsigned char *)charq == 'R') {
#line 15151 ""
- } else if (*(unsigned char *)charq == 'I') {
+ mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
+#line 15152 ""
+ } else {
-/* Midi controls. */
+/* Save (Record but don't activate) */
-#line 15155 ""
- getmidi_(&comkeys_2.noinst, lineq, &all_1.iccount, &
- combibarcnt_1.ibarcnt, &ibaroff, &all_1.nbars, &all_1.lenbar,
- &all_1.mtrdenl, &all_1.nv, &c_false, (ftnlen)128);
+#line 15156 ""
+L5:
+#line 15156 ""
+ mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
#line 15157 ""
- } else if (*(unsigned char *)charq == 'M') {
-
-/* Macro action */
-
+ if (commac_1.mrecord) {
+#line 15158 ""
+ getbuf_(lineq, (ftnlen)128);
+#line 15159 ""
+ all_1.iccount = 0;
+#line 15160 ""
+ goto L5;
#line 15161 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
+ }
#line 15162 ""
- if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
+ all_1.iccount = all_1.iccount + ndxm + 1;
+#line 15163 ""
+ }
+#line 15164 ""
+ } else if (*(unsigned char *)charq == 'P') {
-/* Record or save a macro. Get the number of the macro. */
+/* Playback the macro */
-#line 15166 ""
- getchar_(lineq, &all_1.iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15167 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
#line 15168 ""
- commac_1.macnum = i_nint(&fnum);
+ getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (
+ ftnlen)1);
#line 15169 ""
- commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
+ readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128,
+ (ftnlen)1);
#line 15170 ""
- if (*(unsigned char *)charq == 'R') {
+ commac_1.macnum = i_nint(&fnum);
#line 15171 ""
- mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
+ commac_1.icchold = all_1.iccount;
#line 15172 ""
- } else {
-
-/* Save (Record but don't activate) */
-
-#line 15176 ""
-L5:
+ s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
+#line 15173 ""
+ all_1.iccount = 128;
+#line 15174 ""
+ c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
+#line 15175 ""
+ commac_1.mplay = TRUE_;
#line 15176 ""
- mrec1_(lineq, &all_1.iccount, &ndxm, (ftnlen)128);
+ }
#line 15177 ""
- if (commac_1.mrecord) {
-#line 15178 ""
- getbuf_(lineq, (ftnlen)128);
-#line 15179 ""
- all_1.iccount = 0;
-#line 15180 ""
- goto L5;
+ } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
+
+/* Continued rhythmic shortcut */
+
#line 15181 ""
- }
+ idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
#line 15182 ""
- all_1.iccount = all_1.iccount + ndxm + 1;
-#line 15183 ""
- }
-#line 15184 ""
- } else if (*(unsigned char *)charq == 'P') {
+ if (idotform == 1) {
-/* Playback the macro */
+/* Check for start of forced beam on 2nd member of dotform=1 shortcut */
-#line 15188 ""
- getchar_(lineq, &all_1.iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 15189 ""
- readnum_(lineq, &all_1.iccount, durq, &fnum, (ftnlen)128, (ftnlen)
- 1);
+#line 15186 ""
+ if (comget_1.fbon) {
+#line 15187 ""
+ if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[
+ commvl_1.ivx - 1] * 24 - 25] == (real)
+ all_1.itsofar[commvl_1.ivx - 1]) {
+#line 15187 ""
+ comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[
+ commvl_1.ivx - 1] * 24 - 25] +=
+ all_1.nodur[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25] / 2;
+#line 15187 ""
+ }
#line 15190 ""
- commac_1.macnum = i_nint(&fnum);
-#line 15191 ""
- commac_1.icchold = all_1.iccount;
-#line 15192 ""
- s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
-#line 15193 ""
- all_1.iccount = 128;
+ }
+
+/* Change duration of prior note */
+
#line 15194 ""
- c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
+ all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[
+ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 25];
#line 15195 ""
- commac_1.mplay = TRUE_;
+ all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
+ 24 - 25] = all_1.nodur[commvl_1.ivx + all_1.nnl[
+ commvl_1.ivx - 1] * 24 - 25] * 3 / 2;
#line 15196 ""
- }
+ all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[
+ commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 -
+ 25];
#line 15197 ""
- } else if (i_indx(",.", charq, (ftnlen)2, (ftnlen)1) > 0) {
-
-/* Continued rhythmic shortcut */
-
+ }
+#line 15198 ""
+ ++idotform;
+#line 15199 ""
+ numnum = 1;
+#line 15200 ""
+ cdot = TRUE_;
#line 15201 ""
- idotform = i_indx(". ,", charq, (ftnlen)3, (ftnlen)1);
+ goto L1;
#line 15202 ""
- if (idotform == 1) {
-
-/* Check for start of forced beam on 2nd member of dotform=1 shortcut */
-
-#line 15206 ""
- if (comget_1.fbon) {
-#line 15207 ""
- if (comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1]
- * 24 - 25] == (real) all_1.itsofar[commvl_1.ivx - 1])
- {
-#line 15207 ""
- comfb_1.t1fb[commvl_1.ivx + comfb_1.nfb[commvl_1.ivx - 1]
- * 24 - 25] += all_1.nodur[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 25] / 2;
-#line 15207 ""
- }
-#line 15210 ""
}
-
-/* Change duration of prior note */
-
-#line 15214 ""
- all_1.itsofar[commvl_1.ivx - 1] -= all_1.nodur[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
-#line 15215 ""
- all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] * 24 - 25]
- = all_1.nodur[commvl_1.ivx + all_1.nnl[commvl_1.ivx - 1] *
- 24 - 25] * 3 / 2;
-#line 15216 ""
- all_1.itsofar[commvl_1.ivx - 1] += all_1.nodur[commvl_1.ivx +
- all_1.nnl[commvl_1.ivx - 1] * 24 - 25];
-#line 15217 ""
- }
-#line 15218 ""
- ++idotform;
-#line 15219 ""
- numnum = 1;
-#line 15220 ""
- cdot = TRUE_;
-#line 15221 ""
- goto L1;
-#line 15222 ""
+#line 15202 ""
+ }
+#line 15202 ""
}
-#line 15223 ""
+#line 15203 ""
return 0;
} /* getnote_ */
@@ -36060,7 +36297,7 @@ L5:
static real xofforn;
/* Fortran I/O blocks */
- static cilist io___881 = { 0, 6, 0, 0, 0 };
+ static cilist io___880 = { 0, 6, 0, 0, 0 };
@@ -36074,9 +36311,9 @@ L5:
/* Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U */
/* 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. */
-#line 15247 ""
+#line 15227 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 15248 ""
+#line 15228 ""
if (i_indx("bc", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* caesura or breath, handle specially and exit. Set up data in ibcdata(1...nbc) */
@@ -36086,117 +36323,117 @@ L5:
/* bit 27 = 0 if caesura, 1 if breath */
/* bit 28: 5th bit of ivx */
-#line 15257 ""
+#line 15237 ""
*iornq = bit_set(*iornq,28);
-#line 15258 ""
+#line 15238 ""
++comcb_1.nbc;
/* ibcdata(nbc) = ivx+16*ip */
-#line 15260 ""
+#line 15240 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = *ivx % 16 + (*ip << 4);
-#line 15261 ""
+#line 15241 ""
if (*ivx >= 16) {
-#line 15261 ""
+#line 15241 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
comcb_1.nbc - 1],28);
-#line 15261 ""
+#line 15241 ""
}
-#line 15262 ""
+#line 15242 ""
if (*(unsigned char *)charq == 'b') {
-#line 15262 ""
+#line 15242 ""
comcb_1.ibcdata[comcb_1.nbc - 1] = bit_set(comcb_1.ibcdata[
comcb_1.nbc - 1],27);
-#line 15262 ""
+#line 15242 ""
}
-#line 15263 ""
+#line 15243 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15264 ""
+#line 15244 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* We have a vertical shift, get it */
-#line 15268 ""
+#line 15248 ""
++(*iccount);
-#line 15269 ""
+#line 15249 ""
readnum_(lineq, iccount, charq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 15270 ""
+#line 15250 ""
if (*(unsigned char *)durq == '-') {
-#line 15270 ""
+#line 15250 ""
fnum = -fnum;
-#line 15270 ""
+#line 15250 ""
}
-#line 15271 ""
+#line 15251 ""
r__1 = fnum + 32;
-#line 15271 ""
+#line 15251 ""
i__1 = i_nint(&r__1);
-#line 15271 ""
+#line 15251 ""
setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__6, &c__13, &i__1);
-#line 15272 ""
+#line 15252 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Horizontal shift, get it */
-#line 15276 ""
+#line 15256 ""
++(*iccount);
-#line 15277 ""
+#line 15257 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 15278 ""
+#line 15258 ""
if (*(unsigned char *)charq == '-') {
-#line 15278 ""
+#line 15258 ""
fnum = -fnum;
-#line 15278 ""
+#line 15258 ""
}
-#line 15279 ""
+#line 15259 ""
r__1 = fnum * 10;
-#line 15279 ""
+#line 15259 ""
i__1 = i_nint(&r__1) + 128;
-#line 15279 ""
+#line 15259 ""
setbits_(&comcb_1.ibcdata[comcb_1.nbc - 1], &c__8, &c__19, &
i__1);
-#line 15280 ""
+#line 15260 ""
}
-#line 15281 ""
+#line 15261 ""
}
-#line 15282 ""
+#line 15262 ""
return 0;
-#line 15283 ""
+#line 15263 ""
}
/* Set signal on main note that some note at this time has ornament. ONLY used */
/* in beamstrt to activate further tests for whether ihornb is needed. */
-#line 15288 ""
+#line 15268 ""
*iornq = bit_set(*iornq,23);
/* Isolate 21 bits defining exisiting ornaments */
-#line 15292 ""
+#line 15272 ""
if (*notcrd) {
/* iorni = iand(4194303,iornq) */
/* iorni = iand(541065215,iornq) */
-#line 15295 ""
+#line 15275 ""
iorni = 1614807039 & *iornq;
-#line 15296 ""
+#line 15276 ""
} else {
-#line 15297 ""
+#line 15277 ""
iorni = 4194303 & comtrill_1.icrdorn[comtrill_1.ncrd - 1];
-#line 15298 ""
+#line 15278 ""
}
/* korn = index('stmgx+Tupf._)e:XXX>^',charq) */
-#line 15300 ""
+#line 15280 ""
korn = i_indx("stmgx+Tupf._)e:XXX>^XXXXXXXXCG", charq, (ftnlen)30, (
ftnlen)1);
-#line 15301 ""
+#line 15281 ""
if (korn != 15) {
-#line 15301 ""
+#line 15281 ""
iorni = bit_set(iorni,korn);
-#line 15301 ""
+#line 15281 ""
}
/* Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later */
/* as follows: korn=16-18 for sfn, and or 21 for bare ?. */
/* When this if-block is done, korn will = bit# of actual ornament (unless "?"). */
-#line 15307 ""
+#line 15287 ""
if (korn == 15) {
/* c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-20 prev iornq */
@@ -36206,236 +36443,236 @@ L5:
/* iorni = ior(iorni,iand(iornq0,1638383)) */
/* iorni = ior(iorni,iand(iornq0,3735535)) */
/* iorni = ior(iorni,iand(iornq0,540606447)) */
-#line 15316 ""
+#line 15296 ""
iorni |= *iornq0 & 1614348271;
-#line 15317 ""
+#line 15297 ""
*ornrpt = FALSE_;
-#line 15318 ""
+#line 15298 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* durq will be ' ' */
-#line 15322 ""
+#line 15302 ""
} else if (korn == 14) {
/* Editorial accidental */
-#line 15326 ""
+#line 15306 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* korn = 15+index('sfn',durq) */
-#line 15328 ""
+#line 15308 ""
korn = i_indx("sfn?", durq, (ftnlen)4, (ftnlen)1) + 15;
-#line 15329 ""
+#line 15309 ""
if (korn == 19) {
-#line 15329 ""
+#line 15309 ""
korn = 21;
-#line 15329 ""
+#line 15309 ""
}
-#line 15330 ""
+#line 15310 ""
iorni = bit_set(bit_clear(iorni,14),korn);
-#line 15331 ""
+#line 15311 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15332 ""
+#line 15312 ""
if (*(unsigned char *)durq == '?') {
/* This is "oe[s|f|n]?". Set 21st bit also. */
-#line 15336 ""
+#line 15316 ""
iorni = bit_set(iorni,21);
-#line 15337 ""
+#line 15317 ""
korn += 6;
-#line 15338 ""
+#line 15318 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15339 ""
+#line 15319 ""
}
/* iorni = ibset(ibclr(iorni,14),korn) */
-#line 15341 ""
+#line 15321 ""
} else if (korn == 4 && *noxtup) {
/* segno. Check in pmxa for just 1/block & notcrd. Get horiz. offset in points */
-#line 15345 ""
+#line 15325 ""
*noffseg = 0;
-#line 15346 ""
+#line 15326 ""
negseg = FALSE_;
-#line 15347 ""
+#line 15327 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15348 ""
+#line 15328 ""
if (*(unsigned char *)durq != ' ') {
/* Segno shift is specified */
-#line 15352 ""
+#line 15332 ""
if (*(unsigned char *)durq == '-') {
-#line 15353 ""
+#line 15333 ""
negseg = TRUE_;
-#line 15354 ""
+#line 15334 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15355 ""
+#line 15335 ""
}
-#line 15356 ""
+#line 15336 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 15357 ""
+#line 15337 ""
*noffseg = (integer) fnum;
-#line 15358 ""
+#line 15338 ""
if (negseg) {
-#line 15358 ""
+#line 15338 ""
*noffseg = -(*noffseg);
-#line 15358 ""
+#line 15338 ""
}
-#line 15359 ""
+#line 15339 ""
}
-#line 15360 ""
+#line 15340 ""
} else if (korn == 7) {
/* Trill. Check in pmxa for notcrd. Default is 1 noteskip long, with "tr" */
-#line 15364 ""
+#line 15344 ""
++comtrill_1.ntrill;
-#line 15365 ""
+#line 15345 ""
comtrill_1.ivtrill[comtrill_1.ntrill - 1] = *ivx;
-#line 15366 ""
+#line 15346 ""
comtrill_1.iptrill[comtrill_1.ntrill - 1] = *ip;
-#line 15367 ""
+#line 15347 ""
comtrill_1.xnsktr[comtrill_1.ntrill - 1] = 1.f;
-#line 15368 ""
+#line 15348 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15369 ""
+#line 15349 ""
if (*(unsigned char *)durq == 't') {
/* Convert to new internal symbol for non-'"tr" trill */
-#line 15373 ""
+#line 15353 ""
korn = 15;
-#line 15374 ""
+#line 15354 ""
iorni = bit_set(bit_clear(iorni,7),15);
-#line 15375 ""
+#line 15355 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15376 ""
+#line 15356 ""
}
-#line 15377 ""
+#line 15357 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
/* We have a number for the length */
-#line 15381 ""
+#line 15361 ""
readnum_(lineq, iccount, durq, &comtrill_1.xnsktr[
comtrill_1.ntrill - 1], (ftnlen)128, (ftnlen)1);
-#line 15382 ""
+#line 15362 ""
}
-#line 15383 ""
+#line 15363 ""
} else if (korn == 10 && *noxtup) {
/* Fermata */
-#line 15387 ""
+#line 15367 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15388 ""
+#line 15368 ""
if (*(unsigned char *)durq == 'd') {
-#line 15389 ""
+#line 15369 ""
korn = 14;
-#line 15390 ""
+#line 15370 ""
iorni = bit_set(bit_clear(iorni,10),14);
-#line 15391 ""
+#line 15371 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15392 ""
+#line 15372 ""
}
-#line 15393 ""
+#line 15373 ""
} else {
-#line 15394 ""
+#line 15374 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 15395 ""
+#line 15375 ""
}
-#line 15396 ""
+#line 15376 ""
if (i_indx("+- :", durq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 15397 ""
- s_wsle(&io___881);
-#line 15397 ""
+#line 15377 ""
+ s_wsle(&io___880);
+#line 15377 ""
do_lio(&c__9, &c__1, "Unexpected character at end of ornament: ", (
ftnlen)41);
-#line 15397 ""
+#line 15377 ""
do_lio(&c__9, &c__1, durq, (ftnlen)1);
-#line 15397 ""
+#line 15377 ""
e_wsle();
-#line 15398 ""
+#line 15378 ""
stop1_();
-#line 15399 ""
+#line 15379 ""
}
-#line 15400 ""
+#line 15380 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Shift ornament up or down */
-#line 15404 ""
+#line 15384 ""
++comtrill_1.nudorn;
/* Set bit 25 in iorni as a signal. This may not really be necessary. */
-#line 15408 ""
+#line 15388 ""
iorni = bit_set(iorni,25);
/* Assemble info to put in kudorn(nudorn) Bits 0-7:ip, 8-11:ivx, 12-18:nolev, */
/* 19-24: type of ornament to be shifted, 25-30: shift+32, 31:h-shft present */
-#line 15413 ""
+#line 15393 ""
xofforn = (real) (44 - *(unsigned char *)durq);
-#line 15414 ""
+#line 15394 ""
++(*iccount);
-#line 15415 ""
+#line 15395 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 15416 ""
+#line 15396 ""
r__1 = xofforn * fnum;
-#line 15416 ""
+#line 15396 ""
iofforn = i_nint(&r__1);
-#line 15417 ""
+#line 15397 ""
comtrill_1.kudorn[comtrill_1.nudorn - 1] = *ip + (*ivx % 16 << 8) + (*
nole << 12) + (korn << 19) + (iofforn + 32 << 25);
-#line 15419 ""
+#line 15399 ""
comivxudorn_1.ivxudorn[comtrill_1.nudorn - 1] = *ivx;
-#line 15420 ""
+#line 15400 ""
if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
/* Horizontal shift */
-#line 15424 ""
+#line 15404 ""
comtrill_1.kudorn[comtrill_1.nudorn - 1] = bit_set(
comtrill_1.kudorn[comtrill_1.nudorn - 1],31);
-#line 15425 ""
+#line 15405 ""
xofforn = (real) (44 - *(unsigned char *)durq);
-#line 15426 ""
+#line 15406 ""
++(*iccount);
-#line 15427 ""
+#line 15407 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
/* 141226 ornhshft(nudorn) = nint(xofforn*fnum) */
-#line 15429 ""
+#line 15409 ""
comtrill_1.ornhshft[comtrill_1.nudorn - 1] = xofforn * fnum;
-#line 15430 ""
+#line 15410 ""
}
-#line 15431 ""
+#line 15411 ""
} else if (*(unsigned char *)durq == ':') {
/* Turn on repeated ornaments */
-#line 15435 ""
+#line 15415 ""
*ornrpt = TRUE_;
/* Save the ornament value just set */
-#line 15439 ""
+#line 15419 ""
*iornq0 = iorni;
-#line 15440 ""
+#line 15420 ""
}
-#line 15441 ""
+#line 15421 ""
if (*notcrd) {
-#line 15442 ""
+#line 15422 ""
*iornq |= iorni;
-#line 15443 ""
+#line 15423 ""
} else {
-#line 15444 ""
+#line 15424 ""
comtrill_1.icrdorn[comtrill_1.ncrd - 1] |= iorni;
-#line 15445 ""
+#line 15425 ""
}
-#line 15446 ""
+#line 15426 ""
return 0;
} /* getorn_ */
@@ -36471,9 +36708,9 @@ L5:
static char lnholdq[128];
/* Fortran I/O blocks */
- static cilist io___887 = { 0, 6, 0, 0, 0 };
- static cilist io___888 = { 0, 15, 0, "()", 0 };
- static cilist io___892 = { 0, 18, 1, "(a)", 0 };
+ static cilist io___886 = { 0, 6, 0, 0, 0 };
+ static cilist io___887 = { 0, 15, 0, "()", 0 };
+ static cilist io___891 = { 0, 18, 1, "(a)", 0 };
@@ -36496,410 +36733,410 @@ L5:
/* ipbufmod = points to last character of most recent inserted line */
/* from pmx.mod */
-#line 15480 ""
+#line 15460 ""
c1omget_1.line1pmxmod = inbuff_1.ilbuf;
-#line 15481 ""
+#line 15461 ""
if (! (*global)) {
-#line 15482 ""
+#line 15462 ""
ioin__1.inerr = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.infilen = includeq_len;
-#line 15482 ""
+#line 15462 ""
ioin__1.infile = includeq;
-#line 15482 ""
+#line 15462 ""
ioin__1.inex = &fexist;
-#line 15482 ""
+#line 15462 ""
ioin__1.inopen = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.innum = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.innamed = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inname = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inacc = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inseq = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.indir = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.infmt = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inform = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inunf = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inrecl = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.innrec = 0;
-#line 15482 ""
+#line 15462 ""
ioin__1.inblank = 0;
-#line 15482 ""
+#line 15462 ""
f_inqu(&ioin__1);
/* Transfer includeq to temporary char variable with known length */
-#line 15486 ""
+#line 15466 ""
s_copy(pmxmoddirq, includeq, (ftnlen)80, includeq_len);
-#line 15487 ""
+#line 15467 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
-#line 15488 ""
- s_wsle(&io___887);
-#line 15488 ""
+#line 15468 ""
+ s_wsle(&io___886);
+#line 15468 ""
e_wsle();
-#line 15489 ""
- s_wsfe(&io___888);
-#line 15489 ""
+#line 15469 ""
+ s_wsfe(&io___887);
+#line 15469 ""
e_wsfe();
-#line 15490 ""
+#line 15470 ""
if (! fexist) {
/* Writing concatenation */
-#line 15491 ""
+#line 15471 ""
i__1[0] = 15, a__1[0] = "Could not find ";
-#line 15491 ""
+#line 15471 ""
i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
-#line 15491 ""
+#line 15471 ""
i__1[2] = 19, a__1[2] = ", checking further.";
-#line 15491 ""
+#line 15471 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)114);
-#line 15491 ""
+#line 15471 ""
printl_(ch__1, lpmxmoddirq + 34);
/* File named includeq doesn't not exist. Get directory from PMXMODDIR and */
/* see if it's there */
-#line 15497 ""
+#line 15477 ""
getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
-#line 15498 ""
+#line 15478 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
-#line 15499 ""
+#line 15479 ""
if (lpmxmoddirq > 0) {
/* Writing concatenation */
-#line 15500 ""
+#line 15480 ""
i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
-#line 15500 ""
+#line 15480 ""
i__2[1] = includeq_len, a__2[1] = includeq;
-#line 15500 ""
+#line 15480 ""
s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
-#line 15501 ""
+#line 15481 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
-#line 15502 ""
+#line 15482 ""
} else {
-#line 15503 ""
+#line 15483 ""
printl_("No other directory defined by PMXMODDIR, stopping", (
ftnlen)49);
-#line 15505 ""
+#line 15485 ""
stop1_();
-#line 15506 ""
+#line 15486 ""
}
-#line 15507 ""
+#line 15487 ""
ioin__1.inerr = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.infilen = 80;
-#line 15507 ""
+#line 15487 ""
ioin__1.infile = pmxmoddirq;
-#line 15507 ""
+#line 15487 ""
ioin__1.inex = &fexist;
-#line 15507 ""
+#line 15487 ""
ioin__1.inopen = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.innum = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.innamed = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inname = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inacc = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inseq = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.indir = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.infmt = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inform = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inunf = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inrecl = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.innrec = 0;
-#line 15507 ""
+#line 15487 ""
ioin__1.inblank = 0;
-#line 15507 ""
+#line 15487 ""
f_inqu(&ioin__1);
-#line 15508 ""
+#line 15488 ""
if (! fexist) {
/* Writing concatenation */
-#line 15509 ""
+#line 15489 ""
i__1[0] = 15, a__1[0] = "Could not find ";
-#line 15509 ""
+#line 15489 ""
i__1[1] = lpmxmoddirq, a__1[1] = pmxmoddirq;
-#line 15509 ""
+#line 15489 ""
i__1[2] = 11, a__1[2] = ", stopping.";
-#line 15509 ""
+#line 15489 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)106);
-#line 15509 ""
+#line 15489 ""
printl_(ch__2, lpmxmoddirq + 26);
-#line 15511 ""
+#line 15491 ""
stop1_();
-#line 15512 ""
+#line 15492 ""
}
-#line 15513 ""
+#line 15493 ""
}
/* Writing concatenation */
-#line 15514 ""
+#line 15494 ""
i__2[0] = 28, a__2[0] = "Opening normal include file ";
-#line 15514 ""
+#line 15494 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
-#line 15514 ""
+#line 15494 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
-#line 15514 ""
+#line 15494 ""
printl_(ch__3, lpmxmoddirq + 28);
-#line 15516 ""
+#line 15496 ""
o__1.oerr = 0;
-#line 15516 ""
+#line 15496 ""
o__1.ounit = 18;
-#line 15516 ""
+#line 15496 ""
o__1.ofnmlen = 80;
-#line 15516 ""
+#line 15496 ""
o__1.ofnm = pmxmoddirq;
-#line 15516 ""
+#line 15496 ""
o__1.orl = 0;
-#line 15516 ""
+#line 15496 ""
o__1.osta = 0;
-#line 15516 ""
+#line 15496 ""
o__1.oacc = 0;
-#line 15516 ""
+#line 15496 ""
o__1.ofm = 0;
-#line 15516 ""
+#line 15496 ""
o__1.oblnk = 0;
-#line 15516 ""
+#line 15496 ""
f_open(&o__1);
-#line 15517 ""
+#line 15497 ""
} else {
/* Check for existence of pmx.mod */
-#line 15521 ""
+#line 15501 ""
getenv_("PMXMODDIR", pmxmoddirq, (ftnlen)9, (ftnlen)80);
-#line 15522 ""
+#line 15502 ""
lpmxmoddirq = lenstr_(pmxmoddirq, &c__80, (ftnlen)80);
-#line 15523 ""
+#line 15503 ""
if (lpmxmoddirq == 0) {
-#line 15523 ""
+#line 15503 ""
return 0;
-#line 15523 ""
+#line 15503 ""
}
/* Writing concatenation */
-#line 15524 ""
+#line 15504 ""
i__2[0] = lpmxmoddirq, a__2[0] = pmxmoddirq;
-#line 15524 ""
+#line 15504 ""
i__2[1] = 7, a__2[1] = "pmx.mod";
-#line 15524 ""
+#line 15504 ""
s_cat(pmxmoddirq, a__2, i__2, &c__2, (ftnlen)80);
-#line 15525 ""
+#line 15505 ""
lpmxmoddirq += 7;
-#line 15526 ""
+#line 15506 ""
ioin__1.inerr = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.infilen = 80;
-#line 15526 ""
+#line 15506 ""
ioin__1.infile = pmxmoddirq;
-#line 15526 ""
+#line 15506 ""
ioin__1.inex = &fexist;
-#line 15526 ""
+#line 15506 ""
ioin__1.inopen = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.innum = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.innamed = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inname = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inacc = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inseq = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.indir = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.infmt = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inform = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inunf = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inrecl = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.innrec = 0;
-#line 15526 ""
+#line 15506 ""
ioin__1.inblank = 0;
-#line 15526 ""
+#line 15506 ""
f_inqu(&ioin__1);
-#line 15527 ""
+#line 15507 ""
if (! fexist) {
-#line 15527 ""
+#line 15507 ""
return 0;
-#line 15527 ""
+#line 15507 ""
}
/* Writing concatenation */
-#line 15528 ""
+#line 15508 ""
i__2[0] = 28, a__2[0] = "Opening global include file ";
-#line 15528 ""
+#line 15508 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
-#line 15528 ""
+#line 15508 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)108);
-#line 15528 ""
+#line 15508 ""
printl_(ch__3, lpmxmoddirq + 28);
-#line 15530 ""
+#line 15510 ""
o__1.oerr = 0;
-#line 15530 ""
+#line 15510 ""
o__1.ounit = 18;
-#line 15530 ""
+#line 15510 ""
o__1.ofnmlen = lpmxmoddirq;
-#line 15530 ""
+#line 15510 ""
o__1.ofnm = pmxmoddirq;
-#line 15530 ""
+#line 15510 ""
o__1.orl = 0;
-#line 15530 ""
+#line 15510 ""
o__1.osta = 0;
-#line 15530 ""
+#line 15510 ""
o__1.oacc = 0;
-#line 15530 ""
+#line 15510 ""
o__1.ofm = 0;
-#line 15530 ""
+#line 15510 ""
o__1.oblnk = 0;
-#line 15530 ""
+#line 15510 ""
f_open(&o__1);
-#line 15531 ""
+#line 15511 ""
}
-#line 15532 ""
+#line 15512 ""
printl_("Adding include data", (ftnlen)19);
/* Read lines in from pmx.mod one at a time */
-#line 15536 ""
+#line 15516 ""
ipbufmod = inbuff_1.ipbuf;
-#line 15537 ""
+#line 15517 ""
lenbufmod = c1omget_1.lenbuf0;
-#line 15538 ""
+#line 15518 ""
for (ilbufmod = inbuff_1.ilbuf; ilbufmod <= 9600; ++ilbufmod) {
-#line 15539 ""
- i__3 = s_rsfe(&io___892);
-#line 15539 ""
+#line 15519 ""
+ i__3 = s_rsfe(&io___891);
+#line 15519 ""
if (i__3 != 0) {
-#line 15539 ""
+#line 15519 ""
goto L3;
-#line 15539 ""
+#line 15519 ""
}
-#line 15539 ""
+#line 15519 ""
i__3 = do_fio(&c__1, lnholdq, (ftnlen)128);
-#line 15539 ""
+#line 15519 ""
if (i__3 != 0) {
-#line 15539 ""
+#line 15519 ""
goto L3;
-#line 15539 ""
+#line 15519 ""
}
-#line 15539 ""
+#line 15519 ""
i__3 = e_rsfe();
-#line 15539 ""
+#line 15519 ""
if (i__3 != 0) {
-#line 15539 ""
+#line 15519 ""
goto L3;
-#line 15539 ""
+#line 15519 ""
}
/* A line was read. Slide all existing lengths from here forward ahead by 1 */
-#line 15543 ""
+#line 15523 ""
i__3 = ilbufmod;
-#line 15543 ""
+#line 15523 ""
for (ilbuff = inbuff_1.nlbuf; ilbuff >= i__3; --ilbuff) {
-#line 15544 ""
+#line 15524 ""
inbuff_1.lbuf[ilbuff] = inbuff_1.lbuf[ilbuff - 1];
-#line 15545 ""
+#line 15525 ""
/* L2: */
-#line 15545 ""
+#line 15525 ""
}
/* Get length of line from include file */
-#line 15549 ""
+#line 15529 ""
lenmodline = lenstr_(lnholdq, &c__128, (ftnlen)128);
-#line 15550 ""
+#line 15530 ""
if (lenmodline == 0) {
/* Blank line. Make it a single blank with length 1 */
-#line 15554 ""
+#line 15534 ""
lenmodline = 1;
-#line 15555 ""
+#line 15535 ""
s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1);
-#line 15556 ""
+#line 15536 ""
}
-#line 15557 ""
+#line 15537 ""
inbuff_1.lbuf[ilbufmod - 1] = (shortint) lenmodline;
-#line 15558 ""
+#line 15538 ""
printl_(lnholdq, lenmodline);
/* Insert new stuff into bufq */
-#line 15562 ""
+#line 15542 ""
i__3 = ipbufmod;
/* Writing concatenation */
-#line 15562 ""
+#line 15542 ""
i__1[0] = ipbufmod, a__1[0] = inbuff_1.bufq;
-#line 15562 ""
+#line 15542 ""
i__1[1] = lenmodline, a__1[1] = lnholdq;
-#line 15562 ""
+#line 15542 ""
i__1[2] = lenbufmod - i__3, a__1[2] = inbuff_1.bufq + i__3;
-#line 15562 ""
+#line 15542 ""
s_cat(inbuff_1.bufq, a__1, i__1, &c__3, (ftnlen)131072);
/* Update internal parameters */
-#line 15567 ""
+#line 15547 ""
ipbufmod += inbuff_1.lbuf[ilbufmod - 1];
-#line 15568 ""
+#line 15548 ""
lenbufmod += inbuff_1.lbuf[ilbufmod - 1];
-#line 15569 ""
+#line 15549 ""
++inbuff_1.nlbuf;
-#line 15570 ""
+#line 15550 ""
/* L1: */
-#line 15570 ""
+#line 15550 ""
}
-#line 15571 ""
+#line 15551 ""
L3:
/* Writing concatenation */
-#line 15572 ""
+#line 15552 ""
i__2[0] = 8, a__2[0] = "Closing ";
-#line 15572 ""
+#line 15552 ""
i__2[1] = lpmxmoddirq, a__2[1] = pmxmoddirq;
-#line 15572 ""
+#line 15552 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)88);
-#line 15572 ""
+#line 15552 ""
printl_(ch__4, lpmxmoddirq + 8);
-#line 15573 ""
+#line 15553 ""
cl__1.cerr = 0;
-#line 15573 ""
+#line 15553 ""
cl__1.cunit = 18;
-#line 15573 ""
+#line 15553 ""
cl__1.csta = 0;
-#line 15573 ""
+#line 15553 ""
f_clos(&cl__1);
-#line 15574 ""
+#line 15554 ""
c1omget_1.linesinpmxmod = c1omget_1.linesinpmxmod + ilbufmod -
inbuff_1.ilbuf;
-#line 15575 ""
+#line 15555 ""
c1omget_1.lenbuf0 = lenbufmod;
/* Fix Andre's error reporting problem 101211 leading to log(neg#) due */
/* to nline being 2 bigger than it should be */
-#line 15580 ""
+#line 15560 ""
c1omget_1.nline += -2;
-#line 15582 ""
+#line 15562 ""
return 0;
} /* getpmxmod_ */
@@ -36913,6 +37150,7 @@ L3:
/* System generated locals */
integer i__1, i__2;
real r__1;
+ char ch__1[1];
olist o__1;
/* Builtin functions */
@@ -36921,7 +37159,9 @@ L3:
i_nint(real *), i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
- static integer i__, iv, ivi, ipos, nline;
+ static integer i__, iv, ivi;
+ extern /* Character */ VOID chax_(char *, ftnlen, integer *);
+ static integer ipos, nline;
static char lineq[128];
static integer iinst, jinst;
extern doublereal readin_(char *, integer *, integer *, ftnlen);
@@ -36930,144 +37170,144 @@ L3:
static integer iccount, nvsofar;
/* Fortran I/O blocks */
- static cilist io___898 = { 0, 17, 0, "(a)", 0 };
+ static cilist io___897 = { 0, 17, 0, "(a)", 0 };
/* Get the first line */
-#line 15598 ""
+#line 15578 ""
/* Parameter adjustments */
-#line 15598 ""
+#line 15578 ""
--sepsymq;
-#line 15598 ""
+#line 15578 ""
--clefq;
-#line 15598 ""
+#line 15578 ""
inameq -= 79;
-#line 15598 ""
+#line 15578 ""
-#line 15598 ""
+#line 15578 ""
/* Function Body */
-#line 15598 ""
+#line 15578 ""
iccount = 0;
-#line 15599 ""
+#line 15579 ""
L9:
-#line 15599 ""
+#line 15579 ""
getbuf_(lineq, (ftnlen)128);
-#line 15600 ""
+#line 15580 ""
if (*(unsigned char *)lineq == '%') {
-#line 15600 ""
+#line 15580 ""
goto L9;
-#line 15600 ""
+#line 15580 ""
}
-#line 15601 ""
+#line 15581 ""
*istype0 = s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) == 0;
-#line 15602 ""
+#line 15582 ""
if (*istype0) {
/* Have TeX input until next line that starts with '---'. Save in scratch. */
-#line 15606 ""
+#line 15586 ""
o__1.oerr = 0;
-#line 15606 ""
+#line 15586 ""
o__1.ounit = 17;
-#line 15606 ""
+#line 15586 ""
o__1.ofnm = 0;
-#line 15606 ""
+#line 15586 ""
o__1.orl = 0;
-#line 15606 ""
+#line 15586 ""
o__1.osta = "SCRATCH";
-#line 15606 ""
+#line 15586 ""
o__1.oacc = 0;
-#line 15606 ""
+#line 15586 ""
o__1.ofm = 0;
-#line 15606 ""
+#line 15586 ""
o__1.oblnk = 0;
-#line 15606 ""
+#line 15586 ""
f_open(&o__1);
-#line 15607 ""
+#line 15587 ""
L3:
-#line 15607 ""
+#line 15587 ""
getbuf_(lineq, (ftnlen)128);
-#line 15608 ""
+#line 15588 ""
if (s_cmp(lineq, "---", (ftnlen)3, (ftnlen)3) != 0) {
-#line 15609 ""
- s_wsfe(&io___898);
-#line 15609 ""
+#line 15589 ""
+ s_wsfe(&io___897);
+#line 15589 ""
do_fio(&c__1, lineq, (ftnlen)128);
-#line 15609 ""
+#line 15589 ""
e_wsfe();
-#line 15610 ""
+#line 15590 ""
goto L3;
-#line 15611 ""
+#line 15591 ""
}
/* Force a new line read on first call to readin */
-#line 15615 ""
+#line 15595 ""
iccount = 128;
-#line 15616 ""
+#line 15596 ""
}
/* Here, lineq is first line w/ numerical setup data. */
-#line 15620 ""
+#line 15600 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15620 ""
+#line 15600 ""
*nv = i_nint(&r__1);
-#line 15621 ""
+#line 15601 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15621 ""
+#line 15601 ""
*noinst = i_nint(&r__1);
-#line 15622 ""
+#line 15602 ""
newway = *noinst <= 0;
-#line 15623 ""
+#line 15603 ""
if (newway) {
-#line 15623 ""
+#line 15603 ""
*noinst = -(*noinst);
-#line 15623 ""
+#line 15603 ""
}
-#line 15624 ""
+#line 15604 ""
i__1 = *noinst;
-#line 15624 ""
+#line 15604 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* Seve # of staves per inst in case later drop some inst's. */
-#line 15628 ""
+#line 15608 ""
if (newway) {
/* Read in nvi for each instrument */
-#line 15632 ""
+#line 15612 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15632 ""
+#line 15612 ""
comnvi_1.nsperi[iinst - 1] = i_nint(&r__1);
-#line 15633 ""
+#line 15613 ""
} else if (iinst > 1) {
-#line 15634 ""
+#line 15614 ""
comnvi_1.nsperi[iinst - 1] = 1;
-#line 15635 ""
+#line 15615 ""
} else {
-#line 15636 ""
+#line 15616 ""
comnvi_1.nsperi[iinst - 1] = *nv - *noinst + 1;
-#line 15637 ""
+#line 15617 ""
}
-#line 15638 ""
+#line 15618 ""
comnvi_1.iiorig[iinst - 1] = iinst;
-#line 15639 ""
+#line 15619 ""
comnvi_1.nspern[iinst - 1] = comnvi_1.nsperi[iinst - 1];
-#line 15640 ""
+#line 15620 ""
/* L2: */
-#line 15640 ""
+#line 15620 ""
}
-#line 15641 ""
+#line 15621 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15641 ""
+#line 15621 ""
*mtrnuml = i_nint(&r__1);
-#line 15642 ""
+#line 15622 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15642 ""
+#line 15622 ""
*mtrdenl = i_nint(&r__1);
/* c */
/* c Kluge to make mtrdenl work */
@@ -37076,147 +37316,147 @@ L3:
/* mtrdenl = 2 */
/* mtrnuml = mtrnuml*2 */
/* end if */
-#line 15650 ""
+#line 15630 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15650 ""
+#line 15630 ""
*mtrnmp = i_nint(&r__1);
-#line 15651 ""
+#line 15631 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15651 ""
+#line 15631 ""
*mtrdnp = i_nint(&r__1);
-#line 15652 ""
+#line 15632 ""
*xmtrnum0 = readin_(lineq, &iccount, &nline, (ftnlen)128);
/* Original key sig (before any trnasposition) in next position. Transposed */
/* sig for topfile was transferred thru pmxtex.dat. Need isig0 for key */
/* changes if transposed. */
-#line 15658 ""
+#line 15638 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15658 ""
+#line 15638 ""
*isig0 = i_nint(&r__1);
/* 130316 */
/* do 11 iinst = 1 , noinst */
/* midisig(iinst) = isig0 */
-#line 15662 ""
+#line 15642 ""
commidisig_1.midisig = *isig0;
/* 11 continue */
-#line 15664 ""
+#line 15644 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15664 ""
+#line 15644 ""
*npages = i_nint(&r__1);
-#line 15665 ""
+#line 15645 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15665 ""
+#line 15645 ""
*nsyst = i_nint(&r__1);
-#line 15666 ""
+#line 15646 ""
r__1 = readin_(lineq, &iccount, &nline, (ftnlen)128);
-#line 15666 ""
+#line 15646 ""
*musicsize = i_nint(&r__1);
-#line 15667 ""
+#line 15647 ""
*fracindent = readin_(lineq, &iccount, &nline, (ftnlen)128);
/* Next noinst non-comment lines are names of instruments. */
-#line 15671 ""
+#line 15651 ""
i__1 = *noinst;
-#line 15671 ""
+#line 15651 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 15672 ""
+#line 15652 ""
L5:
-#line 15672 ""
+#line 15652 ""
getbuf_(inameq + i__ * 79, (ftnlen)79);
-#line 15673 ""
+#line 15653 ""
if (*(unsigned char *)&inameq[i__ * 79] == '%') {
-#line 15673 ""
+#line 15653 ""
goto L5;
-#line 15673 ""
+#line 15653 ""
}
-#line 15674 ""
+#line 15654 ""
/* L4: */
-#line 15674 ""
+#line 15654 ""
}
/* Next non-comment line has nv clef names */
-#line 15678 ""
+#line 15658 ""
L6:
-#line 15678 ""
+#line 15658 ""
getbuf_(lineq, (ftnlen)128);
-#line 15679 ""
+#line 15659 ""
if (*(unsigned char *)lineq == '%') {
-#line 15679 ""
+#line 15659 ""
goto L6;
-#line 15679 ""
+#line 15659 ""
}
-#line 15680 ""
+#line 15660 ""
iv = 0;
-#line 15681 ""
+#line 15661 ""
nvsofar = 0;
-#line 15682 ""
+#line 15662 ""
i__1 = *noinst;
-#line 15682 ""
+#line 15662 ""
for (jinst = 1; jinst <= i__1; ++jinst) {
-#line 15683 ""
+#line 15663 ""
nvsofar += comnvi_1.nsperi[jinst - 1];
-#line 15684 ""
+#line 15664 ""
i__2 = comnvi_1.nsperi[jinst - 1];
-#line 15684 ""
+#line 15664 ""
for (ivi = 1; ivi <= i__2; ++ivi) {
-#line 15685 ""
+#line 15665 ""
++iv;
-#line 15686 ""
+#line 15666 ""
*(unsigned char *)&clefq[iv] = *(unsigned char *)&lineq[iv - 1];
-#line 15687 ""
+#line 15667 ""
if (iv == nvsofar) {
-#line 15688 ""
+#line 15668 ""
*(unsigned char *)&sepsymq[iv] = '&';
-#line 15689 ""
+#line 15669 ""
} else {
-#line 15690 ""
+#line 15670 ""
*(unsigned char *)&sepsymq[iv] = '|';
-#line 15691 ""
+#line 15671 ""
}
-#line 15692 ""
+#line 15672 ""
/* L10: */
-#line 15692 ""
+#line 15672 ""
}
-#line 15693 ""
+#line 15673 ""
/* L1: */
-#line 15693 ""
+#line 15673 ""
}
/* Mext non-comment line has path name */
-#line 15697 ""
+#line 15677 ""
L8:
-#line 15697 ""
+#line 15677 ""
getbuf_(pathnameq, (ftnlen)40);
-#line 15698 ""
+#line 15678 ""
if (*(unsigned char *)pathnameq == '%') {
-#line 15698 ""
+#line 15678 ""
goto L8;
-#line 15698 ""
+#line 15678 ""
}
-#line 15699 ""
+#line 15679 ""
*lpath = i_indx(pathnameq, " ", (ftnlen)40, (ftnlen)1) - 1;
-
-/* 160130 Replace '\' by '/' */
-
-#line 15703 ""
+#line 15680 ""
L12:
-#line 15703 ""
- ipos = i_indx(pathnameq, "\\", (ftnlen)40, (ftnlen)1);
-#line 15704 ""
+#line 15680 ""
+ chax_(ch__1, (ftnlen)1, &c__92);
+#line 15680 ""
+ ipos = i_indx(pathnameq, ch__1, (ftnlen)40, (ftnlen)1);
+#line 15681 ""
if (ipos > 0) {
-#line 15705 ""
- *(unsigned char *)&pathnameq[ipos - 1] = '/';
-/* print*,'Changed pathname to ',pathnameq(1:lpath) */
-#line 15707 ""
+#line 15682 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 15682 ""
+ *(unsigned char *)&pathnameq[ipos - 1] = *(unsigned char *)&ch__1[0];
+#line 15683 ""
goto L12;
-#line 15708 ""
+#line 15684 ""
}
-#line 15709 ""
+#line 15685 ""
return 0;
} /* getset_ */
@@ -37240,55 +37480,55 @@ doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote,
/* Since notes are ordered by increasing start times, as soon as we find one */
/* that starts too late, we are done checking. */
-#line 15723 ""
+#line 15699 ""
/* Parameter adjustments */
-#line 15723 ""
+#line 15699 ""
--to;
-#line 15723 ""
+#line 15699 ""
--tnote;
-#line 15723 ""
+#line 15699 ""
-#line 15723 ""
+#line 15699 ""
/* Function Body */
-#line 15723 ""
+#line 15699 ""
tgovern = 1e3f;
-#line 15724 ""
+#line 15700 ""
tend = to[*n] + *space;
-#line 15725 ""
+#line 15701 ""
i__1 = *ntot;
-#line 15725 ""
+#line 15701 ""
for (in = 1; in <= i__1; ++in) {
/* Since to() is ordered by start times, exit loop after first note that */
/* starts later than note of interest. */
-#line 15730 ""
+#line 15706 ""
if (to[in] > to[*n] + comtol_1.tol) {
-#line 15730 ""
+#line 15706 ""
goto L2;
-#line 15730 ""
+#line 15706 ""
}
-#line 15731 ""
+#line 15707 ""
if (to[in] + tnote[in] > tend - comtol_1.tol) {
/* If here, this note overlaps and must be tested. */
/* Computing MIN */
-#line 15735 ""
+#line 15711 ""
r__1 = tgovern, r__2 = tnote[in];
-#line 15735 ""
+#line 15711 ""
tgovern = dmin(r__1,r__2);
-#line 15736 ""
+#line 15712 ""
}
-#line 15737 ""
+#line 15713 ""
/* L1: */
-#line 15737 ""
+#line 15713 ""
}
-#line 15738 ""
+#line 15714 ""
L2:
-#line 15739 ""
+#line 15715 ""
ret_val = *space / tgovern;
-#line 15740 ""
+#line 15716 ""
return ret_val;
} /* getsquez_ */
@@ -37319,140 +37559,140 @@ L2:
/* during xtups, we use itup and ntup to get actual time. On entry, ntup=0 if */
/* not in xtup. */
-#line 15756 ""
+#line 15732 ""
colon = FALSE_;
-#line 15757 ""
+#line 15733 ""
ess = FALSE_;
-#line 15758 ""
+#line 15734 ""
number = FALSE_;
-#line 15759 ""
+#line 15735 ""
nextbl = *iccount + i_indx(lineq + (*iccount - 1), " ", 128 - (*iccount -
1), (ftnlen)1) - 1;
-#line 15760 ""
+#line 15736 ""
if (i_indx(lineq + (*iccount - 1), "P", nextbl - (*iccount - 1), (ftnlen)
1) > 0) {
/* "Parts only", ignore entire symbol */
-#line 15764 ""
+#line 15740 ""
*iccount = nextbl;
-#line 15765 ""
+#line 15741 ""
return 0;
-#line 15766 ""
+#line 15742 ""
}
-#line 15767 ""
+#line 15743 ""
L1:
-#line 15767 ""
+#line 15743 ""
getchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 15768 ""
+#line 15744 ""
if (*(unsigned char *)charq == 'B') {
/* "Both parts and score," ignore character */
-#line 15772 ""
+#line 15748 ""
goto L1;
-#line 15773 ""
+#line 15749 ""
} else if (*(unsigned char *)charq == ':') {
-#line 15774 ""
+#line 15750 ""
colon = TRUE_;
-#line 15775 ""
+#line 15751 ""
goto L1;
-#line 15776 ""
+#line 15752 ""
} else if (*(unsigned char *)charq == 'S') {
-#line 15777 ""
+#line 15753 ""
ess = TRUE_;
-#line 15778 ""
+#line 15754 ""
goto L1;
-#line 15779 ""
+#line 15755 ""
} else if (i_indx("+-.0123456789", charq, (ftnlen)13, (ftnlen)1) > 0) {
-#line 15780 ""
+#line 15756 ""
number = TRUE_;
-#line 15781 ""
+#line 15757 ""
if (*(unsigned char *)charq == '-') {
-#line 15781 ""
+#line 15757 ""
++(*iccount);
-#line 15781 ""
+#line 15757 ""
}
-#line 15782 ""
+#line 15758 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 15783 ""
+#line 15759 ""
if (*(unsigned char *)charq == '-') {
-#line 15783 ""
+#line 15759 ""
fnum = -fnum;
-#line 15783 ""
+#line 15759 ""
}
-#line 15784 ""
+#line 15760 ""
if (*(unsigned char *)durq != 'p') {
-#line 15785 ""
+#line 15761 ""
fnum *= *wheadpt;
-#line 15786 ""
+#line 15762 ""
--(*iccount);
-#line 15787 ""
+#line 15763 ""
}
-#line 15788 ""
+#line 15764 ""
goto L1;
-#line 15789 ""
+#line 15765 ""
}
/* charq must be blank, so done parsing */
-#line 15793 ""
+#line 15769 ""
if (! ess && ! colon) {
/* Ordinary hardspace. Goes before next note. */
/* (Later, at "|" or "/", check for presence and switch to udoff if there!) */
-#line 15798 ""
+#line 15774 ""
++comudsp_1.nudsp;
-#line 15799 ""
+#line 15775 ""
*iornq1 = bit_set(*iornq1,26);
-#line 15800 ""
+#line 15776 ""
comudsp_1.udsp[comudsp_1.nudsp - 1] = fnum;
-#line 15801 ""
+#line 15777 ""
comudsp_1.tudsp[comudsp_1.nudsp - 1] = (real) (*itsofar);
-#line 15802 ""
+#line 15778 ""
if (*ntup > 0) {
-#line 15802 ""
+#line 15778 ""
comudsp_1.tudsp[comudsp_1.nudsp - 1] += (real) (*itup - 1 + *
ndoub) / *ntup * ifnodur_(nnodur, dotq, (ftnlen)1);
-#line 15802 ""
+#line 15778 ""
}
/* * +float(itup-1)/ntup*ifnodur(nnodur,dotq) */
-#line 15805 ""
+#line 15781 ""
} else if (! number) {
/* Must be "X:" End a group offset. */
-#line 15809 ""
+#line 15785 ""
*irest = bit_set(*irest,17);
-#line 15810 ""
+#line 15786 ""
*shifton = FALSE_;
-#line 15811 ""
+#line 15787 ""
return 0;
-#line 15812 ""
+#line 15788 ""
} else {
/* Only other possibility is start offset, "S" for single, ':' for multiple */
-#line 15816 ""
+#line 15792 ""
++comudsp_1.nudoff[*ivx - 1];
-#line 15817 ""
+#line 15793 ""
comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25] = fnum;
-#line 15818 ""
+#line 15794 ""
if (ess) {
-#line 15819 ""
+#line 15795 ""
*irest1 = bit_set(*irest1,15);
-#line 15820 ""
+#line 15796 ""
} else {
-#line 15821 ""
+#line 15797 ""
*irest1 = bit_set(*irest1,16);
-#line 15822 ""
+#line 15798 ""
*shifton = TRUE_;
-#line 15823 ""
+#line 15799 ""
}
-#line 15824 ""
+#line 15800 ""
}
-#line 15825 ""
+#line 15801 ""
return 0;
} /* getx_ */
@@ -37469,75 +37709,75 @@ integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len)
extern /* Subroutine */ int stop1_(void);
/* Fortran I/O blocks */
+ static cilist io___917 = { 0, 6, 0, 0, 0 };
static cilist io___918 = { 0, 6, 0, 0, 0 };
- static cilist io___919 = { 0, 6, 0, 0, 0 };
-#line 15829 ""
+#line 15805 ""
if (*idur == 6) {
-#line 15830 ""
+#line 15806 ""
ret_val = 1;
-#line 15831 ""
+#line 15807 ""
} else if (*idur == 3) {
-#line 15832 ""
+#line 15808 ""
ret_val = 2;
-#line 15833 ""
+#line 15809 ""
} else if (*idur == 1) {
-#line 15834 ""
+#line 15810 ""
ret_val = 4;
-#line 15835 ""
+#line 15811 ""
} else if (*idur == 8) {
-#line 15836 ""
+#line 15812 ""
ret_val = 8;
-#line 15837 ""
+#line 15813 ""
} else if (*idur == 4) {
-#line 15838 ""
+#line 15814 ""
ret_val = 16;
-#line 15839 ""
+#line 15815 ""
} else if (*idur == 2) {
-#line 15840 ""
+#line 15816 ""
ret_val = 32;
-#line 15841 ""
+#line 15817 ""
} else if (*idur == 0) {
-#line 15842 ""
+#line 15818 ""
ret_val = 64;
-#line 15843 ""
+#line 15819 ""
} else if (*idur == 16) {
/* Only used for denominator of time signatures, not for notes */
-#line 15847 ""
+#line 15823 ""
ret_val = 4;
-#line 15848 ""
+#line 15824 ""
} else if (*idur == 9) {
-#line 15849 ""
+#line 15825 ""
ret_val = 128;
-#line 15850 ""
+#line 15826 ""
} else {
-#line 15851 ""
- s_wsle(&io___918);
-#line 15851 ""
+#line 15827 ""
+ s_wsle(&io___917);
+#line 15827 ""
e_wsle();
-#line 15852 ""
- s_wsle(&io___919);
-#line 15852 ""
+#line 15828 ""
+ s_wsle(&io___918);
+#line 15828 ""
do_lio(&c__9, &c__1, "You entered an invalid note-length value:", (
ftnlen)41);
-#line 15852 ""
+#line 15828 ""
do_lio(&c__3, &c__1, (char *)&(*idur), (ftnlen)sizeof(integer));
-#line 15852 ""
+#line 15828 ""
e_wsle();
-#line 15853 ""
+#line 15829 ""
stop1_();
-#line 15854 ""
+#line 15830 ""
}
-#line 15855 ""
+#line 15831 ""
if (*(unsigned char *)dotq == 'd') {
-#line 15855 ""
+#line 15831 ""
ret_val = ret_val * 3 / 2;
-#line 15855 ""
+#line 15831 ""
}
-#line 15856 ""
+#line 15832 ""
return ret_val;
} /* i1fnodur_ */
@@ -37555,9 +37795,9 @@ integer iashft_(integer *nacc)
/* System generated locals */
integer ret_val;
-#line 15866 ""
+#line 15842 ""
ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4];
-#line 15867 ""
+#line 15843 ""
return ret_val;
} /* iashft_ */
@@ -37572,67 +37812,67 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
/* Subroutine */ int s_stop(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___921 = { 0, 6, 0, 0, 0 };
+ static cilist io___920 = { 0, 6, 0, 0, 0 };
-#line 15871 ""
+#line 15847 ""
if (*idur == 6) {
-#line 15872 ""
+#line 15848 ""
ret_val = 1;
-#line 15873 ""
+#line 15849 ""
} else if (*idur == 3) {
-#line 15874 ""
+#line 15850 ""
ret_val = 2;
-#line 15875 ""
+#line 15851 ""
} else if (*idur == 1) {
-#line 15876 ""
+#line 15852 ""
ret_val = 4;
-#line 15877 ""
+#line 15853 ""
} else if (*idur == 8) {
-#line 15878 ""
+#line 15854 ""
ret_val = 8;
-#line 15879 ""
+#line 15855 ""
} else if (*idur == 4) {
-#line 15880 ""
+#line 15856 ""
ret_val = 16;
-#line 15881 ""
+#line 15857 ""
} else if (*idur == 2) {
-#line 15882 ""
+#line 15858 ""
ret_val = 32;
-#line 15883 ""
+#line 15859 ""
} else if (*idur == 0) {
-#line 15884 ""
+#line 15860 ""
ret_val = 64;
-#line 15885 ""
+#line 15861 ""
} else if (*idur == 9) {
-#line 15886 ""
+#line 15862 ""
ret_val = 128;
-#line 15887 ""
+#line 15863 ""
} else if (*idur == 16) {
/* Only used for denominator of time signatures, not for notes */
-#line 15891 ""
+#line 15867 ""
ret_val = 4;
-#line 15892 ""
+#line 15868 ""
} else {
-#line 15893 ""
- s_wsle(&io___921);
-#line 15893 ""
+#line 15869 ""
+ s_wsle(&io___920);
+#line 15869 ""
do_lio(&c__9, &c__1, "You entered an invalid note value", (ftnlen)33);
-#line 15893 ""
+#line 15869 ""
e_wsle();
-#line 15894 ""
+#line 15870 ""
s_stop("", (ftnlen)0);
-#line 15895 ""
+#line 15871 ""
}
-#line 15896 ""
+#line 15872 ""
if (*(unsigned char *)dotq == 'd') {
-#line 15896 ""
+#line 15872 ""
ret_val = ret_val * 3 / 2;
-#line 15896 ""
+#line 15872 ""
}
-#line 15897 ""
+#line 15873 ""
return ret_val;
} /* ifnodur_ */
@@ -37641,9 +37881,9 @@ integer ifnolev_(char *noq, integer *oct, integer *ntrans, ftnlen noq_len)
/* System generated locals */
integer ret_val;
-#line 15902 ""
+#line 15878 ""
ret_val = *oct * 7 + (*(unsigned char *)noq - 92) % 7 + 1 + *ntrans;
-#line 15903 ""
+#line 15879 ""
return ret_val;
} /* ifnolev_ */
@@ -37687,9 +37927,9 @@ integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift)
/* Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */
/* then added to ioff */
-#line 15938 ""
+#line 15914 ""
ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift));
-#line 15939 ""
+#line 15915 ""
return ret_val;
} /* igetbits_ */
@@ -37705,6 +37945,7 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer *
/* Local variables */
extern /* Subroutine */ int stop1_(void);
+ static integer mmidi4;
/* Fortran I/O blocks */
static cilist io___922 = { 0, 6, 0, 0, 0 };
@@ -37713,40 +37954,43 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer *
/* Gets variable-length integer starting in mmidi at imidi+1. Returns nbytes. */
-#line 15947 ""
+#line 15923 ""
/* Parameter adjustments */
-#line 15947 ""
+#line 15923 ""
mmidi -= 25;
-#line 15947 ""
+#line 15923 ""
-#line 15947 ""
+#line 15923 ""
/* Function Body */
-#line 15947 ""
+#line 15923 ""
ret_val = 0;
-#line 15948 ""
+#line 15924 ""
for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
-#line 15949 ""
- ret_val = (ret_val << 7) + (127 & mmidi[*icm + (*imidi + *nbytes) *
- 25]);
-#line 15951 ""
- if (! bit_test(mmidi[*icm + (*imidi + *nbytes) * 25],7)) {
-#line 15951 ""
+#line 15925 ""
+ mmidi4 = mmidi[*icm + (*imidi + *nbytes) * 25];
+#line 15926 ""
+ ret_val = (ret_val << 7) + (127 & mmidi4);
+/* * +iand(127,mmidi(icm,imidi+nbytes)) */
+/* if (.not.btest(mmidi(icm,imidi+nbytes),7)) return */
+#line 15930 ""
+ if (! bit_test(mmidi4,7)) {
+#line 15930 ""
return ret_val;
-#line 15951 ""
+#line 15930 ""
}
-#line 15952 ""
+#line 15931 ""
/* L1: */
-#line 15952 ""
+#line 15931 ""
}
-#line 15953 ""
+#line 15932 ""
s_wsle(&io___922);
-#line 15953 ""
+#line 15932 ""
do_lio(&c__9, &c__1, "Messup in igetvarlen", (ftnlen)20);
-#line 15953 ""
+#line 15932 ""
e_wsle();
-#line 15954 ""
+#line 15933 ""
stop1_();
-#line 15955 ""
+#line 15934 ""
return ret_val;
} /* igetvarlen_ */
@@ -37763,41 +38007,41 @@ logical isdotted_(integer *nodur, integer *ivx, integer *ip)
/* Function returns true if note is dotted or double-dotted. */
/* Return false for any xtuplet. */
-#line 15964 ""
+#line 15943 ""
/* Parameter adjustments */
-#line 15964 ""
+#line 15943 ""
nodur -= 25;
-#line 15964 ""
+#line 15943 ""
-#line 15964 ""
+#line 15943 ""
/* Function Body */
-#line 15964 ""
+#line 15943 ""
if (nodur[*ivx + *ip * 24] == 0) {
-#line 15965 ""
+#line 15944 ""
ret_val = FALSE_;
-#line 15966 ""
+#line 15945 ""
return ret_val;
-#line 15967 ""
+#line 15946 ""
} else if (*ip > 1) {
-#line 15968 ""
+#line 15947 ""
if (nodur[*ivx + (*ip - 1) * 24] == 0) {
-#line 15969 ""
+#line 15948 ""
ret_val = FALSE_;
-#line 15970 ""
+#line 15949 ""
return ret_val;
-#line 15971 ""
+#line 15950 ""
}
-#line 15972 ""
+#line 15951 ""
}
/* Ruled out all xtups, so is dotted or double-dotted if not a power of 2. */
-#line 15976 ""
+#line 15955 ""
r__1 = log((real) nodur[*ivx + *ip * 24]) / .69314718f + comtol_1.tol *
.5f;
-#line 15976 ""
+#line 15955 ""
ret_val = r_mod(&r__1, &c_b1053) > comtol_1.tol;
-#line 15978 ""
+#line 15957 ""
return ret_val;
} /* isdotted_ */
@@ -37819,43 +38063,43 @@ integer isetvarlen_(integer *idur, integer *nbytes)
static cilist io___924 = { 0, 6, 0, 0, 0 };
-#line 15981 ""
+#line 15960 ""
ret_val = 0;
-#line 15982 ""
+#line 15961 ""
itemp = *idur;
-#line 15983 ""
+#line 15962 ""
for (*nbytes = 1; *nbytes <= 4; ++(*nbytes)) {
-#line 15984 ""
+#line 15963 ""
i__1 = *nbytes - 1;
-#line 15984 ""
+#line 15963 ""
ret_val += (itemp & 127) * pow_ii(&c__256, &i__1);
-#line 15985 ""
+#line 15964 ""
itemp = lbit_shift(itemp, (ftnlen)-7);
-#line 15986 ""
+#line 15965 ""
if (itemp > 0) {
-#line 15987 ""
+#line 15966 ""
i__1 = (*nbytes << 3) + 7;
-#line 15987 ""
+#line 15966 ""
ret_val += pow_ii(&c__2, &i__1);
-#line 15988 ""
+#line 15967 ""
} else {
-#line 15989 ""
+#line 15968 ""
return ret_val;
-#line 15990 ""
+#line 15969 ""
}
-#line 15991 ""
+#line 15970 ""
/* L1: */
-#line 15991 ""
+#line 15970 ""
}
-#line 15992 ""
+#line 15971 ""
s_wsle(&io___924);
-#line 15992 ""
+#line 15971 ""
do_lio(&c__9, &c__1, "Problem in fn. isetvarlen", (ftnlen)25);
-#line 15992 ""
+#line 15971 ""
e_wsle();
-#line 15993 ""
+#line 15972 ""
stop1_();
-#line 15994 ""
+#line 15973 ""
return ret_val;
} /* isetvarlen_ */
@@ -37880,75 +38124,75 @@ integer isetvarlen_(integer *idur, integer *nbytes)
/* Returns string with integer only if length is 1, otherwise enclosed in */
/* brackets. */
-#line 16001 ""
+#line 15980 ""
if (*i__ != 0) {
-#line 16002 ""
+#line 15981 ""
r__1 = abs(*i__) * 1.0001f;
-#line 16002 ""
+#line 15981 ""
*len = r_lg10(&r__1) + 1;
-#line 16003 ""
+#line 15982 ""
if (*i__ < 0) {
-#line 16003 ""
+#line 15982 ""
++(*len);
-#line 16003 ""
+#line 15982 ""
}
-#line 16004 ""
+#line 15983 ""
} else {
-#line 16005 ""
+#line 15984 ""
s_copy(string, "0", string_len, (ftnlen)1);
-#line 16006 ""
+#line 15985 ""
*len = 1;
-#line 16007 ""
+#line 15986 ""
return 0;
-#line 16008 ""
+#line 15987 ""
}
-#line 16009 ""
+#line 15988 ""
if (*len == 1) {
-#line 16010 ""
+#line 15989 ""
*(unsigned char *)&ch__1[0] = *i__ + 48;
-#line 16010 ""
+#line 15989 ""
s_copy(string, ch__1, string_len, (ftnlen)1);
-#line 16011 ""
+#line 15990 ""
} else {
-#line 16012 ""
+#line 15991 ""
s_copy(string, "{", string_len, (ftnlen)1);
-#line 16013 ""
+#line 15992 ""
ici__1.icierr = 0;
-#line 16013 ""
+#line 15992 ""
ici__1.icirnum = 1;
-#line 16013 ""
+#line 15992 ""
ici__1.icirlen = *len;
-#line 16013 ""
+#line 15992 ""
ici__1.iciunit = string + 1;
/* Writing concatenation */
-#line 16013 ""
+#line 15992 ""
i__1[0] = 2, a__1[0] = "(i";
-#line 16013 ""
+#line 15992 ""
*(unsigned char *)&ch__1[0] = *len + 48;
-#line 16013 ""
+#line 15992 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 16013 ""
+#line 15992 ""
i__1[2] = 1, a__1[2] = ")";
-#line 16013 ""
+#line 15992 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)4), ch__2);
-#line 16013 ""
+#line 15992 ""
s_wsfi(&ici__1);
-#line 16013 ""
+#line 15992 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
-#line 16013 ""
+#line 15992 ""
e_wsfi();
/* Writing concatenation */
-#line 16014 ""
+#line 15993 ""
i__2[0] = *len + 1, a__2[0] = string;
-#line 16014 ""
+#line 15993 ""
i__2[1] = 1, a__2[1] = "}";
-#line 16014 ""
+#line 15993 ""
s_cat(string, a__2, i__2, &c__2, string_len);
-#line 16015 ""
+#line 15994 ""
*len += 2;
-#line 16016 ""
+#line 15995 ""
}
-#line 16017 ""
+#line 15996 ""
return 0;
} /* istring_ */
@@ -37957,21 +38201,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
/* System generated locals */
integer ret_val;
-#line 16021 ""
+#line 16000 ""
for (ret_val = *n; ret_val >= 1; --ret_val) {
-#line 16022 ""
+#line 16001 ""
if (*(unsigned char *)&string[ret_val - 1] != ' ') {
-#line 16022 ""
+#line 16001 ""
return ret_val;
-#line 16022 ""
+#line 16001 ""
}
-#line 16023 ""
+#line 16002 ""
/* L1: */
-#line 16023 ""
+#line 16002 ""
}
-#line 16024 ""
+#line 16003 ""
ret_val = 0;
-#line 16025 ""
+#line 16004 ""
return ret_val;
} /* lenstr_ */
@@ -37988,45 +38232,45 @@ integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm,
/* Used for placing numbers in xtups. Returns note level if not a rest, */
/* else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. */
-#line 16033 ""
+#line 16012 ""
if (! bit_test(*irest,0)) {
-#line 16034 ""
+#line 16013 ""
ret_val = *nolev;
-#line 16035 ""
+#line 16014 ""
} else {
/* Restlevel is -4, 0, 2 or 100+offset. First get offset from 1-voice default. */
-#line 16039 ""
+#line 16018 ""
if (*mult > 0) {
-#line 16040 ""
+#line 16019 ""
if (*mult == 2) {
-#line 16041 ""
+#line 16020 ""
ioff = (*iud << 1) - 1;
-#line 16042 ""
+#line 16021 ""
} else if (*mult != 4) {
-#line 16043 ""
+#line 16022 ""
ioff = *iud * *mult;
-#line 16044 ""
+#line 16023 ""
} else {
-#line 16045 ""
+#line 16024 ""
ioff = (*iud << 2) + 1;
-#line 16046 ""
+#line 16025 ""
}
-#line 16047 ""
+#line 16026 ""
} else {
/* May need to futz with this later for non-beamed xtups (quarter, half rests) */
-#line 16051 ""
+#line 16030 ""
ioff = *iud << 1;
-#line 16052 ""
+#line 16031 ""
}
-#line 16053 ""
+#line 16032 ""
ret_val = (*nolev + 20) % 100 - 20 + *ncm + ioff;
-#line 16054 ""
+#line 16033 ""
}
-#line 16055 ""
+#line 16034 ""
return ret_val;
} /* levrn_ */
@@ -38046,29 +38290,29 @@ integer lfmt1_(real *x)
/* Computes total length of an "f" format with one decimal place. */
/* First round to nearest 0.1 */
-#line 16062 ""
+#line 16041 ""
if (dabs(*x) < .001f) {
-#line 16063 ""
+#line 16042 ""
ret_val = 2;
-#line 16064 ""
+#line 16043 ""
} else {
-#line 16065 ""
+#line 16044 ""
r__1 = (integer) (dabs(*x) * 10 + .5f) * .1f;
-#line 16065 ""
+#line 16044 ""
y = r_sign(&r__1, x);
-#line 16066 ""
+#line 16045 ""
r__1 = dabs(y) * 1000 + .001f;
-#line 16066 ""
+#line 16045 ""
ret_val = (integer) r_lg10(&r__1);
-#line 16067 ""
+#line 16046 ""
if (y < 0.f) {
-#line 16067 ""
+#line 16046 ""
++ret_val;
-#line 16067 ""
+#line 16046 ""
}
-#line 16068 ""
+#line 16047 ""
}
-#line 16069 ""
+#line 16048 ""
return ret_val;
} /* lfmt1_ */
@@ -38120,300 +38364,300 @@ integer lfmt1_(real *x)
/* closing of full tie are not used except for shape alterations. */
/* do 1 ndx = 0 , 11 */
-#line 16094 ""
+#line 16073 ""
/* Parameter adjustments */
-#line 16094 ""
+#line 16073 ""
--sepsymq;
-#line 16094 ""
+#line 16073 ""
--isdat4;
-#line 16094 ""
+#line 16073 ""
--isdat3;
-#line 16094 ""
+#line 16073 ""
--isdat2;
-#line 16094 ""
+#line 16073 ""
--isdat1;
-#line 16094 ""
+#line 16073 ""
-#line 16094 ""
+#line 16073 ""
/* Function Body */
-#line 16094 ""
+#line 16073 ""
for (ndx = 0; ndx <= 23; ++ndx) {
-#line 16095 ""
+#line 16074 ""
if (bit_test(comslur_1.listslur,ndx)) {
/* Slur or tie with index ndx is open. Find the one with right ndxb, see if tie */
-#line 16099 ""
+#line 16078 ""
i__1 = *nsdat;
-#line 16099 ""
+#line 16078 ""
for (isdat = 1; isdat <= i__1; ++isdat) {
/* if (igetbits(isdat1(isdat),4,28) .ne. ndx) go to 2 ! Wrong index */
-#line 16101 ""
+#line 16080 ""
if (igetbits_(&isdat1[isdat], &c__4, &c__28) + (igetbits_(&
isdat1[isdat], &c__1, &c__18) << 4) != ndx) {
-#line 16101 ""
+#line 16080 ""
goto L2;
-#line 16101 ""
+#line 16080 ""
}
/* Wron */
-#line 16103 ""
+#line 16082 ""
if (! bit_test(isdat1[isdat],11)) {
-#line 16103 ""
+#line 16082 ""
goto L2;
-#line 16103 ""
+#line 16082 ""
}
/* Bypass if stop */
-#line 16104 ""
+#line 16083 ""
if (bit_test(isdat2[isdat],3)) {
-#line 16104 ""
+#line 16083 ""
goto L3;
-#line 16104 ""
+#line 16083 ""
}
/* "st" */
-#line 16105 ""
+#line 16084 ""
idcode = igetbits_(&isdat1[isdat], &c__7, &c__19);
-#line 16106 ""
+#line 16085 ""
if (idcode == 1) {
-#line 16106 ""
+#line 16085 ""
goto L3;
-#line 16106 ""
+#line 16085 ""
}
/* "t" */
-#line 16107 ""
+#line 16086 ""
tie = FALSE_;
-#line 16108 ""
+#line 16087 ""
goto L5;
-#line 16109 ""
+#line 16088 ""
L2:
-#line 16109 ""
+#line 16088 ""
;
-#line 16109 ""
+#line 16088 ""
}
-#line 16110 ""
+#line 16089 ""
}
-#line 16111 ""
+#line 16090 ""
goto L1;
-#line 16112 ""
+#line 16091 ""
L3:
-#line 16113 ""
+#line 16092 ""
tie = TRUE_;
-#line 16114 ""
+#line 16093 ""
L5:
/* A slur or tie is open, with index ndx */
-#line 16118 ""
+#line 16097 ""
iv = igetbits_(&isdat1[isdat], &c__5, &c__13);
-#line 16119 ""
+#line 16098 ""
kv = igetbits_(&isdat1[isdat], &c__1, &c__12) + 1;
-#line 16120 ""
+#line 16099 ""
*(unsigned char *)udq = 'd';
-#line 16121 ""
+#line 16100 ""
if (bit_test(isdat1[isdat],27)) {
-#line 16121 ""
+#line 16100 ""
*(unsigned char *)udq = 'u';
-#line 16121 ""
+#line 16100 ""
}
/* Writing concatenation */
-#line 16122 ""
+#line 16101 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16122 ""
+#line 16101 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 16122 ""
+#line 16101 ""
i__2[1] = 6, a__1[1] = "znotes";
-#line 16122 ""
+#line 16101 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16123 ""
+#line 16102 ""
lnote = 7;
-#line 16124 ""
+#line 16103 ""
i__1 = iv - 1;
-#line 16124 ""
+#line 16103 ""
for (iiv = 1; iiv <= i__1; ++iiv) {
/* Writing concatenation */
-#line 16125 ""
+#line 16104 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16125 ""
+#line 16104 ""
i__2[1] = 1, a__1[1] = sepsymq + iiv;
-#line 16125 ""
+#line 16104 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16126 ""
+#line 16105 ""
++lnote;
-#line 16127 ""
+#line 16106 ""
/* L4: */
-#line 16127 ""
+#line 16106 ""
}
-#line 16128 ""
+#line 16107 ""
if (kv == 2) {
/* Writing concatenation */
-#line 16129 ""
+#line 16108 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 16129 ""
+#line 16108 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16129 ""
+#line 16108 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 16129 ""
+#line 16108 ""
i__3[2] = 9, a__2[2] = "nextvoice";
-#line 16129 ""
+#line 16108 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16130 ""
+#line 16109 ""
lnote += 10;
-#line 16131 ""
+#line 16110 ""
}
/* Compute horiz and vert offsets */
/* nolev = igetbits(isdat2(isdat),7,19) */
-#line 16136 ""
+#line 16115 ""
islhgt = igetbits_(&isdat3[isdat], &c__8, &c__14);
-#line 16137 ""
+#line 16116 ""
ilb12 = 0;
-#line 16138 ""
+#line 16117 ""
if (*ispstie) {
-#line 16138 ""
+#line 16117 ""
ilb12 = 1;
-#line 16138 ""
+#line 16117 ""
}
-#line 16139 ""
+#line 16118 ""
i__1 = ilb12 << 4;
-#line 16139 ""
+#line 16118 ""
ivoff = igetbits_(&isdat4[isdat], &c__6, &i__1) - 32;
-#line 16140 ""
+#line 16119 ""
if (ivoff == -32) {
-#line 16140 ""
+#line 16119 ""
ivoff = 0;
-#line 16140 ""
+#line 16119 ""
}
/* nolev = nolev+ivoff */
-#line 16142 ""
+#line 16121 ""
islhgt += ivoff;
-#line 16143 ""
+#line 16122 ""
i__1 = (ilb12 << 4) + 6;
-#line 16143 ""
+#line 16122 ""
ihoff = igetbits_(&isdat4[isdat], &c__7, &i__1) - 64;
/* This is 10X */
-#line 16144 ""
+#line 16123 ""
if (ihoff == -64) {
-#line 16144 ""
+#line 16123 ""
ihoff = 0;
-#line 16144 ""
+#line 16123 ""
}
/* Add starting stuff for command */
-#line 16148 ""
+#line 16127 ""
if (! (*ispstie)) {
/* End 1st segment */
/* Writing concatenation */
-#line 16149 ""
+#line 16128 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 16149 ""
+#line 16128 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16149 ""
+#line 16128 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 16149 ""
+#line 16128 ""
i__3[2] = 8, a__2[2] = "roffset{";
-#line 16149 ""
+#line 16128 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16150 ""
+#line 16129 ""
lnote += 9;
/* hoff = ihoff*.1-.5 */
/* hoff = ihoff*.1-.8 */
-#line 16153 ""
+#line 16132 ""
hoff = ihoff * .1f - .4f;
-#line 16154 ""
+#line 16133 ""
if (hoff < 0.f) {
-#line 16155 ""
+#line 16134 ""
hoff = -hoff;
/* Writing concatenation */
-#line 16156 ""
+#line 16135 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16156 ""
+#line 16135 ""
i__2[1] = 1, a__1[1] = "-";
-#line 16156 ""
+#line 16135 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16157 ""
+#line 16136 ""
++lnote;
-#line 16158 ""
+#line 16137 ""
}
-#line 16159 ""
+#line 16138 ""
writflot_(&hoff, notexq, &lnote, (ftnlen)128);
/* Writing concatenation */
-#line 16160 ""
+#line 16139 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16160 ""
+#line 16139 ""
i__2[1] = 2, a__1[1] = "}{";
-#line 16160 ""
+#line 16139 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16161 ""
+#line 16140 ""
lnote += 2;
-#line 16162 ""
+#line 16141 ""
} else {
/* Writing concatenation */
-#line 16163 ""
+#line 16142 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 16163 ""
+#line 16142 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16163 ""
+#line 16142 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 16163 ""
+#line 16142 ""
i__4[2] = 5, a__3[2] = "off{-";
-#line 16163 ""
+#line 16142 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 16163 ""
+#line 16142 ""
i__4[3] = 1, a__3[3] = ch__2;
-#line 16163 ""
+#line 16142 ""
i__4[4] = 14, a__3[4] = "afterruleskip}";
-#line 16163 ""
+#line 16142 ""
s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
-#line 16165 ""
+#line 16144 ""
lnote += 21;
/* 091025 add dotting for 2nd segment if needed */
-#line 16169 ""
+#line 16148 ""
if (bit_test(isdat2[isdat],4)) {
/* Writing concatenation */
-#line 16170 ""
+#line 16149 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16170 ""
+#line 16149 ""
i__3[0] = 1, a__2[0] = ch__1;
-#line 16170 ""
+#line 16149 ""
i__3[1] = 6, a__2[1] = "dotted";
-#line 16170 ""
+#line 16149 ""
i__3[2] = lnote, a__2[2] = notexq;
-#line 16170 ""
+#line 16149 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16171 ""
+#line 16150 ""
lnote += 7;
-#line 16172 ""
+#line 16151 ""
}
-#line 16173 ""
+#line 16152 ""
}
-#line 16174 ""
+#line 16153 ""
if (*ispstie && tie) {
/* Writing concatenation */
-#line 16175 ""
+#line 16154 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16175 ""
+#line 16154 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16175 ""
+#line 16154 ""
i__5[1] = 1, a__4[1] = ch__1;
-#line 16175 ""
+#line 16154 ""
i__5[2] = 8, a__4[2] = "tieforis";
-#line 16175 ""
+#line 16154 ""
i__5[3] = 1, a__4[3] = udq;
-#line 16175 ""
+#line 16154 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16176 ""
+#line 16155 ""
lnote += 10;
-#line 16177 ""
+#line 16156 ""
}
-#line 16178 ""
+#line 16157 ""
if (bit_test(isdat3[isdat],0)) {
/* Curvature tweak on termination of 1st seg */
-#line 16182 ""
+#line 16161 ""
imid = igetbits_(&isdat3[isdat], &c__6, &c__2) - 32;
/* Invoke macro (from pmx.tex) that redefines \tslur as r'qd. mapping: */
@@ -38424,82 +38668,82 @@ L5:
/* 6 HH */
/* Writing concatenation */
-#line 16191 ""
+#line 16170 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16191 ""
+#line 16170 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16191 ""
+#line 16170 ""
i__5[1] = 1, a__4[1] = ch__1;
-#line 16191 ""
+#line 16170 ""
i__5[2] = 7, a__4[2] = "psforts";
-#line 16191 ""
+#line 16170 ""
i__1 = imid + 48;
-#line 16191 ""
+#line 16170 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 16191 ""
+#line 16170 ""
i__5[3] = 1, a__4[3] = ch__2;
-#line 16191 ""
+#line 16170 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16192 ""
+#line 16171 ""
lnote += 9;
/* Zero out the flag in case there's a different curv on term of 2nd, */
-#line 16196 ""
+#line 16175 ""
isdat3[isdat] = bit_clear(isdat3[isdat],0);
-#line 16197 ""
+#line 16176 ""
}
/* Add the command name */
-#line 16201 ""
+#line 16180 ""
if (*ispstie) {
/* Writing concatenation */
-#line 16202 ""
+#line 16181 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16202 ""
+#line 16181 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16202 ""
+#line 16181 ""
i__5[1] = 1, a__4[1] = ch__1;
-#line 16202 ""
+#line 16181 ""
i__5[2] = 2, a__4[2] = "is";
-#line 16202 ""
+#line 16181 ""
i__5[3] = 1, a__4[3] = udq;
-#line 16202 ""
+#line 16181 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16203 ""
+#line 16182 ""
lnote += 4;
-#line 16204 ""
+#line 16183 ""
} else if (tie) {
/* Writing concatenation */
-#line 16205 ""
+#line 16184 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 16205 ""
+#line 16184 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16205 ""
+#line 16184 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 16205 ""
+#line 16184 ""
i__3[2] = 4, a__2[2] = "ttie";
-#line 16205 ""
+#line 16184 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16206 ""
+#line 16185 ""
lnote += 5;
-#line 16207 ""
+#line 16186 ""
} else {
/* Writing concatenation */
-#line 16208 ""
+#line 16187 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 16208 ""
+#line 16187 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16208 ""
+#line 16187 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 16208 ""
+#line 16187 ""
i__3[2] = 5, a__2[2] = "tslur";
-#line 16208 ""
+#line 16187 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16209 ""
+#line 16188 ""
lnote += 6;
-#line 16210 ""
+#line 16189 ""
}
/* Add index */
@@ -38511,214 +38755,214 @@ L5:
/* notexq = notexq(1:lnote)//'{1'//chax(49-ndx)//'}' */
/* lnote = lnote+4 */
/* end if */
-#line 16221 ""
+#line 16200 ""
if (23 - ndx < 10) {
/* Writing concatenation */
-#line 16222 ""
+#line 16201 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16222 ""
+#line 16201 ""
i__1 = 71 - ndx;
-#line 16222 ""
+#line 16201 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 16222 ""
+#line 16201 ""
i__2[1] = 1, a__1[1] = ch__1;
-#line 16222 ""
+#line 16201 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16223 ""
+#line 16202 ""
++lnote;
-#line 16224 ""
+#line 16203 ""
} else if (23 - ndx < 20) {
/* Writing concatenation */
-#line 16225 ""
+#line 16204 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16225 ""
+#line 16204 ""
i__5[1] = 2, a__4[1] = "{1";
-#line 16225 ""
+#line 16204 ""
i__1 = 61 - ndx;
-#line 16225 ""
+#line 16204 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 16225 ""
+#line 16204 ""
i__5[2] = 1, a__4[2] = ch__1;
-#line 16225 ""
+#line 16204 ""
i__5[3] = 1, a__4[3] = "}";
-#line 16225 ""
+#line 16204 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16226 ""
+#line 16205 ""
lnote += 4;
-#line 16227 ""
+#line 16206 ""
} else {
/* Writing concatenation */
-#line 16228 ""
+#line 16207 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16228 ""
+#line 16207 ""
i__5[1] = 2, a__4[1] = "{2";
-#line 16228 ""
+#line 16207 ""
i__1 = 51 - ndx;
-#line 16228 ""
+#line 16207 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 16228 ""
+#line 16207 ""
i__5[2] = 1, a__4[2] = ch__1;
-#line 16228 ""
+#line 16207 ""
i__5[3] = 1, a__4[3] = "}";
-#line 16228 ""
+#line 16207 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16229 ""
+#line 16208 ""
lnote += 4;
-#line 16230 ""
+#line 16209 ""
}
-#line 16231 ""
+#line 16210 ""
if (*ispstie || ! tie) {
/* Add note name for slur height */
-#line 16235 ""
+#line 16214 ""
comoct_1.noctup = 0;
-#line 16236 ""
+#line 16215 ""
ncm = igetbits_(&isdat3[isdat], &c__8, &c__22);
-#line 16237 ""
+#line 16216 ""
if (ncm == 23) {
-#line 16237 ""
+#line 16216 ""
comoct_1.noctup = -2;
-#line 16237 ""
+#line 16216 ""
}
/* call notefq(noteq,lnoten,nolev,ncm) */
-#line 16239 ""
+#line 16218 ""
notefq_(noteq, &lnoten, &islhgt, &ncm, (ftnlen)8);
/* Writing concatenation */
-#line 16240 ""
+#line 16219 ""
i__5[0] = lnote, a__4[0] = notexq;
-#line 16240 ""
+#line 16219 ""
i__5[1] = 1, a__4[1] = "{";
-#line 16240 ""
+#line 16219 ""
i__5[2] = lnoten, a__4[2] = noteq;
-#line 16240 ""
+#line 16219 ""
i__5[3] = 1, a__4[3] = "}";
-#line 16240 ""
+#line 16219 ""
s_cat(notexq, a__4, i__5, &c__4, (ftnlen)128);
-#line 16241 ""
+#line 16220 ""
lnote = lnote + 1 + lnoten + 1;
-#line 16242 ""
+#line 16221 ""
}
-#line 16243 ""
+#line 16222 ""
if (*ispstie) {
/* Horizontal shift start of new thing */
/* Writing concatenation */
-#line 16247 ""
+#line 16226 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16247 ""
+#line 16226 ""
i__2[1] = 1, a__1[1] = "{";
-#line 16247 ""
+#line 16226 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16248 ""
+#line 16227 ""
++lnote;
/* ihoff = ihoff-13 */
-#line 16250 ""
+#line 16229 ""
if (tie) {
-#line 16251 ""
+#line 16230 ""
ihoff += -12;
-#line 16252 ""
+#line 16231 ""
} else {
-#line 16253 ""
+#line 16232 ""
ihoff += -7;
-#line 16254 ""
+#line 16233 ""
}
-#line 16255 ""
+#line 16234 ""
if (ihoff < 0) {
-#line 16256 ""
+#line 16235 ""
ihoff = -ihoff;
/* Writing concatenation */
-#line 16257 ""
+#line 16236 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16257 ""
+#line 16236 ""
i__2[1] = 1, a__1[1] = "-";
-#line 16257 ""
+#line 16236 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16258 ""
+#line 16237 ""
++lnote;
-#line 16259 ""
+#line 16238 ""
}
-#line 16260 ""
+#line 16239 ""
r__1 = ihoff * .1f;
-#line 16260 ""
+#line 16239 ""
writflot_(&r__1, notexq, &lnote, (ftnlen)128);
/* Writing concatenation */
-#line 16261 ""
+#line 16240 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16261 ""
+#line 16240 ""
i__2[1] = 1, a__1[1] = "}";
-#line 16261 ""
+#line 16240 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16262 ""
+#line 16241 ""
++lnote;
-#line 16263 ""
+#line 16242 ""
}
/* Add closing stuff */
-#line 16267 ""
+#line 16246 ""
if (*ispstie) {
/* Writing concatenation */
-#line 16268 ""
+#line 16247 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 16268 ""
+#line 16247 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16268 ""
+#line 16247 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 16268 ""
+#line 16247 ""
i__4[2] = 4, a__3[2] = "off{";
-#line 16268 ""
+#line 16247 ""
chax_(ch__2, (ftnlen)1, &c__92);
-#line 16268 ""
+#line 16247 ""
i__4[3] = 1, a__3[3] = ch__2;
-#line 16268 ""
+#line 16247 ""
i__4[4] = 14, a__3[4] = "afterruleskip}";
-#line 16268 ""
+#line 16247 ""
s_cat(notexq, a__3, i__4, &c__5, (ftnlen)128);
-#line 16270 ""
+#line 16249 ""
lnote += 20;
-#line 16271 ""
+#line 16250 ""
} else {
/* Writing concatenation */
-#line 16272 ""
+#line 16251 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 16272 ""
+#line 16251 ""
i__2[1] = 1, a__1[1] = "}";
-#line 16272 ""
+#line 16251 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)128);
-#line 16273 ""
+#line 16252 ""
++lnote;
-#line 16274 ""
+#line 16253 ""
}
/* Writing concatenation */
-#line 16275 ""
+#line 16254 ""
i__3[0] = lnote, a__2[0] = notexq;
-#line 16275 ""
+#line 16254 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16275 ""
+#line 16254 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 16275 ""
+#line 16254 ""
i__3[2] = 3, a__2[2] = "en%";
-#line 16275 ""
+#line 16254 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)128);
-#line 16276 ""
+#line 16255 ""
lnote += 4;
-#line 16277 ""
+#line 16256 ""
s_wsfe(&io___946);
-#line 16277 ""
+#line 16256 ""
do_fio(&c__1, notexq, lnote);
-#line 16277 ""
+#line 16256 ""
e_wsfe();
-#line 16278 ""
+#line 16257 ""
L1:
-#line 16278 ""
+#line 16257 ""
;
-#line 16278 ""
+#line 16257 ""
}
-#line 16279 ""
+#line 16258 ""
*ispstie = ! (*ispstie);
-#line 16280 ""
+#line 16259 ""
return 0;
} /* linebreakties_ */
@@ -38754,243 +38998,243 @@ L1:
static cilist io___954 = { 0, 16, 0, "(a)", 0 };
-#line 16298 ""
+#line 16277 ""
/* Parameter adjustments */
-#line 16298 ""
+#line 16277 ""
islur -= 25;
-#line 16298 ""
+#line 16277 ""
-#line 16298 ""
+#line 16277 ""
/* Function Body */
-#line 16298 ""
+#line 16277 ""
merge = FALSE_;
-#line 16299 ""
+#line 16278 ""
if (comgrace_1.nlit > 0) {
-#line 16300 ""
+#line 16279 ""
merge = *iv == comgrace_1.ivlit[comgrace_1.nlit - 1] && *nnl ==
comgrace_1.iplit[comgrace_1.nlit - 1];
-#line 16301 ""
+#line 16280 ""
}
-#line 16302 ""
+#line 16281 ""
++comgrace_1.nlit;
-#line 16303 ""
+#line 16282 ""
comgrace_1.ivlit[comgrace_1.nlit - 1] = *iv;
-#line 16304 ""
+#line 16283 ""
comgrace_1.iplit[comgrace_1.nlit - 1] = *nnl;
-#line 16305 ""
+#line 16284 ""
itype = 1;
-#line 16306 ""
+#line 16285 ""
L17:
-#line 16306 ""
+#line 16285 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 16307 ""
+#line 16286 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16307 ""
+#line 16286 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
-#line 16308 ""
+#line 16287 ""
++itype;
-#line 16309 ""
+#line 16288 ""
goto L17;
-#line 16310 ""
+#line 16289 ""
}
/* Writing concatenation */
-#line 16311 ""
+#line 16290 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16311 ""
+#line 16290 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 16311 ""
+#line 16290 ""
i__1[1] = 1, a__1[1] = durq;
-#line 16311 ""
+#line 16290 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2, (
ftnlen)128);
-#line 16312 ""
+#line 16291 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] = 2;
-#line 16313 ""
+#line 16292 ""
L18:
-#line 16313 ""
+#line 16292 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 16314 ""
+#line 16293 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16314 ""
+#line 16293 ""
if (*(unsigned char *)durq == *(unsigned char *)&ch__1[0]) {
-#line 16315 ""
+#line 16294 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 16316 ""
+#line 16295 ""
if (*(unsigned char *)durq != ' ') {
/* Starting a new tex command within the string */
/* Writing concatenation */
-#line 16320 ""
+#line 16299 ""
i__2[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__2[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
-#line 16320 ""
+#line 16299 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 16320 ""
+#line 16299 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 16320 ""
+#line 16299 ""
i__2[2] = 1, a__2[2] = durq;
-#line 16320 ""
+#line 16299 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__2, i__2, &
c__3, (ftnlen)128);
-#line 16321 ""
+#line 16300 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] += 2;
-#line 16322 ""
+#line 16301 ""
goto L18;
-#line 16323 ""
+#line 16302 ""
}
-#line 16324 ""
+#line 16303 ""
} else {
/* Writing concatenation */
-#line 16325 ""
+#line 16304 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
-#line 16325 ""
+#line 16304 ""
i__1[1] = 1, a__1[1] = durq;
-#line 16325 ""
+#line 16304 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &c__2,
(ftnlen)128);
-#line 16326 ""
+#line 16305 ""
++comgrace_1.lenlit[comgrace_1.nlit - 1];
-#line 16327 ""
+#line 16306 ""
goto L18;
-#line 16328 ""
+#line 16307 ""
}
/* If here, just read backslash-blank so string is done */
-#line 16332 ""
+#line 16311 ""
if (itype == 1) {
-#line 16333 ""
+#line 16312 ""
islur[*iv + *nnl * 24] = bit_set(islur[*iv + *nnl * 24],16);
-#line 16334 ""
+#line 16313 ""
if (merge) {
/* There are 2 separate strings on the same note, so merge them. */
-#line 16338 ""
+#line 16317 ""
--comgrace_1.nlit;
/* Writing concatenation */
-#line 16339 ""
+#line 16318 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
-#line 16339 ""
+#line 16318 ""
i__1[1] = comgrace_1.lenlit[comgrace_1.nlit], a__1[1] =
comgrace_1.litq + (comgrace_1.nlit << 7);
-#line 16339 ""
+#line 16318 ""
s_cat(comgrace_1.litq + (comgrace_1.nlit - 1 << 7), a__1, i__1, &
c__2, (ftnlen)128);
-#line 16341 ""
+#line 16320 ""
comgrace_1.lenlit[comgrace_1.nlit - 1] += comgrace_1.lenlit[
comgrace_1.nlit];
-#line 16342 ""
+#line 16321 ""
if (comgrace_1.lenlit[comgrace_1.nlit - 1] > 128) {
-#line 16343 ""
+#line 16322 ""
s_wsle(&io___950);
-#line 16343 ""
+#line 16322 ""
e_wsle();
-#line 16344 ""
+#line 16323 ""
s_wsle(&io___951);
-#line 16344 ""
+#line 16323 ""
do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than "\
"128 characters", (ftnlen)52);
-#line 16344 ""
+#line 16323 ""
e_wsle();
-#line 16346 ""
+#line 16325 ""
s_wsfe(&io___952);
-#line 16346 ""
+#line 16325 ""
do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha"\
"racters", (ftnlen)52);
-#line 16346 ""
+#line 16325 ""
e_wsfe();
-#line 16348 ""
+#line 16327 ""
stop1_();
-#line 16349 ""
+#line 16328 ""
}
-#line 16350 ""
+#line 16329 ""
}
-#line 16351 ""
+#line 16330 ""
} else {
/* Type 2 or 3. */
-#line 16355 ""
+#line 16334 ""
if (itype == 3) {
/* Write the string NOW */
-#line 16359 ""
+#line 16338 ""
if (comlast_1.islast) {
-#line 16359 ""
+#line 16338 ""
s_wsfe(&io___953);
/* Writing concatenation */
-#line 16359 ""
+#line 16338 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
-#line 16359 ""
+#line 16338 ""
i__1[1] = 1, a__1[1] = "%";
-#line 16359 ""
+#line 16338 ""
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
-#line 16359 ""
+#line 16338 ""
do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] +
1);
-#line 16359 ""
+#line 16338 ""
e_wsfe();
-#line 16359 ""
+#line 16338 ""
}
-#line 16361 ""
+#line 16340 ""
} else {
/* Must go at top */
-#line 16365 ""
+#line 16344 ""
if (! (*topmods)) {
-#line 16366 ""
+#line 16345 ""
*topmods = TRUE_;
-#line 16367 ""
+#line 16346 ""
o__1.oerr = 0;
-#line 16367 ""
+#line 16346 ""
o__1.ounit = 16;
-#line 16367 ""
+#line 16346 ""
o__1.ofnm = 0;
-#line 16367 ""
+#line 16346 ""
o__1.orl = 0;
-#line 16367 ""
+#line 16346 ""
o__1.osta = "SCRATCH";
-#line 16367 ""
+#line 16346 ""
o__1.oacc = 0;
-#line 16367 ""
+#line 16346 ""
o__1.ofm = 0;
-#line 16367 ""
+#line 16346 ""
o__1.oblnk = 0;
-#line 16367 ""
+#line 16346 ""
f_open(&o__1);
-#line 16368 ""
+#line 16347 ""
}
/* Must write '%' here rather than later, in case string ends with blank. */
-#line 16372 ""
+#line 16351 ""
s_wsfe(&io___954);
/* Writing concatenation */
-#line 16372 ""
+#line 16351 ""
i__1[0] = comgrace_1.lenlit[comgrace_1.nlit - 1], a__1[0] =
comgrace_1.litq + (comgrace_1.nlit - 1 << 7);
-#line 16372 ""
+#line 16351 ""
i__1[1] = 1, a__1[1] = "%";
-#line 16372 ""
+#line 16351 ""
s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)129);
-#line 16372 ""
+#line 16351 ""
do_fio(&c__1, ch__2, comgrace_1.lenlit[comgrace_1.nlit - 1] + 1);
-#line 16372 ""
+#line 16351 ""
e_wsfe();
-#line 16373 ""
+#line 16352 ""
}
-#line 16374 ""
+#line 16353 ""
--comgrace_1.nlit;
-#line 16375 ""
+#line 16354 ""
}
-#line 16376 ""
+#line 16355 ""
return 0;
} /* littex_ */
@@ -38999,19 +39243,19 @@ integer llen_(char *strq, integer *n, ftnlen strq_len)
/* System generated locals */
integer ret_val;
-#line 16380 ""
+#line 16359 ""
for (ret_val = *n; ret_val >= 0; --ret_val) {
-#line 16381 ""
+#line 16360 ""
if (*(unsigned char *)&strq[ret_val - 1] != ' ') {
-#line 16381 ""
+#line 16360 ""
return ret_val;
-#line 16381 ""
+#line 16360 ""
}
-#line 16382 ""
+#line 16361 ""
/* L1: */
-#line 16382 ""
+#line 16361 ""
}
-#line 16383 ""
+#line 16362 ""
return ret_val;
} /* llen_ */
@@ -39028,9 +39272,9 @@ integer log2_(integer *n)
/* log2 = alog(1.*n)/0.6931472+.0001 */
/* log2 = dlog(1.d0*n)/0.693147181d0+.00000001d0 */
-#line 16390 ""
+#line 16369 ""
ret_val = (integer) (log(*n * 1.) / .693147181 + 2e-8);
-#line 16391 ""
+#line 16370 ""
return ret_val;
} /* log2_ */
@@ -39058,242 +39302,242 @@ integer log2_(integer *n)
extern /* Subroutine */ int setbits_(integer *, integer *, integer *,
integer *);
-#line 16410 ""
+#line 16389 ""
all_1.ibm1[commvl_1.ivx + *numnew * 24 - 25] = *nip1;
-#line 16411 ""
+#line 16390 ""
all_1.ibm2[commvl_1.ivx + *numnew * 24 - 25] = *nip2;
-#line 16412 ""
+#line 16391 ""
numnow = *numnew;
-#line 16413 ""
+#line 16392 ""
if (*numnew > 1) {
/* If it starts before any others, must put it in order */
-#line 16417 ""
+#line 16396 ""
for (ib = *numnew - 1; ib >= 1; --ib) {
-#line 16418 ""
+#line 16397 ""
if (all_1.ibm1[commvl_1.ivx + ib * 24 - 25] < *nip1) {
-#line 16418 ""
+#line 16397 ""
goto L12;
-#line 16418 ""
+#line 16397 ""
}
-#line 16419 ""
+#line 16398 ""
all_1.ibm1[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm1[
commvl_1.ivx + ib * 24 - 25];
-#line 16420 ""
+#line 16399 ""
all_1.ibm2[commvl_1.ivx + (ib + 1) * 24 - 25] = all_1.ibm2[
commvl_1.ivx + ib * 24 - 25];
-#line 16421 ""
+#line 16400 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + (ib + 1) * 24 - 25] =
*(unsigned char *)&all_1.ulq[commvl_1.ivx + ib * 24 - 25];
-#line 16422 ""
+#line 16401 ""
all_1.ibm1[commvl_1.ivx + ib * 24 - 25] = *nip1;
-#line 16423 ""
+#line 16402 ""
all_1.ibm2[commvl_1.ivx + ib * 24 - 25] = *nip2;
-#line 16424 ""
+#line 16403 ""
numnow = ib;
-#line 16425 ""
+#line 16404 ""
/* L11: */
-#line 16425 ""
+#line 16404 ""
}
-#line 16426 ""
+#line 16405 ""
L12:
-#line 16427 ""
+#line 16406 ""
;
-#line 16427 ""
+#line 16406 ""
}
-#line 16428 ""
+#line 16407 ""
sum = 0.f;
/* Beam has non-xtup within */
-#line 16432 ""
+#line 16411 ""
nrests = 0;
-#line 16433 ""
+#line 16412 ""
isxtup = FALSE_;
-#line 16434 ""
+#line 16413 ""
i__1 = *nip2;
-#line 16434 ""
+#line 16413 ""
for (iip = *nip1; iip <= i__1; ++iip) {
-#line 16435 ""
+#line 16414 ""
if (bit_test(all_1.islur[commvl_1.ivx + *nip1 * 24 - 25],21)) {
/* Forced multiplicity */
-#line 16439 ""
+#line 16418 ""
i__2 = igetbits_(&all_1.islur[commvl_1.ivx + *nip1 * 24 - 25], &
c__3, &c__22) + 8;
-#line 16439 ""
+#line 16418 ""
setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &c__0,
&i__2);
-#line 16441 ""
+#line 16420 ""
} else if (! isxtup) {
-#line 16442 ""
+#line 16421 ""
if (all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
-#line 16443 ""
+#line 16422 ""
i__2 = 4 - log2_(&all_1.nodur[commvl_1.ivx + iip * 24 - 25])
+ 8;
-#line 16443 ""
+#line 16422 ""
setbits_(&all_1.mult[commvl_1.ivx + iip * 24 - 25], &c__4, &
c__0, &i__2);
-#line 16444 ""
+#line 16423 ""
} else {
/* Start xtup within forced beam */
-#line 16448 ""
+#line 16427 ""
isxtup = TRUE_;
-#line 16449 ""
+#line 16428 ""
iip1 = iip;
-#line 16450 ""
+#line 16429 ""
}
-#line 16451 ""
+#line 16430 ""
} else if (isxtup && all_1.nodur[commvl_1.ivx + iip * 24 - 25] > 0) {
/* End of xtup within forced beam. Must count doubled notes */
-#line 16455 ""
+#line 16434 ""
ndoub = 0;
-#line 16456 ""
+#line 16435 ""
i__2 = iip;
-#line 16456 ""
+#line 16435 ""
for (iiip = iip1; iiip <= i__2; ++iiip) {
-#line 16457 ""
+#line 16436 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
-#line 16457 ""
+#line 16436 ""
++ndoub;
-#line 16457 ""
+#line 16436 ""
}
-#line 16458 ""
+#line 16437 ""
/* L1: */
-#line 16458 ""
+#line 16437 ""
}
-#line 16459 ""
+#line 16438 ""
multx = (integer) ((log(iip + 1.f - iip1 + ndoub) * .952f - log(
all_1.nodur[commvl_1.ivx + iip * 24 - 25] / 2.f)) /
.69315f + 13.429f) - 10;
-#line 16461 ""
+#line 16440 ""
i__2 = iip;
-#line 16461 ""
+#line 16440 ""
for (iiip = iip1; iiip <= i__2; ++iiip) {
-#line 16462 ""
+#line 16441 ""
i__3 = multx + 8;
-#line 16462 ""
+#line 16441 ""
setbits_(&all_1.mult[commvl_1.ivx + iiip * 24 - 25], &c__4, &
c__0, &i__3);
/* Note the following still works after making mult only the 1st 4 bits. */
-#line 16466 ""
+#line 16445 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],18)) {
-#line 16466 ""
+#line 16445 ""
--all_1.mult[commvl_1.ivx + iiip * 24 - 25];
-#line 16466 ""
+#line 16445 ""
}
-#line 16468 ""
+#line 16447 ""
if (bit_test(all_1.nacc[commvl_1.ivx + iiip * 24 - 25],19)) {
-#line 16469 ""
+#line 16448 ""
++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
-#line 16470 ""
+#line 16449 ""
} else if (iiip > 1) {
-#line 16471 ""
+#line 16450 ""
if (bit_test(all_1.nacc[commvl_1.ivx + (iiip - 1) * 24 -
25],19)) {
-#line 16471 ""
+#line 16450 ""
++all_1.mult[commvl_1.ivx + iiip * 24 - 25];
-#line 16471 ""
+#line 16450 ""
}
-#line 16473 ""
+#line 16452 ""
}
-#line 16474 ""
+#line 16453 ""
/* L74: */
-#line 16474 ""
+#line 16453 ""
}
-#line 16475 ""
+#line 16454 ""
isxtup = FALSE_;
-#line 16476 ""
+#line 16455 ""
}
-#line 16477 ""
+#line 16456 ""
if (bit_test(all_1.irest[commvl_1.ivx + iip * 24 - 25],0)) {
-#line 16478 ""
+#line 16457 ""
++nrests;
-#line 16479 ""
+#line 16458 ""
} else {
-#line 16480 ""
+#line 16459 ""
sum += all_1.nolev[commvl_1.ivx + iip * 24 - 25];
-#line 16481 ""
+#line 16460 ""
}
-#line 16482 ""
+#line 16461 ""
/* L9: */
-#line 16482 ""
+#line 16461 ""
}
/* Set beam up-down-ness */
-#line 16486 ""
+#line 16465 ""
if (comfb_1.ifb > 0 && *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
max(1,comfb_1.ifb) * 24 - 25] != 'x') {
-#line 16487 ""
+#line 16466 ""
if (*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx + comfb_1.ifb * 24
- 25] == 'f') {
/* Get default, then trade "l" and "u" */
-#line 16491 ""
+#line 16470 ""
r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
-#line 16491 ""
+#line 16470 ""
i__1 = ncmid_(&all_1.iv, nip1);
-#line 16491 ""
+#line 16470 ""
ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
-#line 16491 ""
+#line 16470 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = (
char) (225 - *(unsigned char *)&ch__1[0]);
-#line 16493 ""
+#line 16472 ""
} else {
-#line 16494 ""
+#line 16473 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + comfb_1.ifb * 24 - 25]
= *(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
comfb_1.ifb * 24 - 25];
-#line 16495 ""
+#line 16474 ""
}
/* This probably works only because forced beams are done first, so they */
/* don't have to be re-sorted within each voice. ???? */
-#line 16500 ""
+#line 16479 ""
} else if (commvl_1.nvmx[all_1.iv - 1] == 2) {
/* Multi-voice per staff */
-#line 16504 ""
+#line 16483 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 16505 ""
+#line 16484 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
'l';
-#line 16506 ""
+#line 16485 ""
} else {
-#line 16507 ""
+#line 16486 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] =
'u';
-#line 16508 ""
+#line 16487 ""
}
-#line 16509 ""
+#line 16488 ""
} else {
/* Defaults */
-#line 16513 ""
+#line 16492 ""
r__1 = sum / (*nip2 - *nip1 + 1 - nrests);
-#line 16513 ""
+#line 16492 ""
i__1 = ncmid_(&all_1.iv, nip1);
-#line 16513 ""
+#line 16492 ""
ulfq_(ch__1, (ftnlen)1, &r__1, &i__1);
-#line 16513 ""
+#line 16492 ""
*(unsigned char *)&all_1.ulq[commvl_1.ivx + numnow * 24 - 25] = *(
unsigned char *)&ch__1[0];
-#line 16515 ""
+#line 16494 ""
}
-#line 16516 ""
+#line 16495 ""
return 0;
} /* logbeam_ */
@@ -39316,73 +39560,73 @@ L12:
/* This is called when (a) macro recording is just starting and */
/* (b) at the start of a new line, if recording is on */
-#line 16532 ""
+#line 16511 ""
inbuff_1.lbuf[0] = inbuff_1.lbuf[0];
-#line 16533 ""
+#line 16512 ""
if (! commac_1.mrecord) {
/* Starting the macro */
-#line 16537 ""
+#line 16516 ""
c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
-#line 16538 ""
+#line 16517 ""
c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
-#line 16539 ""
+#line 16518 ""
c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
-#line 16540 ""
+#line 16519 ""
commac_1.mrecord = TRUE_;
-#line 16541 ""
+#line 16520 ""
}
-#line 16542 ""
+#line 16521 ""
if (*iccount < 128) {
-#line 16543 ""
+#line 16522 ""
i__1 = *iccount;
-#line 16543 ""
+#line 16522 ""
*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
-#line 16544 ""
+#line 16523 ""
if (*ndxm > 0) {
-#line 16544 ""
+#line 16523 ""
i__1 = *iccount;
-#line 16544 ""
+#line 16523 ""
i__2 = 128 - *iccount;
-#line 16544 ""
+#line 16523 ""
*ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
-#line 16544 ""
+#line 16523 ""
}
-#line 16546 ""
+#line 16525 ""
if (*ndxm > 0) {
/* This line ends the macro. */
-#line 16550 ""
+#line 16529 ""
i__1 = *iccount + *ndxm;
-#line 16550 ""
+#line 16529 ""
if (s_cmp(lineq + i__1, " ", *iccount + *ndxm + 1 - i__1, (ftnlen)
1) != 0) {
-#line 16551 ""
+#line 16530 ""
i__1 = *iccount + *ndxm + 1;
-#line 16551 ""
+#line 16530 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 16551 ""
+#line 16530 ""
errmsg_(lineq, &i__1, &i__2, "Improper macro termination!", (
ftnlen)128, (ftnlen)27);
-#line 16553 ""
+#line 16532 ""
stop1_();
-#line 16554 ""
+#line 16533 ""
}
-#line 16555 ""
+#line 16534 ""
c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
-#line 16556 ""
+#line 16535 ""
c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
-#line 16557 ""
+#line 16536 ""
commac_1.mrecord = FALSE_;
-#line 16558 ""
+#line 16537 ""
}
-#line 16559 ""
+#line 16538 ""
}
-#line 16560 ""
+#line 16539 ""
return 0;
} /* m1rec1_ */
@@ -39413,7 +39657,7 @@ L12:
static real tglp2;
extern /* Subroutine */ int addfb_(integer *, integer *, real *, real *,
real *, char *, integer *, ftnlen);
- static integer mapfb[16];
+ static integer mapfb[24];
static real deskb;
extern doublereal fnote_(integer *, integer *, integer *, integer *);
static real eskzb;
@@ -39440,173 +39684,177 @@ L12:
/* Above are factors for grace note, clef spacing. (fraction of wheadpt) */
/* In 1.04, moved to block data subprogram */
-#line 16652 ""
+#line 16631 ""
/* Parameter adjustments */
-#line 16652 ""
+#line 16631 ""
--istart;
-#line 16652 ""
+#line 16631 ""
--numbms;
-#line 16652 ""
+#line 16631 ""
--istop;
-#line 16652 ""
+#line 16631 ""
--squez;
-#line 16652 ""
+#line 16631 ""
--cwrest;
-#line 16652 ""
+#line 16631 ""
--tstart;
-#line 16652 ""
+#line 16631 ""
-#line 16652 ""
+#line 16631 ""
/* Function Body */
-#line 16652 ""
+#line 16631 ""
if (commidi_1.ismidi) {
/* Initialize for this bar the accidental counter for the midi file. */
/* naccim(icm) = # of accidentals from earlier in the bar */
-#line 16657 ""
+#line 16636 ""
i__1 = all_1.nv;
-#line 16657 ""
+#line 16636 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 16658 ""
+#line 16637 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 16658 ""
+#line 16637 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 16659 ""
+#line 16638 ""
commidi_1.naccim[commidi_1.midchan[all_1.iv + kv * 24 - 25]] =
0;
-#line 16660 ""
-/* L45: */
-#line 16660 ""
+#line 16639 ""
+/* L4599: */
+#line 16639 ""
}
-#line 16660 ""
+#line 16640 ""
+/* L45: */
+#line 16640 ""
}
-#line 16661 ""
+#line 16641 ""
}
/* Time from start of gulp to end of bar, used with forced beams */
-#line 16665 ""
+#line 16645 ""
tglp2 = (real) (all_1.lenb0 + all_1.ibar * all_1.lenb1);
-#line 16666 ""
+#line 16646 ""
if (all_1.lenb0 > 0) {
-#line 16666 ""
+#line 16646 ""
tglp2 -= all_1.lenb1;
-#line 16666 ""
+#line 16646 ""
}
-#line 16667 ""
+#line 16647 ""
*tglp1 = tglp2 - all_1.lenbar;
/* infbmx will only be true if in xtup that is NOT in explicit forced beam. */
-#line 16671 ""
- i__2 = all_1.nv;
-#line 16671 ""
- for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
-#line 16672 ""
- i__1 = commvl_1.nvmx[all_1.iv - 1];
-#line 16672 ""
- for (kv = 1; kv <= i__1; ++kv) {
-#line 16673 ""
+#line 16651 ""
+ i__1 = all_1.nv;
+#line 16651 ""
+ for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 16652 ""
+ i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 16652 ""
+ for (kv = 1; kv <= i__2; ++kv) {
+#line 16653 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 16674 ""
+#line 16654 ""
cwrest[commvl_1.ivx] = FALSE_;
-#line 16675 ""
+#line 16655 ""
infbmx[commvl_1.ivx - 1] = FALSE_;
-#line 16676 ""
+#line 16656 ""
inxtup[commvl_1.ivx - 1] = FALSE_;
-#line 16677 ""
+#line 16657 ""
if (all_1.ibar > 1) {
-#line 16678 ""
+#line 16658 ""
all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx +
all_1.ibar * 24 - 25] - all_1.nib[commvl_1.ivx + (
all_1.ibar - 1) * 24 - 25];
-#line 16679 ""
+#line 16659 ""
} else {
-#line 16680 ""
+#line 16660 ""
all_1.nn[commvl_1.ivx - 1] = all_1.nib[commvl_1.ivx +
all_1.ibar * 24 - 25];
-#line 16681 ""
+#line 16661 ""
}
-#line 16682 ""
-/* L1: */
-#line 16682 ""
+#line 16662 ""
+/* L1999: */
+#line 16662 ""
}
-#line 16682 ""
+#line 16663 ""
+/* L1: */
+#line 16663 ""
}
/* initialize list note counter, time(iv), curr. note(iv). The loop to 4 */
/* ONLY initializes each voice. */
-#line 16687 ""
+#line 16668 ""
in = 1;
-#line 16688 ""
+#line 16669 ""
nxtup = 0;
-#line 16689 ""
+#line 16670 ""
comarp_1.narp = 0;
-#line 16690 ""
+#line 16671 ""
i__1 = all_1.nv;
-#line 16690 ""
+#line 16671 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 16691 ""
+#line 16672 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 16691 ""
+#line 16672 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 16692 ""
+#line 16673 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 16693 ""
+#line 16674 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
-#line 16694 ""
+#line 16675 ""
cnn[commvl_1.ivx - 1] = 1;
-#line 16695 ""
+#line 16676 ""
all_1.ivxo[in - 1] = commvl_1.ivx;
-#line 16696 ""
+#line 16677 ""
all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
-#line 16697 ""
+#line 16678 ""
all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &c__1,
all_1.nacc);
-#line 16698 ""
+#line 16679 ""
all_1.to[in - 1] = 0.f;
-#line 16699 ""
+#line 16680 ""
xit[commvl_1.ivx - 1] = all_1.tnote[in - 1];
/* Note that xit(ivx) is to END of note in voice, but it1xtup is start time. */
-#line 16703 ""
+#line 16684 ""
if (all_1.nodur[commvl_1.ivx + all_1.ipo[in - 1] * 24 - 25] == 0)
{
/* First note of xtuplet at start of bar in voice ivx. */
-#line 16707 ""
+#line 16688 ""
++nxtup;
-#line 16708 ""
+#line 16689 ""
nxtnow[commvl_1.ivx - 1] = nxtup;
-#line 16709 ""
+#line 16690 ""
inxtup[commvl_1.ivx - 1] = TRUE_;
-#line 16710 ""
+#line 16691 ""
t1xtup[nxtup - 1] = 0.f;
/* Xtup at start of bar. If no explicit forced beam, start one, set */
/* signal infbmx, and save number ifbnow for use at termination. */
-#line 16715 ""
+#line 16696 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
-#line 16716 ""
+#line 16697 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
-#line 16716 ""
+#line 16697 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
{
-#line 16717 ""
+#line 16698 ""
if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25]
> *tglp1 + xit[commvl_1.ivx - 1] +
comtol_1.tol) {
/* No explicit fb here; so exit loop and insert one. */
-#line 16721 ""
+#line 16702 ""
goto L61;
-#line 16722 ""
+#line 16703 ""
} else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb *
24 - 25] < *tglp1 + xit[commvl_1.ivx - 1] +
comtol_1.tol && comfb_1.t2fb[commvl_1.ivx +
@@ -39615,156 +39863,160 @@ L12:
/* IS explicit fb here; must NOT insert one */
-#line 16727 ""
+#line 16708 ""
goto L62;
-#line 16728 ""
+#line 16709 ""
}
-#line 16729 ""
+#line 16710 ""
/* L60: */
-#line 16729 ""
+#line 16710 ""
}
-#line 16730 ""
+#line 16711 ""
}
-#line 16731 ""
+#line 16712 ""
L61:
/* If here, xtup isn't in explicit fb, so must insert one */
-#line 16735 ""
+#line 16716 ""
infbmx[commvl_1.ivx - 1] = TRUE_;
-#line 16736 ""
+#line 16717 ""
r__1 = t1xtup[nxtup - 1] + *tglp1;
-#line 16736 ""
+#line 16717 ""
addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
-#line 16738 ""
+#line 16719 ""
ifbnow[commvl_1.ivx - 1] = ifbadd;
-#line 16739 ""
+#line 16720 ""
}
-#line 16740 ""
+#line 16721 ""
L62:
-#line 16741 ""
+#line 16722 ""
if ((r__1 = xit[commvl_1.ivx - 1] - all_1.lenbar, dabs(r__1)) <
comtol_1.tol) {
-#line 16741 ""
+#line 16722 ""
xit[commvl_1.ivx - 1] = 1e3f;
-#line 16741 ""
+#line 16722 ""
}
-#line 16742 ""
+#line 16723 ""
++in;
-#line 16743 ""
-/* L4: */
-#line 16743 ""
+#line 16724 ""
+/* L4999: */
+#line 16724 ""
}
-#line 16743 ""
+#line 16725 ""
+/* L4: */
+#line 16725 ""
}
/* Build the list: This is a manual loop starting at 5 */
-#line 16747 ""
+#line 16729 ""
L5:
/* Determine which voice comes next from end of notes done so far. */
/* tmin is the earliest ending time of notes done so far */
-#line 16752 ""
+#line 16734 ""
tmin = 1e3f;
-#line 16753 ""
- i__2 = all_1.nv;
-#line 16753 ""
- for (iiv = 1; iiv <= i__2; ++iiv) {
-#line 16754 ""
- i__1 = commvl_1.nvmx[iiv - 1];
-#line 16754 ""
- for (kv = 1; kv <= i__1; ++kv) {
-#line 16755 ""
+#line 16735 ""
+ i__1 = all_1.nv;
+#line 16735 ""
+ for (iiv = 1; iiv <= i__1; ++iiv) {
+#line 16736 ""
+ i__2 = commvl_1.nvmx[iiv - 1];
+#line 16736 ""
+ for (kv = 1; kv <= i__2; ++kv) {
+#line 16737 ""
iivx = commvl_1.ivmx[iiv + kv * 24 - 25];
/* Computing MIN */
-#line 16756 ""
+#line 16738 ""
r__1 = tmin, r__2 = xit[iivx - 1];
-#line 16756 ""
+#line 16738 ""
tminn = dmin(r__1,r__2);
-#line 16757 ""
+#line 16739 ""
if (tminn < tmin - comtol_1.tol) {
-#line 16758 ""
+#line 16740 ""
tmin = tminn;
-#line 16759 ""
+#line 16741 ""
commvl_1.ivx = iivx;
-#line 16760 ""
+#line 16742 ""
}
-#line 16761 ""
-/* L6: */
-#line 16761 ""
+#line 16743 ""
+/* L6999: */
+#line 16743 ""
}
-#line 16761 ""
+#line 16744 ""
+/* L6: */
+#line 16744 ""
}
-#line 16762 ""
+#line 16745 ""
if ((r__1 = tmin - 1e3f, dabs(r__1)) < comtol_1.tol) {
-#line 16762 ""
+#line 16745 ""
goto L7;
-#line 16762 ""
+#line 16745 ""
}
-#line 16763 ""
+#line 16746 ""
all_1.ivxo[in - 1] = commvl_1.ivx;
-#line 16764 ""
+#line 16747 ""
++cnn[commvl_1.ivx - 1];
-#line 16765 ""
+#line 16748 ""
all_1.ipo[in - 1] = cnn[commvl_1.ivx - 1];
-#line 16766 ""
+#line 16749 ""
all_1.to[in - 1] = tmin;
/* Check if this voice is done */
-#line 16770 ""
+#line 16753 ""
all_1.tnote[in - 1] = fnote_(all_1.nodur, &commvl_1.ivx, &cnn[
commvl_1.ivx - 1], all_1.nacc);
-#line 16771 ""
+#line 16754 ""
if (cnn[commvl_1.ivx - 1] == all_1.nn[commvl_1.ivx - 1]) {
-#line 16772 ""
+#line 16755 ""
xit[commvl_1.ivx - 1] = 1e3f;
-#line 16773 ""
+#line 16756 ""
} else {
-#line 16774 ""
+#line 16757 ""
xit[commvl_1.ivx - 1] += all_1.tnote[in - 1];
-#line 16775 ""
+#line 16758 ""
}
/* Flag xtups */
-#line 16779 ""
+#line 16762 ""
if (all_1.nodur[commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] == 0) {
-#line 16780 ""
+#line 16763 ""
if (! inxtup[commvl_1.ivx - 1]) {
/* First note of xtup, not at start of bar. */
-#line 16784 ""
+#line 16767 ""
++nxtup;
-#line 16785 ""
+#line 16768 ""
nxtnow[commvl_1.ivx - 1] = nxtup;
-#line 16786 ""
+#line 16769 ""
inxtup[commvl_1.ivx - 1] = TRUE_;
-#line 16787 ""
+#line 16770 ""
t1xtup[nxtup - 1] = xit[commvl_1.ivx - 1] - all_1.tnote[in - 1];
/* (Note: can't be on last note in voice, so xit(ivx) <> 1000) */
/* Put xtuplet in a forced beam if not already in forced beam */
-#line 16792 ""
+#line 16775 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
-#line 16793 ""
+#line 16776 ""
i__1 = comfb_1.nfb[commvl_1.ivx - 1];
-#line 16793 ""
+#line 16776 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__1; ++comfb_1.ifb) {
-#line 16794 ""
+#line 16777 ""
if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] > *
tglp1 + xit[commvl_1.ivx - 1] + comtol_1.tol) {
/* NO explicit bm; put one in */
-#line 16798 ""
+#line 16781 ""
goto L71;
-#line 16799 ""
+#line 16782 ""
} else if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 -
25] < *tglp1 + xit[commvl_1.ivx - 1] +
comtol_1.tol && comfb_1.t2fb[commvl_1.ivx +
@@ -39773,59 +40025,59 @@ L5:
/* IS explicit bm. Don't put one */
-#line 16804 ""
+#line 16787 ""
goto L72;
-#line 16805 ""
+#line 16788 ""
}
-#line 16806 ""
+#line 16789 ""
/* L70: */
-#line 16806 ""
+#line 16789 ""
}
-#line 16807 ""
+#line 16790 ""
}
-#line 16808 ""
+#line 16791 ""
L71:
/* If here, no explicit bm, so put one in */
-#line 16812 ""
+#line 16795 ""
infbmx[commvl_1.ivx - 1] = TRUE_;
-#line 16813 ""
+#line 16796 ""
r__1 = t1xtup[nxtup - 1] + *tglp1;
-#line 16813 ""
+#line 16796 ""
addfb_(comfb_1.nfb, &commvl_1.ivx, &r__1, comfb_1.t1fb,
comfb_1.t2fb, comfb_1.ulfbq, &ifbadd, (ftnlen)1);
-#line 16815 ""
+#line 16798 ""
ifbnow[commvl_1.ivx - 1] = ifbadd;
-#line 16816 ""
+#line 16799 ""
}
-#line 16817 ""
+#line 16800 ""
L72:
-#line 16818 ""
+#line 16801 ""
;
-#line 16818 ""
+#line 16801 ""
} else if (inxtup[commvl_1.ivx - 1]) {
/* This test is sufficient because already know nodur>0 */
-#line 16822 ""
+#line 16805 ""
inxtup[commvl_1.ivx - 1] = FALSE_;
-#line 16823 ""
+#line 16806 ""
if (infbmx[commvl_1.ivx - 1]) {
/* Xtup is in auto-forced beam, so end it */
-#line 16827 ""
+#line 16810 ""
comfb_1.t2fb[commvl_1.ivx + ifbnow[commvl_1.ivx - 1] * 24 - 25] =
t1xtup[nxtnow[commvl_1.ivx - 1] - 1] + all_1.nodur[
commvl_1.ivx + cnn[commvl_1.ivx - 1] * 24 - 25] + *tglp1;
-#line 16829 ""
+#line 16812 ""
infbmx[commvl_1.ivx - 1] = FALSE_;
-#line 16830 ""
+#line 16813 ""
}
-#line 16831 ""
+#line 16814 ""
}
-#line 16832 ""
+#line 16815 ""
if (bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25]
,24) || bit_test(all_1.irest[all_1.ivxo[in - 1] + all_1.ipo[in -
1] * 24 - 25],30)) {
@@ -39833,62 +40085,62 @@ L72:
/* For staff jumped beam, flag the first note (lowest voice) at same time. */
/* Later will start new notes group here. */
-#line 16838 ""
+#line 16821 ""
inj = in;
-#line 16839 ""
+#line 16822 ""
if (all_1.ivxo[in - 1] > 1) {
-#line 16840 ""
+#line 16823 ""
for (iin = in - 1; iin >= 1; --iin) {
-#line 16841 ""
+#line 16824 ""
if (all_1.to[iin - 1] + comtol_1.tol < all_1.to[in - 1]) {
-#line 16841 ""
+#line 16824 ""
goto L41;
-#line 16841 ""
+#line 16824 ""
}
-#line 16842 ""
+#line 16825 ""
if ((r__1 = all_1.to[iin - 1] - all_1.to[in - 1], dabs(r__1))
< comtol_1.tol) {
-#line 16843 ""
+#line 16826 ""
inj = iin;
-#line 16844 ""
+#line 16827 ""
goto L40;
-#line 16845 ""
+#line 16828 ""
}
-#line 16846 ""
+#line 16829 ""
L40:
-#line 16846 ""
+#line 16829 ""
;
-#line 16846 ""
+#line 16829 ""
}
-#line 16847 ""
+#line 16830 ""
}
-#line 16848 ""
+#line 16831 ""
L41:
-#line 16849 ""
+#line 16832 ""
all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] * 24 - 25] =
bit_set(all_1.irest[all_1.ivxo[inj - 1] + all_1.ipo[inj - 1] *
24 - 25],29);
-#line 16850 ""
+#line 16833 ""
}
-#line 16851 ""
+#line 16834 ""
++in;
-#line 16852 ""
+#line 16835 ""
goto L5;
-#line 16853 ""
+#line 16836 ""
L7:
-#line 16854 ""
+#line 16837 ""
comntot_1.ntot = in - 1;
-#line 16855 ""
+#line 16838 ""
i__1 = comntot_1.ntot - 1;
-#line 16855 ""
+#line 16838 ""
for (in = 1; in <= i__1; ++in) {
-#line 16856 ""
+#line 16839 ""
all_1.tno[in - 1] = all_1.to[in] - all_1.to[in - 1];
-#line 16857 ""
+#line 16840 ""
/* L8: */
-#line 16857 ""
+#line 16840 ""
}
-#line 16858 ""
+#line 16841 ""
all_1.tno[comntot_1.ntot - 1] = all_1.tnote[comntot_1.ntot - 1];
/* Debug writes */
@@ -39904,32 +40156,32 @@ L7:
/* Done w/ list. Loop for parsing into note blocks: */
-#line 16873 ""
+#line 16856 ""
ib = 1;
-#line 16874 ""
+#line 16857 ""
istart[1] = 1;
-#line 16875 ""
+#line 16858 ""
comnsp_2.space[0] = 0.f;
-#line 16876 ""
+#line 16859 ""
in = 1;
/* A manual loop to set space(ib) and istop(ib) */
-#line 16880 ""
+#line 16863 ""
L9:
/* Computing MIN */
-#line 16882 ""
+#line 16865 ""
i__1 = in + 1;
-#line 16882 ""
+#line 16865 ""
commvl_1.ivx = all_1.ivxo[min(i__1,comntot_1.ntot) - 1];
/* Computing MIN */
-#line 16883 ""
+#line 16866 ""
i__1 = in + 1;
-#line 16883 ""
+#line 16866 ""
ip = all_1.ipo[min(i__1,comntot_1.ntot) - 1];
-#line 16884 ""
+#line 16867 ""
isl = all_1.islur[commvl_1.ivx + ip * 24 - 25];
-#line 16885 ""
+#line 16868 ""
if (in == comntot_1.ntot || (commvl_1.ivx == 1 && ((isl & 67109216) > 0 ||
bit_test(all_1.ipl[ip * 24 - 24],28) || bit_test(all_1.iornq[ip *
24],4)) || bit_test(isl,15)) || bit_test(all_1.irest[
@@ -39951,353 +40203,357 @@ L9:
/* 5/25/98: This stuff causes trouble with just "c2 Ct c", maybe when clef */
/* changes on last note in the list? */
-#line 16906 ""
+#line 16889 ""
if (bit_test(isl,15) && in < comntot_1.ntot) {
-#line 16907 ""
+#line 16890 ""
for (iin = in; iin >= 1; --iin) {
-#line 16908 ""
+#line 16891 ""
if (all_1.tno[iin - 1] > comtol_1.tol) {
-#line 16909 ""
+#line 16892 ""
in = iin;
-#line 16910 ""
+#line 16893 ""
all_1.islur[commvl_1.ivx + ip * 24 - 25] = bit_clear(
all_1.islur[commvl_1.ivx + ip * 24 - 25],15);
-#line 16911 ""
+#line 16894 ""
all_1.islur[all_1.ivxo[in] + all_1.ipo[in] * 24 - 25] =
bit_set(all_1.islur[all_1.ivxo[in] + all_1.ipo[in]
* 24 - 25],15);
-#line 16913 ""
+#line 16896 ""
goto L51;
-#line 16914 ""
+#line 16897 ""
}
-#line 16915 ""
+#line 16898 ""
/* L50: */
-#line 16915 ""
+#line 16898 ""
}
-#line 16916 ""
+#line 16899 ""
L51:
-#line 16917 ""
+#line 16900 ""
;
-#line 16917 ""
+#line 16900 ""
}
-#line 16918 ""
+#line 16901 ""
if (comnsp_2.space[ib - 1] < comtol_1.tol) {
-#line 16919 ""
+#line 16902 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
-#line 16920 ""
+#line 16903 ""
squez[ib] = 1.f;
-#line 16921 ""
+#line 16904 ""
}
-#line 16922 ""
+#line 16905 ""
istop[ib] = in;
-#line 16923 ""
+#line 16906 ""
} else if (comnsp_2.space[ib - 1] < comtol_1.tol) {
/* space hasn't been set yet, so tentatively set: */
-#line 16927 ""
+#line 16910 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
-#line 16928 ""
+#line 16911 ""
if (comnsp_2.space[ib - 1] < comtol_1.tol) {
-#line 16929 ""
+#line 16912 ""
++in;
-#line 16930 ""
+#line 16913 ""
} else {
-#line 16931 ""
+#line 16914 ""
squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib -
1], all_1.tnote, all_1.to);
-#line 16932 ""
+#line 16915 ""
istop[ib] = in;
-#line 16933 ""
+#line 16916 ""
}
-#line 16934 ""
+#line 16917 ""
goto L9;
-#line 16935 ""
+#line 16918 ""
} else if (all_1.tno[in] < comtol_1.tol) {
/* This is not the last note in the group, so */
-#line 16939 ""
+#line 16922 ""
++in;
-#line 16940 ""
+#line 16923 ""
goto L9;
-#line 16941 ""
+#line 16924 ""
} else if ((r__1 = all_1.tno[in] - comnsp_2.space[ib - 1], dabs(r__1)) <
comtol_1.tol) {
-#line 16942 ""
+#line 16925 ""
i__1 = in + 1;
-#line 16942 ""
+#line 16925 ""
xsquez = getsquez_(&i__1, &comntot_1.ntot, &comnsp_2.space[ib - 1],
all_1.tnote, all_1.to);
-#line 16943 ""
+#line 16926 ""
if ((r__1 = xsquez - squez[ib], dabs(r__1)) < comtol_1.tol) {
/* Keep spacing the same, update tentative stop point */
-#line 16947 ""
+#line 16930 ""
++in;
-#line 16948 ""
+#line 16931 ""
istop[ib] = in;
-#line 16949 ""
+#line 16932 ""
goto L9;
-#line 16950 ""
+#line 16933 ""
}
-#line 16951 ""
+#line 16934 ""
}
/* At this point istart and istop are good, so finalize block */
-#line 16955 ""
+#line 16938 ""
tstart[ib] = all_1.to[istart[ib] - 1];
-#line 16956 ""
+#line 16939 ""
if (istop[ib] == comntot_1.ntot) {
-#line 16956 ""
+#line 16939 ""
goto L15;
-#line 16956 ""
+#line 16939 ""
}
-#line 16957 ""
+#line 16940 ""
++ib;
-#line 16958 ""
+#line 16941 ""
istart[ib] = istop[ib - 1] + 1;
-#line 16959 ""
+#line 16942 ""
in = istart[ib];
/* Set tentative block space and squeeze-factor for upcoming block */
-#line 16963 ""
+#line 16946 ""
comnsp_2.space[ib - 1] = all_1.tno[in - 1];
-#line 16964 ""
+#line 16947 ""
if (comnsp_2.space[ib - 1] > comtol_1.tol) {
-#line 16964 ""
+#line 16947 ""
squez[ib] = getsquez_(&in, &comntot_1.ntot, &comnsp_2.space[ib - 1],
all_1.tnote, all_1.to);
-#line 16964 ""
+#line 16947 ""
}
-#line 16966 ""
+#line 16949 ""
istop[ib] = in;
-#line 16967 ""
+#line 16950 ""
goto L9;
-#line 16968 ""
+#line 16951 ""
L15:
-#line 16969 ""
+#line 16952 ""
comnsp_2.nb = ib;
/* Invert the list of places into ipl(0-7), making it easier to analyze a voice */
-#line 16973 ""
+#line 16956 ""
i__1 = comntot_1.ntot;
-#line 16973 ""
+#line 16956 ""
for (in = 1; in <= i__1; ++in) {
/* ??? This may fix extra \loff's (bit 8 of ipl) in measures with >255 notes. */
/* ipl(ivxo(in),ipo(in)) = ior(ipl(ivxo(in),ipo(in)),in) */
-#line 16978 ""
+#line 16961 ""
comipl2_1.ipl2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = in;
-#line 16979 ""
+#line 16962 ""
/* L13: */
-#line 16979 ""
+#line 16962 ""
}
/* Compute elemskips from start of bar to each note in the bar, for beam slopes */
-#line 16983 ""
+#line 16966 ""
eskzb = 0.f;
-#line 16984 ""
+#line 16967 ""
ib = 1;
-#line 16985 ""
+#line 16968 ""
i__1 = comntot_1.ntot;
-#line 16985 ""
+#line 16968 ""
for (in = 1; in <= i__1; ++in) {
-#line 16986 ""
+#line 16969 ""
if (in == istart[ib]) {
-#line 16987 ""
+#line 16970 ""
r__1 = comnsp_2.space[ib - 1] / squez[ib];
-#line 16987 ""
+#line 16970 ""
deskb = squez[ib] * feon_(&r__1);
-#line 16988 ""
+#line 16971 ""
} else if (all_1.tno[in - 2] > comtol_1.tol) {
-#line 16989 ""
+#line 16972 ""
eskzb += deskb;
-#line 16990 ""
+#line 16973 ""
}
-#line 16991 ""
+#line 16974 ""
all_1.eskz[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] = eskzb;
-#line 16992 ""
+#line 16975 ""
comeskz2_1.eskz2[all_1.ivxo[in - 1] + all_1.ipo[in - 1] * 24 - 25] =
eskzb;
-#line 16993 ""
+#line 16976 ""
if (in == istop[ib]) {
-#line 16994 ""
+#line 16977 ""
eskzb += deskb;
-#line 16995 ""
+#line 16978 ""
++ib;
-#line 16996 ""
+#line 16979 ""
}
-#line 16997 ""
+#line 16980 ""
/* L30: */
-#line 16997 ""
+#line 16980 ""
}
/* Analyze for beams. */
-#line 17001 ""
+#line 16984 ""
i__1 = all_1.nv;
-#line 17001 ""
+#line 16984 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 17002 ""
+#line 16985 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 17002 ""
+#line 16985 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 17003 ""
+#line 16986 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 17004 ""
+#line 16987 ""
numbms[commvl_1.ivx] = 0;
-#line 17005 ""
+#line 16988 ""
mapfb[0] = 0;
-#line 17006 ""
+#line 16989 ""
mapfb[1] = 0;
-#line 17007 ""
+#line 16990 ""
mapfb[2] = 0;
-#line 17008 ""
+#line 16991 ""
mapfb[3] = 0;
+#line 16992 ""
+ mapfb[4] = 0;
+#line 16993 ""
+ mapfb[5] = 0;
/* First forced beams. */
-#line 17012 ""
+#line 16997 ""
if (comfb_1.nfb[commvl_1.ivx - 1] > 0) {
/* tglp2 is time from start of gulp to end of current bar. */
-#line 17016 ""
+#line 17001 ""
nfbbar = 0;
-#line 17017 ""
+#line 17002 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
-#line 17017 ""
+#line 17002 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb) {
-#line 17018 ""
+#line 17003 ""
if (comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] >
tglp2 - comtol_1.tol) {
-#line 17018 ""
+#line 17003 ""
goto L81;
-#line 17018 ""
+#line 17003 ""
}
-#line 17019 ""
+#line 17004 ""
++nfbbar;
-#line 17020 ""
+#line 17005 ""
++numbms[commvl_1.ivx];
-#line 17021 ""
+#line 17006 ""
numnew = numbms[commvl_1.ivx];
/* Times from beginning of bar */
-#line 17025 ""
+#line 17010 ""
itbb1 = (integer) (comfb_1.t1fb[commvl_1.ivx +
comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
-#line 17026 ""
+#line 17011 ""
itbb2 = (integer) (comfb_1.t2fb[commvl_1.ivx +
comfb_1.ifb * 24 - 25] - *tglp1 + comtol_1.tol);
-#line 17027 ""
+#line 17012 ""
i__4 = all_1.nn[commvl_1.ivx - 1];
-#line 17027 ""
+#line 17012 ""
for (ip = 1; ip <= i__4; ++ip) {
-#line 17028 ""
+#line 17013 ""
if ((integer) (all_1.to[comipl2_1.ipl2[commvl_1.ivx +
ip * 24 - 25] - 1] + comtol_1.tol) == itbb1) {
-#line 17029 ""
+#line 17014 ""
nip1fb = ip;
-#line 17030 ""
+#line 17015 ""
i__5 = all_1.nn[commvl_1.ivx - 1];
-#line 17030 ""
+#line 17015 ""
for (ip1 = ip; ip1 <= i__5; ++ip1) {
-#line 17031 ""
+#line 17016 ""
inip1 = comipl2_1.ipl2[commvl_1.ivx + ip1 *
24 - 25];
-#line 17032 ""
+#line 17017 ""
if ((r__1 = all_1.to[inip1 - 1] + all_1.tnote[
inip1 - 1] - itbb2, dabs(r__1)) <
comtol_1.tol) {
-#line 17033 ""
+#line 17018 ""
nip2fb = ip1;
-#line 17034 ""
+#line 17019 ""
itbb3 = itbb2 - 2;
-#line 17035 ""
+#line 17020 ""
goto L85;
-#line 17036 ""
+#line 17021 ""
}
-#line 17037 ""
+#line 17022 ""
/* L84: */
-#line 17037 ""
+#line 17022 ""
}
-#line 17038 ""
+#line 17023 ""
}
-#line 17039 ""
+#line 17024 ""
/* L83: */
-#line 17039 ""
+#line 17024 ""
}
-#line 17040 ""
+#line 17025 ""
s_wsle(&io___999);
-#line 17040 ""
+#line 17025 ""
e_wsle();
-#line 17041 ""
+#line 17026 ""
s_wsle(&io___1000);
-#line 17041 ""
+#line 17026 ""
do_lio(&c__9, &c__1, "Timing problem w/ forced beams", (
ftnlen)30);
-#line 17041 ""
+#line 17026 ""
e_wsle();
-#line 17042 ""
+#line 17027 ""
s_wsfe(&io___1001);
-#line 17042 ""
+#line 17027 ""
do_fio(&c__1, "Timing problem w/ forced beams", (ftnlen)
30);
-#line 17042 ""
+#line 17027 ""
e_wsfe();
-#line 17043 ""
+#line 17028 ""
L85:
-#line 17044 ""
+#line 17029 ""
logbeam_(&numnew, &nip1fb, &nip2fb);
/* Set up mapfb for forced beam just logged: */
-#line 17048 ""
+#line 17033 ""
ib1 = itbb1 / 2;
-#line 17049 ""
+#line 17034 ""
ib2 = itbb3 / 2;
-#line 17050 ""
+#line 17035 ""
ibrep = all_1.lenbar / *ibmrep / 2;
-#line 17051 ""
+#line 17036 ""
i__4 = *ibmrep;
-#line 17051 ""
+#line 17036 ""
for (irep = 1; irep <= i__4; ++irep) {
/* Computing MAX */
-#line 17052 ""
+#line 17037 ""
i__5 = 0, i__6 = ib1 - (irep - 1) * ibrep;
-#line 17052 ""
+#line 17037 ""
ib1now = max(i__5,i__6);
/* Computing MIN */
-#line 17053 ""
+#line 17038 ""
i__5 = irep * ibrep - 1, i__6 = ib2 - (irep - 1) *
ibrep;
-#line 17053 ""
+#line 17038 ""
ib2now = min(i__5,i__6);
-#line 17054 ""
+#line 17039 ""
mapnow = 0;
-#line 17055 ""
+#line 17040 ""
i__5 = ib2now;
-#line 17055 ""
+#line 17040 ""
for (ib = ib1now; ib <= i__5; ++ib) {
-#line 17056 ""
+#line 17041 ""
mapnow = bit_set(mapnow,ib);
-#line 17057 ""
+#line 17042 ""
/* L87: */
-#line 17057 ""
+#line 17042 ""
}
-#line 17058 ""
+#line 17043 ""
mapfb[irep - 1] |= mapnow;
-#line 17059 ""
+#line 17044 ""
/* L86: */
-#line 17059 ""
+#line 17044 ""
}
/* Since we are cycling thru forced beams, for those that start with a rest and */
@@ -40305,91 +40561,93 @@ L85:
/* 060924: Copy to ALL later notes in fb, in case there's more than 1 rest at */
/* start of beam */
-#line 17066 ""
+#line 17051 ""
if (bit_test(all_1.irest[commvl_1.ivx + nip1fb * 24 - 25],
0)) {
-#line 17067 ""
+#line 17052 ""
i__4 = nip2fb;
-#line 17067 ""
+#line 17052 ""
for (kp = nip1fb + 1; kp <= i__4; ++kp) {
-#line 17068 ""
+#line 17053 ""
i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
* 24 - 25], &c__6, &c__11);
-#line 17068 ""
+#line 17053 ""
setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
&c__6, &c__11, &i__5);
-#line 17070 ""
+#line 17055 ""
i__5 = igetbits_(&all_1.ipl[commvl_1.ivx + nip1fb
* 24 - 25], &c__6, &c__17);
-#line 17070 ""
+#line 17055 ""
setbits_(&all_1.ipl[commvl_1.ivx + kp * 24 - 25],
&c__6, &c__17, &i__5);
-#line 17072 ""
+#line 17057 ""
i__5 = igetbits_(&all_1.islur[commvl_1.ivx +
nip1fb * 24 - 25], &c__2, &c__27);
-#line 17072 ""
+#line 17057 ""
setbits_(&all_1.islur[commvl_1.ivx + kp * 24 - 25]
, &c__2, &c__27, &i__5);
-#line 17074 ""
+#line 17059 ""
/* L88: */
-#line 17074 ""
+#line 17059 ""
}
-#line 17075 ""
+#line 17060 ""
}
-#line 17076 ""
+#line 17061 ""
/* L80: */
-#line 17076 ""
+#line 17061 ""
}
-#line 17077 ""
+#line 17062 ""
L81:
/* Slide down, reduce nfb(ivx). This lets us count up from 1 for each new bar. */
/* Remember, makeabar is called 1/bar, and it calls findbeam once per voice. */
-#line 17082 ""
+#line 17067 ""
if (nfbbar > 0) {
-#line 17083 ""
+#line 17068 ""
comfb_1.nfb[commvl_1.ivx - 1] -= nfbbar;
-#line 17084 ""
+#line 17069 ""
i__3 = comfb_1.nfb[commvl_1.ivx - 1];
-#line 17084 ""
+#line 17069 ""
for (comfb_1.ifb = 1; comfb_1.ifb <= i__3; ++comfb_1.ifb)
{
-#line 17085 ""
+#line 17070 ""
comfb_1.t1fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
comfb_1.t1fb[commvl_1.ivx + (comfb_1.ifb +
nfbbar) * 24 - 25];
-#line 17086 ""
+#line 17071 ""
comfb_1.t2fb[commvl_1.ivx + comfb_1.ifb * 24 - 25] =
comfb_1.t2fb[commvl_1.ivx + (comfb_1.ifb +
nfbbar) * 24 - 25];
-#line 17087 ""
+#line 17072 ""
*(unsigned char *)&comfb_1.ulfbq[commvl_1.ivx +
comfb_1.ifb * 24 - 25] = *(unsigned char *)&
comfb_1.ulfbq[commvl_1.ivx + (comfb_1.ifb +
nfbbar) * 24 - 25];
-#line 17088 ""
+#line 17073 ""
/* L82: */
-#line 17088 ""
+#line 17073 ""
}
-#line 17089 ""
+#line 17074 ""
}
-#line 17090 ""
+#line 17075 ""
}
-#line 17091 ""
+#line 17076 ""
comfb_1.ifb = 0;
/* Done with forced beam masks for this bar and voice. Now get normal beams. */
-#line 17095 ""
+#line 17080 ""
findbeam_(ibmrep, &numbms[1], mapfb);
-#line 17096 ""
-/* L20: */
-#line 17096 ""
+#line 17081 ""
+/* L2099: */
+#line 17081 ""
}
-#line 17096 ""
+#line 17082 ""
+/* L20: */
+#line 17082 ""
}
-#line 17097 ""
+#line 17083 ""
return 0;
} /* make1bar_ */
@@ -40609,458 +40867,460 @@ L81:
/* In 1.04, moved to block data subprogram */
/* 130316 */
-#line 17226 ""
+#line 17212 ""
/* Parameter adjustments */
-#line 17226 ""
+#line 17212 ""
--clefq;
-#line 17226 ""
+#line 17212 ""
--istart;
-#line 17226 ""
+#line 17212 ""
--numbms;
-#line 17226 ""
+#line 17212 ""
--istop;
-#line 17226 ""
+#line 17212 ""
--squez;
-#line 17226 ""
+#line 17212 ""
--cwrest;
-#line 17226 ""
+#line 17212 ""
--tstart;
-#line 17226 ""
+#line 17212 ""
-#line 17226 ""
+#line 17212 ""
/* Function Body */
-#line 17226 ""
+#line 17212 ""
xjbeambrests_1.nbrests = 0;
/* Set up main ib loop within which a block (notes group) is written */
-#line 17230 ""
+#line 17216 ""
i__1 = all_1.nv;
-#line 17230 ""
+#line 17216 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 17231 ""
+#line 17217 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 17231 ""
+#line 17217 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 17232 ""
+#line 17218 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 17233 ""
+#line 17219 ""
all_1.ibmcnt[commvl_1.ivx - 1] = 1;
-#line 17234 ""
+#line 17220 ""
ibmcnt1[commvl_1.ivx - 1] = 1;
-#line 17235 ""
+#line 17221 ""
all_1.beamon[commvl_1.ivx - 1] = FALSE_;
-#line 17236 ""
+#line 17222 ""
beamon1[commvl_1.ivx - 1] = FALSE_;
-#line 17237 ""
+#line 17223 ""
nornb[commvl_1.ivx - 1] = 0;
-#line 17238 ""
+#line 17224 ""
iaskb[commvl_1.ivx - 1] = 1;
-#line 17239 ""
+#line 17225 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
-#line 17240 ""
+#line 17226 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
-#line 17241 ""
-/* L25: */
-#line 17241 ""
+#line 17227 ""
+/* L2599: */
+#line 17227 ""
}
-#line 17241 ""
+#line 17228 ""
+/* L25: */
+#line 17228 ""
}
-#line 17242 ""
+#line 17229 ""
comas1_1.naskb = 0;
-#line 17243 ""
+#line 17230 ""
ifig[0] = 1;
-#line 17244 ""
+#line 17231 ""
ifig[1] = 1;
-#line 17245 ""
+#line 17232 ""
comxtup_1.ixtup = 0;
-#line 17246 ""
+#line 17233 ""
bspend = FALSE_;
-#line 17247 ""
+#line 17234 ""
iscwr = FALSE_;
-#line 17248 ""
+#line 17235 ""
rpndot = FALSE_;
-#line 17249 ""
- i__2 = comnsp_2.nb;
-#line 17249 ""
- for (ib = 1; ib <= i__2; ++ib) {
+#line 17236 ""
+ i__1 = comnsp_2.nb;
+#line 17236 ""
+ for (ib = 1; ib <= i__1; ++ib) {
/* Check for segno */
-#line 17253 ""
+#line 17240 ""
if (bit_test(all_1.iornq[all_1.ipo[istart[ib] - 1] * 24],4) &&
all_1.ivxo[istart[ib] - 1] == 1) {
-#line 17255 ""
+#line 17242 ""
if (comgrace_1.noffseg <= -10) {
-#line 17256 ""
+#line 17243 ""
s_wsfi(&io___1021);
-#line 17256 ""
+#line 17243 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
-#line 17256 ""
+#line 17243 ""
e_wsfi();
-#line 17257 ""
+#line 17244 ""
lnoten = 5;
-#line 17258 ""
+#line 17245 ""
} else if (comgrace_1.noffseg < 0 || comgrace_1.noffseg >= 10) {
-#line 17259 ""
+#line 17246 ""
s_wsfi(&io___1023);
-#line 17259 ""
+#line 17246 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
-#line 17259 ""
+#line 17246 ""
e_wsfi();
-#line 17260 ""
+#line 17247 ""
lnoten = 4;
-#line 17261 ""
+#line 17248 ""
} else {
-#line 17262 ""
+#line 17249 ""
s_wsfi(&io___1024);
-#line 17262 ""
+#line 17249 ""
do_fio(&c__1, (char *)&comgrace_1.noffseg, (ftnlen)sizeof(
integer));
-#line 17262 ""
+#line 17249 ""
e_wsfi();
-#line 17263 ""
+#line 17250 ""
lnoten = 1;
-#line 17264 ""
+#line 17251 ""
}
/* Writing concatenation */
-#line 17265 ""
+#line 17252 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 17265 ""
+#line 17252 ""
i__3[1] = 6, a__1[1] = "znotes";
-#line 17265 ""
+#line 17252 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 17265 ""
+#line 17252 ""
i__3[3] = 6, a__1[3] = "segnoo";
-#line 17265 ""
+#line 17252 ""
i__3[4] = lnoten, a__1[4] = noteq;
-#line 17265 ""
+#line 17252 ""
i__3[5] = 1, a__1[5] = "9";
-#line 17265 ""
+#line 17252 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
-#line 17266 ""
+#line 17253 ""
lnote = lnoten + 15;
-#line 17267 ""
- i__1 = all_1.nv;
-#line 17267 ""
- for (all_1.iv = 2; all_1.iv <= i__1; ++all_1.iv) {
-#line 17268 ""
+#line 17254 ""
+ i__2 = all_1.nv;
+#line 17254 ""
+ for (all_1.iv = 2; all_1.iv <= i__2; ++all_1.iv) {
+#line 17255 ""
if (lnote > 60) {
-#line 17269 ""
+#line 17256 ""
if (comlast_1.islast) {
-#line 17269 ""
+#line 17256 ""
s_wsfe(&io___1027);
/* Writing concatenation */
-#line 17269 ""
+#line 17256 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 17269 ""
+#line 17256 ""
i__4[1] = 1, a__2[1] = "%";
-#line 17269 ""
+#line 17256 ""
s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80);
-#line 17269 ""
+#line 17256 ""
do_fio(&c__1, ch__1, lnote + 1);
-#line 17269 ""
+#line 17256 ""
e_wsfe();
-#line 17269 ""
+#line 17256 ""
}
/* Writing concatenation */
-#line 17270 ""
+#line 17257 ""
i__5[0] = 1, a__3[0] = all_1.sepsymq + (all_1.iv - 2);
-#line 17270 ""
+#line 17257 ""
i__5[1] = 1, a__3[1] = all_1.sq;
-#line 17270 ""
+#line 17257 ""
i__5[2] = 6, a__3[2] = "segnoo";
-#line 17270 ""
+#line 17257 ""
i__5[3] = lnoten, a__3[3] = noteq;
-#line 17270 ""
+#line 17257 ""
i__5[4] = 1, a__3[4] = "9";
-#line 17270 ""
+#line 17257 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 17272 ""
+#line 17259 ""
lnote = lnoten + 9;
-#line 17273 ""
+#line 17260 ""
} else {
/* Writing concatenation */
-#line 17274 ""
+#line 17261 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 17274 ""
+#line 17261 ""
i__3[1] = 1, a__1[1] = all_1.sepsymq + (all_1.iv - 2);
-#line 17274 ""
+#line 17261 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 17274 ""
+#line 17261 ""
i__3[3] = 6, a__1[3] = "segnoo";
-#line 17274 ""
+#line 17261 ""
i__3[4] = lnoten, a__1[4] = noteq;
-#line 17274 ""
+#line 17261 ""
i__3[5] = 1, a__1[5] = "9";
-#line 17274 ""
+#line 17261 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
-#line 17276 ""
+#line 17263 ""
lnote = lnote + lnoten + 9;
-#line 17277 ""
+#line 17264 ""
}
-#line 17278 ""
+#line 17265 ""
/* L130: */
-#line 17278 ""
+#line 17265 ""
}
-#line 17279 ""
+#line 17266 ""
if (comlast_1.islast) {
-#line 17279 ""
+#line 17266 ""
s_wsfe(&io___1028);
/* Writing concatenation */
-#line 17279 ""
+#line 17266 ""
i__6[0] = lnote, a__4[0] = notexq;
-#line 17279 ""
+#line 17266 ""
i__6[1] = 1, a__4[1] = all_1.sq;
-#line 17279 ""
+#line 17266 ""
i__6[2] = 2, a__4[2] = "en";
-#line 17279 ""
+#line 17266 ""
s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
-#line 17279 ""
+#line 17266 ""
do_fio(&c__1, ch__2, lnote + 3);
-#line 17279 ""
+#line 17266 ""
e_wsfe();
-#line 17279 ""
+#line 17266 ""
}
-#line 17280 ""
+#line 17267 ""
lnote = 0;
-#line 17281 ""
+#line 17268 ""
}
/* Check for new clefs */
-#line 17285 ""
+#line 17272 ""
isclef = FALSE_;
-#line 17286 ""
+#line 17273 ""
if (bit_test(all_1.islur[all_1.ivxo[istart[ib] - 1] + all_1.ipo[
istart[ib] - 1] * 24 - 25],15)) {
/* In preceding line, fl32 gave wrong result for ... .gt.0 !!! */
-#line 17291 ""
- i__1 = istop[ib];
-#line 17291 ""
- for (in = istart[ib]; in <= i__1; ++in) {
-#line 17292 ""
+#line 17278 ""
+ i__2 = istop[ib];
+#line 17278 ""
+ for (in = istart[ib]; in <= i__2; ++in) {
+#line 17279 ""
if (bit_test(all_1.islur[all_1.ivxo[in - 1] + all_1.ipo[in -
1] * 24 - 25],11)) {
-#line 17293 ""
+#line 17280 ""
i__7 = lbit_shift(all_1.islur[all_1.ivxo[in - 1] +
all_1.ipo[in - 1] * 24 - 25], (ftnlen)-12) & 7;
-#line 17293 ""
+#line 17280 ""
wsclef_(&all_1.ivxo[in - 1], ninow, &i__7);
/* If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% */
/* if (clefq(ivxo(in)) .eq. '8') then */
-#line 17299 ""
+#line 17286 ""
if (bit_test(all_1.ipl[all_1.ivxo[in - 1] + all_1.ipo[in
- 1] * 24 - 25],2)) {
/* Find instrument number for voice ivso(in) */
-#line 17303 ""
+#line 17290 ""
iv1 = 1;
-#line 17304 ""
+#line 17291 ""
i__7 = *ninow;
-#line 17304 ""
+#line 17291 ""
for (iinst = 1; iinst <= i__7; ++iinst) {
-#line 17305 ""
+#line 17292 ""
if (all_1.ivxo[in - 1] < iv1 + comnvi_1.nspern[
iinst - 1]) {
-#line 17305 ""
+#line 17292 ""
goto L2222;
-#line 17305 ""
+#line 17292 ""
}
-#line 17306 ""
+#line 17293 ""
iv1 += comnvi_1.nspern[iinst - 1];
-#line 17307 ""
+#line 17294 ""
/* L1111: */
-#line 17307 ""
+#line 17294 ""
}
-#line 17308 ""
+#line 17295 ""
s_wsle(&io___1033);
-#line 17308 ""
+#line 17295 ""
e_wsle();
-#line 17309 ""
+#line 17296 ""
s_wsle(&io___1034);
-#line 17309 ""
+#line 17296 ""
do_lio(&c__9, &c__1, "Should not be here in make2bar!"
, (ftnlen)31);
-#line 17309 ""
+#line 17296 ""
e_wsle();
-#line 17310 ""
+#line 17297 ""
stop1_();
-#line 17311 ""
+#line 17298 ""
L2222:
-#line 17312 ""
+#line 17299 ""
if (iinst <= 9) {
-#line 17313 ""
+#line 17300 ""
s_wsfe(&io___1035);
/* Writing concatenation */
-#line 17313 ""
+#line 17300 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17313 ""
+#line 17300 ""
i__4[1] = 19, a__2[1] = "settrebleclefsymbol";
-#line 17313 ""
+#line 17300 ""
s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20);
-#line 17313 ""
+#line 17300 ""
do_fio(&c__1, ch__3, (ftnlen)20);
-#line 17313 ""
+#line 17300 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
-#line 17313 ""
+#line 17300 ""
i__8[0] = 1, a__5[0] = all_1.sq;
-#line 17313 ""
+#line 17300 ""
i__8[1] = 13, a__5[1] = "treblelowoct%";
-#line 17313 ""
+#line 17300 ""
s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14);
-#line 17313 ""
+#line 17300 ""
do_fio(&c__1, ch__4, (ftnlen)14);
-#line 17313 ""
+#line 17300 ""
e_wsfe();
-#line 17315 ""
+#line 17302 ""
} else {
-#line 17316 ""
+#line 17303 ""
s_wsfe(&io___1036);
/* Writing concatenation */
-#line 17316 ""
+#line 17303 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17316 ""
+#line 17303 ""
i__4[1] = 19, a__2[1] = "settrebleclefsymbol";
-#line 17316 ""
+#line 17303 ""
s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)20);
-#line 17316 ""
+#line 17303 ""
do_fio(&c__1, ch__3, (ftnlen)20);
-#line 17316 ""
+#line 17303 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
-#line 17316 ""
+#line 17303 ""
i__8[0] = 1, a__5[0] = all_1.sq;
-#line 17316 ""
+#line 17303 ""
i__8[1] = 13, a__5[1] = "treblelowoct%";
-#line 17316 ""
+#line 17303 ""
s_cat(ch__4, a__5, i__8, &c__2, (ftnlen)14);
-#line 17316 ""
+#line 17303 ""
do_fio(&c__1, ch__4, (ftnlen)14);
-#line 17316 ""
+#line 17303 ""
e_wsfe();
-#line 17318 ""
+#line 17305 ""
}
-#line 17319 ""
+#line 17306 ""
comc8flag_1.c8flag[all_1.ivxo[in - 1] - 1] = TRUE_;
-#line 17320 ""
+#line 17307 ""
}
-#line 17321 ""
+#line 17308 ""
}
-#line 17322 ""
+#line 17309 ""
/* L140: */
-#line 17322 ""
+#line 17309 ""
}
-#line 17323 ""
+#line 17310 ""
if (comlast_1.islast) {
-#line 17323 ""
+#line 17310 ""
s_wsfe(&io___1037);
/* Writing concatenation */
-#line 17323 ""
+#line 17310 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17323 ""
+#line 17310 ""
i__4[1] = 11, a__2[1] = "pmxnewclefs";
-#line 17323 ""
+#line 17310 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
-#line 17323 ""
+#line 17310 ""
do_fio(&c__1, ch__5, (ftnlen)12);
-#line 17323 ""
+#line 17310 ""
e_wsfe();
-#line 17323 ""
+#line 17310 ""
}
-#line 17324 ""
+#line 17311 ""
isclef = TRUE_;
-#line 17325 ""
+#line 17312 ""
}
/* Start a notes group. We're just gonna define every one using pnotes{n}, */
/* where \def\pnotes#1{\vnotes#1\elemskip} */
/* Writing concatenation */
-#line 17330 ""
+#line 17317 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17330 ""
+#line 17317 ""
i__4[1] = 7, a__2[1] = "pnotes{";
-#line 17330 ""
+#line 17317 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 17331 ""
+#line 17318 ""
r__1 = comnsp_2.space[ib - 1] / squez[ib];
-#line 17331 ""
+#line 17318 ""
eonsqz = squez[ib] * feon_(&r__1);
-#line 17332 ""
+#line 17319 ""
if (eonsqz > 9.995f) {
-#line 17333 ""
+#line 17320 ""
s_wsfi(&io___1040);
-#line 17333 ""
+#line 17320 ""
do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
-#line 17333 ""
+#line 17320 ""
e_wsfi();
-#line 17334 ""
+#line 17321 ""
} else if (eonsqz > .995f) {
-#line 17335 ""
+#line 17322 ""
s_wsfi(&io___1041);
-#line 17335 ""
+#line 17322 ""
do_fio(&c__1, (char *)&eonsqz, (ftnlen)sizeof(real));
-#line 17335 ""
+#line 17322 ""
e_wsfi();
-#line 17336 ""
+#line 17323 ""
} else if (eonsqz > .095f) {
/* Writing concatenation */
-#line 17337 ""
+#line 17324 ""
i__4[0] = 8, a__2[0] = soutq;
-#line 17337 ""
+#line 17324 ""
i__4[1] = 2, a__2[1] = "0.";
-#line 17337 ""
+#line 17324 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 17338 ""
+#line 17325 ""
s_wsfi(&io___1042);
-#line 17338 ""
+#line 17325 ""
r__1 = eonsqz * 100;
-#line 17338 ""
- i__1 = i_nint(&r__1);
-#line 17338 ""
- do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 17338 ""
+#line 17325 ""
+ i__2 = i_nint(&r__1);
+#line 17325 ""
+ do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 17325 ""
e_wsfi();
-#line 17339 ""
+#line 17326 ""
} else {
/* Writing concatenation */
-#line 17340 ""
+#line 17327 ""
i__4[0] = 8, a__2[0] = soutq;
-#line 17340 ""
+#line 17327 ""
i__4[1] = 3, a__2[1] = "0.0";
-#line 17340 ""
+#line 17327 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 17341 ""
+#line 17328 ""
s_wsfi(&io___1043);
-#line 17341 ""
+#line 17328 ""
r__1 = eonsqz * 100;
-#line 17341 ""
- i__1 = i_nint(&r__1);
-#line 17341 ""
- do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 17341 ""
+#line 17328 ""
+ i__2 = i_nint(&r__1);
+#line 17328 ""
+ do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
+#line 17328 ""
e_wsfi();
-#line 17342 ""
+#line 17329 ""
}
/* Writing concatenation */
-#line 17343 ""
+#line 17330 ""
i__4[0] = 12, a__2[0] = soutq;
-#line 17343 ""
+#line 17330 ""
i__4[1] = 1, a__2[1] = "}";
-#line 17343 ""
+#line 17330 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 17344 ""
+#line 17331 ""
lsout = 13;
/* Check whole block, flag accidentals etc that are too close, one per *time*. */
@@ -41068,87 +41328,87 @@ L2222:
/* (fbar*wheadpt) following, but rpts seem to occupy some of that gap, so */
/* (dotsfac*wheadpt) is presumed to be filled up. */
-#line 17351 ""
+#line 17338 ""
in = istart[ib] - 1;
-#line 17352 ""
+#line 17339 ""
itrpt = -1;
-#line 17353 ""
+#line 17340 ""
itsig = -1;
/* Begin big manual loop over notes in this block; ends at 112 */
-#line 17357 ""
+#line 17344 ""
L111:
-#line 17357 ""
+#line 17344 ""
++in;
-#line 17358 ""
+#line 17345 ""
if (in > istop[ib]) {
-#line 17358 ""
+#line 17345 ""
goto L112;
-#line 17358 ""
+#line 17345 ""
}
-#line 17359 ""
+#line 17346 ""
ip = all_1.ipo[in - 1];
-#line 17360 ""
+#line 17347 ""
commvl_1.ivx = all_1.ivxo[in - 1];
-#line 17361 ""
+#line 17348 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 17362 ""
+#line 17349 ""
all_1.iv = commvl_1.ivx;
-#line 17363 ""
+#line 17350 ""
} else {
-#line 17364 ""
- i__1 = all_1.nv;
-#line 17364 ""
- for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 17365 ""
+#line 17351 ""
+ i__2 = all_1.nv;
+#line 17351 ""
+ for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 17352 ""
if (commvl_1.nvmx[all_1.iv - 1] == 2 && commvl_1.ivmx[
all_1.iv + 23] == commvl_1.ivx) {
-#line 17365 ""
+#line 17352 ""
goto L129;
-#line 17365 ""
+#line 17352 ""
}
-#line 17366 ""
+#line 17353 ""
/* L128: */
-#line 17366 ""
+#line 17353 ""
}
-#line 17367 ""
+#line 17354 ""
s_wsle(&io___1048);
-#line 17367 ""
+#line 17354 ""
do_lio(&c__9, &c__1, "Trouble finding iv!, ivx,nvmx,ivmx:", (
ftnlen)35);
-#line 17367 ""
+#line 17354 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivx, (ftnlen)sizeof(
integer));
-#line 17367 ""
+#line 17354 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[0], (ftnlen)sizeof(
integer));
-#line 17367 ""
+#line 17354 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.nvmx[1], (ftnlen)sizeof(
integer));
-#line 17367 ""
+#line 17354 ""
e_wsle();
-#line 17368 ""
+#line 17355 ""
s_wsle(&io___1049);
-#line 17368 ""
+#line 17355 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[0], (ftnlen)sizeof(
integer));
-#line 17368 ""
+#line 17355 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[24], (ftnlen)sizeof(
integer));
-#line 17368 ""
+#line 17355 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[1], (ftnlen)sizeof(
integer));
-#line 17368 ""
+#line 17355 ""
do_lio(&c__3, &c__1, (char *)&commvl_1.ivmx[25], (ftnlen)sizeof(
integer));
-#line 17368 ""
+#line 17355 ""
e_wsle();
-#line 17369 ""
+#line 17356 ""
s_stop("", (ftnlen)0);
-#line 17370 ""
+#line 17357 ""
}
-#line 17371 ""
+#line 17358 ""
L129:
/* Call precrd here so we know how much space to add for accid's in chords */
@@ -41162,65 +41422,65 @@ L129:
/* * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */
/* * btest(nacc(ivx,ip),21)) then */
/* if (.not.btest(irest(ivx,ip),24)) then */
-#line 17384 ""
+#line 17371 ""
if (numbms[commvl_1.ivx] > 0 && ibmcnt1[commvl_1.ivx - 1] <= numbms[
commvl_1.ivx] && all_1.ibm1[commvl_1.ivx + ibmcnt1[
commvl_1.ivx - 1] * 24 - 25] == ip) {
-#line 17386 ""
+#line 17373 ""
beamon1[commvl_1.ivx - 1] = TRUE_;
-#line 17387 ""
+#line 17374 ""
}
-#line 17388 ""
+#line 17375 ""
icashft = 0;
-#line 17389 ""
+#line 17376 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* There is a chord on this note. Need up-down-ness in precrd to auto shift for 2nds. */
-#line 17393 ""
+#line 17380 ""
if (beamon1[commvl_1.ivx - 1]) {
-#line 17394 ""
+#line 17381 ""
precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip *
24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[
commvl_1.ivx + ip * 24 - 25], all_1.ulq + (
commvl_1.ivx + ibmcnt1[commvl_1.ivx - 1] * 24 - 25), &
c_false, &icashft, (ftnlen)1);
-#line 17397 ""
+#line 17384 ""
} else {
-#line 17398 ""
- i__1 = ncmid_(&all_1.iv, &ip);
-#line 17398 ""
+#line 17385 ""
+ i__2 = ncmid_(&all_1.iv, &ip);
+#line 17385 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 -
- 25], &i__1, &all_1.islur[commvl_1.ivx + ip * 24 - 25],
+ 25], &i__2, &all_1.islur[commvl_1.ivx + ip * 24 - 25],
&commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
all_1.nv);
-#line 17398 ""
+#line 17385 ""
precrd_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx + ip *
24 - 25], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
all_1.ipl[commvl_1.ivx + ip * 24 - 25], &all_1.irest[
commvl_1.ivx + ip * 24 - 25], ch__6, &c_false, &
icashft, (ftnlen)1);
-#line 17402 ""
+#line 17389 ""
}
-#line 17403 ""
+#line 17390 ""
}
/* Turn beam off? */
-#line 17407 ""
+#line 17394 ""
if (beamon1[commvl_1.ivx - 1] && all_1.ibm2[commvl_1.ivx + ibmcnt1[
commvl_1.ivx - 1] * 24 - 25] == ip) {
-#line 17408 ""
+#line 17395 ""
beamon1[commvl_1.ivx - 1] = FALSE_;
-#line 17409 ""
+#line 17396 ""
++ibmcnt1[commvl_1.ivx - 1];
-#line 17410 ""
+#line 17397 ""
}
/* Remember, rpts & internal sigs can only come at start of (internal) block */
-#line 17414 ""
+#line 17401 ""
isacc = (all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && !
bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],17) && !
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10);
@@ -41229,7 +41489,7 @@ L129:
/* !!! Need to do this for chord notes too. Maybe in chkarp? */
-#line 17422 ""
+#line 17409 ""
isaccs = isacc || bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],0);
/* 5/15/02 Add check for ) ornament of prior note. */
@@ -41237,154 +41497,154 @@ L129:
/* if (ip .gt. 1) then */
/* isaccs = isaccs .or. btest(iornq(ivx,ip-1),13) */
/* end if */
-#line 17429 ""
+#line 17416 ""
isarp = bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27);
-#line 17430 ""
+#line 17417 ""
iscacc = FALSE_;
-#line 17431 ""
+#line 17418 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* There is a chord here; check for arpeggios and accidentals. Note accid shifts are */
/* not of concern here, only whether there's an accid, whick causes iscacc=.true. */
-#line 17436 ""
+#line 17423 ""
iscacc = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
c__3, &c__0) > 0 && ! bit_test(all_1.nacc[commvl_1.ivx +
ip * 24 - 25],17);
-#line 17438 ""
+#line 17425 ""
chkarp_(&comtrill_1.ncrd, comtrill_1.icrdat, &commvl_1.ivx, &ip, &
iscacc, &isarp);
-#line 17439 ""
+#line 17426 ""
}
/* When we get motivated, will do spacing for arpeggios here. */
-#line 17443 ""
+#line 17430 ""
if (commvl_1.ivx == 1 && (all_1.islur[commvl_1.ivx + ip * 24 - 25] &
96) > 0) {
-#line 17443 ""
+#line 17430 ""
itrpt = i_nint(&all_1.to[in - 1]);
-#line 17443 ""
+#line 17430 ""
}
-#line 17445 ""
+#line 17432 ""
issig = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],28);
-#line 17446 ""
+#line 17433 ""
if (commvl_1.ivx == 1 && issig) {
-#line 17446 ""
+#line 17433 ""
itsig = i_nint(&all_1.to[in - 1]);
-#line 17446 ""
+#line 17433 ""
}
-#line 17447 ""
+#line 17434 ""
isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],4) && !
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29) && !
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],31);
-#line 17449 ""
+#line 17436 ""
isgaft = FALSE_;
-#line 17450 ""
+#line 17437 ""
if (ip > 1) {
-#line 17451 ""
+#line 17438 ""
xnd = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + (ip - 1) * 24 -
25] - 1];
-#line 17452 ""
+#line 17439 ""
isgaft = bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],29)
|| bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],
31);
-#line 17453 ""
+#line 17440 ""
isgrace = isgrace || isgaft;
-#line 17454 ""
+#line 17441 ""
}
-#line 17455 ""
+#line 17442 ""
iscln = isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
11);
/* Is prev. note non-beamed, up-stemmed, & flagged? Recall if ip>1, have nd */
-#line 17459 ""
+#line 17446 ""
isflag = ip > 1 && xnd > comtol_1.tol && xnd < 16.f - comtol_1.tol;
-#line 17460 ""
+#line 17447 ""
if (isflag) {
-#line 17460 ""
+#line 17447 ""
i__7 = ip - 1;
-#line 17460 ""
- i__1 = ncmid_(&all_1.iv, &i__7);
-#line 17460 ""
+#line 17447 ""
+ i__2 = ncmid_(&all_1.iv, &i__7);
+#line 17447 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx + (ip - 1) * 24
- - 25], &i__1, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 -
+ - 25], &i__2, &all_1.islur[commvl_1.ivx + (ip - 1) * 24 -
25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
all_1.nv);
-#line 17460 ""
+#line 17447 ""
isflag = ! bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25]
,0) && *(unsigned char *)&ch__6[0] == 'u';
-#line 17460 ""
+#line 17447 ""
}
-#line 17464 ""
+#line 17451 ""
if (isflag) {
-#line 17465 ""
- i__1 = numbms[commvl_1.ivx];
-#line 17465 ""
- for (ibmchk = 1; ibmchk <= i__1; ++ibmchk) {
-#line 17466 ""
+#line 17452 ""
+ i__2 = numbms[commvl_1.ivx];
+#line 17452 ""
+ for (ibmchk = 1; ibmchk <= i__2; ++ibmchk) {
+#line 17453 ""
if (ip - 1 < all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25]) {
-#line 17467 ""
+#line 17454 ""
goto L117;
/* Add check for non-beamed xtuplets. May be problem with stem direction. */
-#line 17471 ""
+#line 17458 ""
} else if (ip - 1 <= all_1.ibm2[commvl_1.ivx + ibmchk * 24 -
25] && ! bit_test(all_1.islur[commvl_1.ivx +
all_1.ibm1[commvl_1.ivx + ibmchk * 24 - 25] * 24 - 25]
,18)) {
-#line 17473 ""
+#line 17460 ""
isflag = FALSE_;
-#line 17474 ""
+#line 17461 ""
goto L117;
-#line 17475 ""
+#line 17462 ""
}
-#line 17476 ""
+#line 17463 ""
/* L116: */
-#line 17476 ""
+#line 17463 ""
}
-#line 17477 ""
+#line 17464 ""
}
-#line 17478 ""
+#line 17465 ""
L117:
/* If isflag, then won't need to check for dot on prev. note. */
/* 5/16/02 ??? Try using this for ) ornament. */
-#line 17484 ""
+#line 17471 ""
isflag = isflag || bit_test(all_1.iornq[commvl_1.ivx + (ip - 1) * 24
- 1],13);
-#line 17485 ""
+#line 17472 ""
isdot = ip > 1;
-#line 17486 ""
+#line 17473 ""
if (isdot) {
-#line 17486 ""
- i__1 = ip - 1;
-#line 17486 ""
- isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__1);
-#line 17486 ""
+#line 17473 ""
+ i__2 = ip - 1;
+#line 17473 ""
+ isdot = isdotted_(all_1.nodur, &commvl_1.ivx, &i__2);
+#line 17473 ""
}
-#line 17487 ""
+#line 17474 ""
isrshft = ip > 1;
-#line 17488 ""
+#line 17475 ""
if (isrshft) {
-#line 17488 ""
+#line 17475 ""
isrshft = bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],
20);
-#line 17488 ""
+#line 17475 ""
}
-#line 17489 ""
+#line 17476 ""
if (! (isaccs || isgrace || iscln || isflag || isrshft || isdot ||
bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26) ||
bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],21) ||
isarp || bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)
|| iscacc)) {
-#line 17489 ""
+#line 17476 ""
goto L111;
-#line 17489 ""
+#line 17476 ""
}
/* Here is an accid,grace,clef,flag,rtshft,dot,udsp,arpeg,left-shift. */
@@ -41392,71 +41652,71 @@ L117:
/* 130324 */
/* wheadpt1 = wheadpt*fullsize(iv) */
-#line 17499 ""
+#line 17486 ""
wheadpt1 = comask_1.wheadpt * comfig_1.fullsize[cominsttrans_1.instno[
all_1.iv - 1] - 1];
-#line 17500 ""
+#line 17487 ""
pts = wheadpt1;
/* Set up for possible cautionary accidental here */
-#line 17504 ""
+#line 17491 ""
if (isaccs || iscacc) {
-#line 17505 ""
+#line 17492 ""
if (! bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],31)) {
-#line 17506 ""
+#line 17493 ""
taccfac = spfacs_1.accfac;
-#line 17507 ""
+#line 17494 ""
} else {
-#line 17508 ""
+#line 17495 ""
taccfac = spfacs_1.accfac * 1.4f;
/* cautionary accidental */
-#line 17509 ""
+#line 17496 ""
}
-#line 17510 ""
+#line 17497 ""
}
-#line 17511 ""
+#line 17498 ""
if (isgrace) {
-#line 17512 ""
+#line 17499 ""
secondgrace = FALSE_;
-#line 17513 ""
- i__1 = comgrace_1.ngrace;
-#line 17513 ""
- for (ig = 1; ig <= i__1; ++ig) {
-#line 17514 ""
+#line 17500 ""
+ i__2 = comgrace_1.ngrace;
+#line 17500 ""
+ for (ig = 1; ig <= i__2; ++ig) {
+#line 17501 ""
if (! isgaft) {
-#line 17515 ""
+#line 17502 ""
if (comgrace_1.ipg[ig - 1] == ip && comgrace_1.ivg[ig - 1]
== commvl_1.ivx) {
-#line 17515 ""
+#line 17502 ""
goto L123;
-#line 17515 ""
+#line 17502 ""
}
-#line 17516 ""
+#line 17503 ""
} else if (ip > 1) {
-#line 17517 ""
+#line 17504 ""
if (comgrace_1.ipg[ig - 1] == ip - 1 && comgrace_1.ivg[ig
- 1] == commvl_1.ivx) {
-#line 17517 ""
+#line 17504 ""
goto L123;
-#line 17517 ""
+#line 17504 ""
}
-#line 17518 ""
+#line 17505 ""
}
-#line 17519 ""
+#line 17506 ""
/* L122: */
-#line 17519 ""
+#line 17506 ""
}
-#line 17520 ""
+#line 17507 ""
s_wsle(&io___1069);
-#line 17520 ""
+#line 17507 ""
do_lio(&c__9, &c__1, "Problem finding grace index in makeabar", (
ftnlen)39);
-#line 17520 ""
+#line 17507 ""
e_wsle();
-#line 17521 ""
+#line 17508 ""
s_stop("", (ftnlen)0);
-#line 17522 ""
+#line 17509 ""
L123:
/* wgr = distance to backspace (in headwidths), less main acc. */
@@ -41464,146 +41724,146 @@ L123:
/* spgr = total space needed (w/o main acc). */
/* Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. */
-#line 17529 ""
+#line 17516 ""
if (comgrace_1.nng[ig - 1] == 1) {
-#line 17530 ""
+#line 17517 ""
wgr = spfacs_1.grafac;
-#line 17531 ""
+#line 17518 ""
if (comgrace_1.multg[ig - 1] == 0) {
-#line 17531 ""
+#line 17518 ""
wgr += -.4f;
-#line 17531 ""
+#line 17518 ""
}
-#line 17532 ""
+#line 17519 ""
} else {
-#line 17533 ""
+#line 17520 ""
wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
-#line 17534 ""
- i__1 = comgrace_1.nng[ig - 1];
-#line 17534 ""
- for (ing = 2; ing <= i__1; ++ing) {
-#line 17535 ""
+#line 17521 ""
+ i__2 = comgrace_1.nng[ig - 1];
+#line 17521 ""
+ for (ing = 2; ing <= i__2; ++ing) {
+#line 17522 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1 + ing
- 1] > 0) {
-#line 17535 ""
+#line 17522 ""
wgr += spfacs_1.acgfac;
-#line 17535 ""
+#line 17522 ""
}
-#line 17536 ""
+#line 17523 ""
/* L126: */
-#line 17536 ""
+#line 17523 ""
}
-#line 17537 ""
+#line 17524 ""
}
-#line 17538 ""
+#line 17525 ""
if (comgrace_1.graspace[ig - 1] > 0.f) {
/* User-defined space before grace */
-#line 17542 ""
+#line 17529 ""
wgr += comgrace_1.graspace[ig - 1];
-#line 17543 ""
+#line 17530 ""
}
-#line 17544 ""
+#line 17531 ""
ptgr[ig - 1] = wgr * wheadpt1;
-#line 17545 ""
+#line 17532 ""
spgr = ptgr[ig - 1] + spfacs_1.xb4fac * wheadpt1;
/* !!! May need to mod for chord accid's */
-#line 17549 ""
+#line 17536 ""
if (isaccs || iscacc) {
-#line 17549 ""
+#line 17536 ""
ptgr[ig - 1] += taccfac * wheadpt1;
-#line 17549 ""
+#line 17536 ""
}
-#line 17550 ""
+#line 17537 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1] - 1] > 0) {
-#line 17550 ""
+#line 17537 ""
spgr += wheadpt1 * spfacs_1.agc1fac;
-#line 17550 ""
+#line 17537 ""
}
-#line 17551 ""
+#line 17538 ""
pts += spgr;
/* Special check for after-grace on ip-1 and normal on ip. Must go back thru */
/* loop again for the normal grace. */
-#line 17556 ""
+#line 17543 ""
if (isgaft && ig < comgrace_1.ngrace && ! secondgrace) {
-#line 17557 ""
+#line 17544 ""
if (comgrace_1.ipg[ig] == ip) {
-#line 17558 ""
+#line 17545 ""
secondgrace = TRUE_;
-#line 17559 ""
+#line 17546 ""
++ig;
-#line 17560 ""
+#line 17547 ""
goto L123;
-#line 17561 ""
+#line 17548 ""
}
-#line 17562 ""
+#line 17549 ""
}
-#line 17563 ""
+#line 17550 ""
}
-#line 17564 ""
+#line 17551 ""
if (iscln) {
-#line 17565 ""
+#line 17552 ""
pts += spfacs_1.clefac * wheadpt1;
/* How far to backspace when printing the clef */
-#line 17569 ""
+#line 17556 ""
ptclef[commvl_1.ivx - 1] = 0.f;
/* !!! May need to mod for chord accid's */
-#line 17573 ""
+#line 17560 ""
if (isaccs || iscacc) {
-#line 17573 ""
+#line 17560 ""
ptclef[commvl_1.ivx - 1] += taccfac * wheadpt1;
-#line 17573 ""
+#line 17560 ""
}
-#line 17575 ""
+#line 17562 ""
if (isgrace) {
-#line 17575 ""
+#line 17562 ""
ptclef[commvl_1.ivx - 1] += spgr;
-#line 17575 ""
+#line 17562 ""
}
-#line 17576 ""
+#line 17563 ""
}
-#line 17577 ""
+#line 17564 ""
if (isrshft) {
-#line 17578 ""
+#line 17565 ""
pts += spfacs_1.rtshfac * wheadpt1;
-#line 17579 ""
+#line 17566 ""
} else if (isflag) {
-#line 17580 ""
+#line 17567 ""
pts += spfacs_1.flagfac * wheadpt1;
-#line 17581 ""
+#line 17568 ""
} else if (isdot) {
-#line 17582 ""
+#line 17569 ""
pts += spfacs_1.dotfac * wheadpt1;
-#line 17583 ""
+#line 17570 ""
}
-#line 17584 ""
+#line 17571 ""
if ((r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) < comtol_1.tol) {
/* Repeat, need a little extra space */
-#line 17588 ""
+#line 17575 ""
pts += spfacs_1.dotsfac * wheadpt1;
-#line 17589 ""
+#line 17576 ""
}
-#line 17590 ""
+#line 17577 ""
if (isarp) {
-#line 17591 ""
+#line 17578 ""
pts += spfacs_1.arpfac * wheadpt1;
-#line 17592 ""
+#line 17579 ""
}
/* Add in padding space */
-#line 17596 ""
+#line 17583 ""
pts += spfacs_1.xspfac * wheadpt1;
/* Now done with all items needing space except accidentals, */
@@ -41612,37 +41872,37 @@ L123:
/* Get available space in elemskips (esk) */
-#line 17604 ""
+#line 17591 ""
isfirst = ip == 1 || (r__1 = all_1.to[in - 1] - itrpt, dabs(r__1)) <
comtol_1.tol || (r__2 = all_1.to[in - 1] - itsig, dabs(r__2))
< comtol_1.tol;
-#line 17606 ""
+#line 17593 ""
if (isfirst) {
/* At start of bar or after repeat sign or new signature */
-#line 17610 ""
+#line 17597 ""
if ((r__1 = all_1.to[in - 1] - itsig, dabs(r__1)) < comtol_1.tol)
{
-#line 17611 ""
+#line 17598 ""
esk = 0.f;
-#line 17612 ""
+#line 17599 ""
} else {
-#line 17613 ""
+#line 17600 ""
esk = comask_1.fbar;
-#line 17614 ""
+#line 17601 ""
}
-#line 17615 ""
+#line 17602 ""
} else {
/* Not 1st note of bar */
-#line 17619 ""
+#line 17606 ""
esk = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - all_1.eskz[
commvl_1.ivx + (ip - 1) * 24 - 25];
-#line 17620 ""
+#line 17607 ""
}
-#line 17621 ""
+#line 17608 ""
if (isgrace) {
/* Since graces can be very long, cannot assume no interference if prior */
@@ -41652,1062 +41912,1062 @@ L123:
/* 10/8/05 Kluge to not zero out esk if in xtup */
-#line 17630 ""
+#line 17617 ""
esksav = esk;
/* Computing MAX */
-#line 17631 ""
- i__1 = 1, i__7 = ip - 2;
-#line 17631 ""
- if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__1,i__7) * 24 -
+#line 17618 ""
+ i__2 = 1, i__7 = ip - 2;
+#line 17618 ""
+ if ((ip <= 2 || all_1.nodur[commvl_1.ivx + max(i__2,i__7) * 24 -
25] > 0) && (r__1 = all_1.to[in - 1] - itsig, dabs(r__1))
> comtol_1.tol) {
-#line 17631 ""
+#line 17618 ""
eskb4_(&ip, &commvl_1.ivx, &in, &ib, comnsp_2.space, &tstart[
1], &comask_1.fbar, &itrpt, &esk);
-#line 17631 ""
+#line 17618 ""
}
/* * to(in).ne.itsig) */
-#line 17635 ""
+#line 17622 ""
if (dabs(esk) < comtol_1.tol) {
-#line 17635 ""
+#line 17622 ""
esk = esksav;
-#line 17635 ""
+#line 17622 ""
}
-#line 17636 ""
+#line 17623 ""
}
/* Done getting available elemskips. Remove headwidth if first. Must do here */
/* rather than earlier since check uses isfirst */
-#line 17641 ""
+#line 17628 ""
if (isfirst) {
-#line 17641 ""
+#line 17628 ""
pts -= wheadpt1;
-#line 17641 ""
+#line 17628 ""
}
/* Deal with accidental shifts and left-notehead shifts */
-#line 17645 ""
+#line 17632 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* In a chord */
-#line 17649 ""
+#line 17636 ""
ptsl = 0.f;
-#line 17650 ""
+#line 17637 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],27)) {
-#line 17650 ""
+#line 17637 ""
ptsl = wheadpt1;
-#line 17650 ""
+#line 17637 ""
}
/* Computing MAX */
-#line 17651 ""
+#line 17638 ""
r__1 = ptsl, r__2 = icashft * .05f * wheadpt1;
-#line 17651 ""
+#line 17638 ""
ptsadd = dmax(r__1,r__2);
/* Note: may have icashft=-20000 (if shftmin=-1000 in crdacc) but that's OK */
-#line 17655 ""
+#line 17642 ""
} else {
/* Not in a chord */
-#line 17659 ""
+#line 17646 ""
ihshft = 0;
-#line 17660 ""
+#line 17647 ""
if (isaccs) {
-#line 17661 ""
+#line 17648 ""
ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &
c__7, &c__10);
/* if (ihshft .ne. 0) ihshft = max(0,64-ihshft) */
-#line 17663 ""
+#line 17650 ""
if (ihshft != 0) {
/* Computing MAX */
-#line 17663 ""
- i__1 = 0, i__7 = 107 - ihshft;
-#line 17663 ""
- ihshft = max(i__1,i__7);
-#line 17663 ""
+#line 17650 ""
+ i__2 = 0, i__7 = 107 - ihshft;
+#line 17650 ""
+ ihshft = max(i__2,i__7);
+#line 17650 ""
}
-#line 17664 ""
+#line 17651 ""
}
/* Check for left-shifted main note */
-#line 17668 ""
+#line 17655 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
-#line 17668 ""
+#line 17655 ""
ihshft = max(20,ihshft);
-#line 17668 ""
+#line 17655 ""
}
-#line 17669 ""
+#line 17656 ""
ptsadd = ihshft * .05f * wheadpt1;
-#line 17670 ""
+#line 17657 ""
}
-#line 17671 ""
+#line 17658 ""
pts += ptsadd;
-#line 17672 ""
+#line 17659 ""
if (isgrace) {
-#line 17672 ""
+#line 17659 ""
ptgr[ig - 1] += ptsadd;
-#line 17672 ""
+#line 17659 ""
}
-#line 17673 ""
+#line 17660 ""
if (iscln) {
-#line 17673 ""
+#line 17660 ""
ptclef[commvl_1.ivx - 1] += ptsadd;
-#line 17673 ""
+#line 17660 ""
}
/* Left-shifted, non-chord note before? */
-#line 17677 ""
+#line 17664 ""
if (ip > 1) {
-#line 17678 ""
+#line 17665 ""
if (! bit_test(all_1.ipl[commvl_1.ivx + (ip - 1) * 24 - 25],10) &&
bit_test(all_1.irest[commvl_1.ivx + (ip - 1) * 24 - 25],
27)) {
-#line 17678 ""
+#line 17665 ""
pts -= wheadpt1;
-#line 17678 ""
+#line 17665 ""
}
-#line 17680 ""
+#line 17667 ""
}
/* Try big accidentals first */
-#line 17684 ""
+#line 17671 ""
ptbneed = pts;
-#line 17685 ""
+#line 17672 ""
if (isaccs || iscacc) {
-#line 17686 ""
+#line 17673 ""
ptbneed += wheadpt1 * spfacs_1.bacfac;
-#line 17687 ""
+#line 17674 ""
}
-#line 17688 ""
+#line 17675 ""
if (comshort_1.poefa[all_1.iline - 1] * comask_1.poenom * esk >
ptbneed) {
/* Set flag for big accidental */
-#line 17692 ""
+#line 17679 ""
if (isacc) {
-#line 17692 ""
+#line 17679 ""
all_1.nacc[commvl_1.ivx + ip * 24 - 25] = bit_set(all_1.nacc[
commvl_1.ivx + ip * 24 - 25],3);
-#line 17692 ""
+#line 17679 ""
}
-#line 17693 ""
+#line 17680 ""
goto L99;
-#line 17694 ""
+#line 17681 ""
}
/* Cannot use big, so try small */
-#line 17698 ""
+#line 17685 ""
ptsneed = pts;
-#line 17699 ""
+#line 17686 ""
if (isaccs || iscacc) {
-#line 17700 ""
+#line 17687 ""
ptsneed += taccfac * wheadpt1;
-#line 17701 ""
+#line 17688 ""
}
-#line 17702 ""
+#line 17689 ""
if (comshort_1.poefa[all_1.iline - 1] * comask_1.poenom * esk <
ptsneed) {
-#line 17703 ""
+#line 17690 ""
r__1 = comshort_1.poefa[all_1.iline - 1] * esk;
-#line 17703 ""
+#line 17690 ""
addask_(&all_1.to[in - 1], &ptsneed, &r__1, &comask_1.fixednew, &
comask_1.scaldold, &c_b1008, &comshort_1.poefa[
all_1.iline - 1], &c_false);
-#line 17705 ""
+#line 17692 ""
}
-#line 17706 ""
+#line 17693 ""
L99:
-#line 17707 ""
+#line 17694 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],26)) {
/* User-defined space. Warning, "zero" may change value in addask! */
-#line 17711 ""
+#line 17698 ""
zero = 0.f;
-#line 17712 ""
+#line 17699 ""
addask_(&all_1.to[in - 1], &ptsneed, &zero, &comask_1.fixednew, &
comask_1.scaldold, tglp1, &c_b1053, &c_true);
-#line 17714 ""
+#line 17701 ""
}
/* End of big manual loop over "in" for accidental checking */
-#line 17718 ""
+#line 17705 ""
goto L111;
-#line 17719 ""
+#line 17706 ""
L112:
/* End of ask analysis for this block. */
/* Adjust eskz if there are added spaces. Corrects length of xtup brackets. */
-#line 17725 ""
+#line 17712 ""
if (comas1_1.naskb > 0) {
-#line 17725 ""
+#line 17712 ""
adjusteskz_(&ib, &istart[1], &comask_1.poenom);
-#line 17725 ""
+#line 17712 ""
}
/* Check for internal repeat or sig change. */
-#line 17729 ""
+#line 17716 ""
if (ib > 1 && all_1.ivxo[istart[ib] - 1] == 1) {
-#line 17730 ""
+#line 17717 ""
iirpt = all_1.islur[all_1.ipo[istart[ib] - 1] * 24 - 24] &
67109216;
-#line 17731 ""
+#line 17718 ""
if (iirpt > 0) {
/* Internal repeat */
-#line 17735 ""
+#line 17722 ""
if (comlast_1.islast) {
-#line 17735 ""
+#line 17722 ""
s_wsfe(&io___1085);
/* Writing concatenation */
-#line 17735 ""
+#line 17722 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 17735 ""
+#line 17722 ""
i__9[1] = 7, a__6[1] = "advance";
-#line 17735 ""
+#line 17722 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 17735 ""
+#line 17722 ""
i__9[3] = 8, a__6[3] = "barno-1%";
-#line 17735 ""
+#line 17722 ""
s_cat(ch__7, a__6, i__9, &c__4, (ftnlen)17);
-#line 17735 ""
+#line 17722 ""
do_fio(&c__1, ch__7, (ftnlen)17);
-#line 17735 ""
+#line 17722 ""
e_wsfe();
-#line 17735 ""
+#line 17722 ""
}
-#line 17736 ""
+#line 17723 ""
if (iirpt == 96) {
-#line 17737 ""
+#line 17724 ""
if (comlast_1.islast) {
-#line 17737 ""
+#line 17724 ""
s_wsfe(&io___1086);
/* Writing concatenation */
-#line 17737 ""
+#line 17724 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17737 ""
+#line 17724 ""
i__4[1] = 15, a__2[1] = "leftrightrepeat";
-#line 17737 ""
+#line 17724 ""
s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)16);
-#line 17737 ""
+#line 17724 ""
do_fio(&c__1, ch__8, (ftnlen)16);
-#line 17737 ""
+#line 17724 ""
e_wsfe();
-#line 17737 ""
+#line 17724 ""
}
-#line 17738 ""
+#line 17725 ""
comask_1.fixednew += spfacs_1.lrrptfac * comask_1.wheadpt;
-#line 17739 ""
+#line 17726 ""
} else if (bit_test(iirpt,5)) {
-#line 17740 ""
+#line 17727 ""
if (comlast_1.islast) {
-#line 17740 ""
+#line 17727 ""
s_wsfe(&io___1087);
/* Writing concatenation */
-#line 17740 ""
+#line 17727 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17740 ""
+#line 17727 ""
i__4[1] = 10, a__2[1] = "leftrepeat";
-#line 17740 ""
+#line 17727 ""
s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11);
-#line 17740 ""
+#line 17727 ""
do_fio(&c__1, ch__9, (ftnlen)11);
-#line 17740 ""
+#line 17727 ""
e_wsfe();
-#line 17740 ""
+#line 17727 ""
}
-#line 17741 ""
+#line 17728 ""
comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
-#line 17742 ""
+#line 17729 ""
} else if (bit_test(iirpt,6)) {
-#line 17743 ""
+#line 17730 ""
if (comlast_1.islast) {
-#line 17743 ""
+#line 17730 ""
s_wsfe(&io___1088);
/* Writing concatenation */
-#line 17743 ""
+#line 17730 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17743 ""
+#line 17730 ""
i__4[1] = 11, a__2[1] = "rightrepeat";
-#line 17743 ""
+#line 17730 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
-#line 17743 ""
+#line 17730 ""
do_fio(&c__1, ch__5, (ftnlen)12);
-#line 17743 ""
+#line 17730 ""
e_wsfe();
-#line 17743 ""
+#line 17730 ""
}
-#line 17744 ""
+#line 17731 ""
comask_1.fixednew += spfacs_1.rptfac * comask_1.wheadpt;
-#line 17745 ""
+#line 17732 ""
} else if (bit_test(iirpt,8)) {
-#line 17746 ""
+#line 17733 ""
if (comlast_1.islast) {
-#line 17746 ""
+#line 17733 ""
s_wsfe(&io___1089);
/* Writing concatenation */
-#line 17746 ""
+#line 17733 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17746 ""
+#line 17733 ""
i__4[1] = 9, a__2[1] = "doublebar";
-#line 17746 ""
+#line 17733 ""
s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10);
-#line 17746 ""
+#line 17733 ""
do_fio(&c__1, ch__10, (ftnlen)10);
-#line 17746 ""
+#line 17733 ""
e_wsfe();
-#line 17746 ""
+#line 17733 ""
}
-#line 17747 ""
+#line 17734 ""
} else {
-#line 17748 ""
+#line 17735 ""
s_wsle(&io___1090);
-#line 17748 ""
+#line 17735 ""
do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command "\
"R*", (ftnlen)36);
-#line 17748 ""
+#line 17735 ""
e_wsle();
-#line 17749 ""
+#line 17736 ""
stop1_();
-#line 17750 ""
+#line 17737 ""
}
-#line 17751 ""
+#line 17738 ""
comask_1.scaldold -= comask_1.fbar;
-#line 17752 ""
+#line 17739 ""
}
-#line 17753 ""
+#line 17740 ""
if (bit_test(all_1.ipl[all_1.ipo[istart[ib] - 1] * 24 - 24],28)) {
/* Internal signature change. */
/* Writing concatenation */
-#line 17757 ""
+#line 17744 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17757 ""
+#line 17744 ""
i__4[1] = 17, a__2[1] = "generalsignature{";
-#line 17757 ""
+#line 17744 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17758 ""
+#line 17745 ""
lnote = 18;
-#line 17759 ""
+#line 17746 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
-#line 17760 ""
+#line 17747 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 17760 ""
+#line 17747 ""
i__4[1] = 1, a__2[1] = "-";
-#line 17760 ""
+#line 17747 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17761 ""
+#line 17748 ""
++lnote;
-#line 17762 ""
+#line 17749 ""
}
-#line 17763 ""
+#line 17750 ""
if (comlast_1.islast) {
-#line 17763 ""
+#line 17750 ""
s_wsfe(&io___1091);
/* Writing concatenation */
-#line 17763 ""
+#line 17750 ""
i__6[0] = lnote, a__4[0] = notexq;
-#line 17763 ""
- i__1 = abs(comtop_1.isig) + 48;
-#line 17763 ""
- chax_(ch__6, (ftnlen)1, &i__1);
-#line 17763 ""
+#line 17750 ""
+ i__2 = abs(comtop_1.isig) + 48;
+#line 17750 ""
+ chax_(ch__6, (ftnlen)1, &i__2);
+#line 17750 ""
i__6[1] = 1, a__4[1] = ch__6;
-#line 17763 ""
+#line 17750 ""
i__6[2] = 2, a__4[2] = "}%";
-#line 17763 ""
+#line 17750 ""
s_cat(ch__2, a__4, i__6, &c__3, (ftnlen)82);
-#line 17763 ""
+#line 17750 ""
do_fio(&c__1, ch__2, lnote + 3);
-#line 17763 ""
+#line 17750 ""
e_wsfe();
-#line 17763 ""
+#line 17750 ""
}
-#line 17765 ""
+#line 17752 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
-#line 17765 ""
+#line 17752 ""
s_wsfe(&io___1092);
/* Writing concatenation */
-#line 17765 ""
+#line 17752 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17765 ""
+#line 17752 ""
i__4[1] = 11, a__2[1] = "ignorenats%";
-#line 17765 ""
+#line 17752 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
-#line 17765 ""
+#line 17752 ""
do_fio(&c__1, ch__5, (ftnlen)12);
-#line 17765 ""
+#line 17752 ""
e_wsfe();
-#line 17765 ""
+#line 17752 ""
}
-#line 17767 ""
+#line 17754 ""
if (comlast_1.islast) {
-#line 17767 ""
+#line 17754 ""
s_wsfe(&io___1093);
/* Writing concatenation */
-#line 17767 ""
+#line 17754 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 17767 ""
+#line 17754 ""
i__3[1] = 14, a__1[1] = "zchangecontext";
-#line 17767 ""
+#line 17754 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 17767 ""
+#line 17754 ""
i__3[3] = 12, a__1[3] = "addspace{-.5";
-#line 17767 ""
+#line 17754 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 17767 ""
+#line 17754 ""
i__3[5] = 15, a__1[5] = "afterruleskip}%";
-#line 17767 ""
+#line 17754 ""
s_cat(ch__11, a__1, i__3, &c__6, (ftnlen)44);
-#line 17767 ""
+#line 17754 ""
do_fio(&c__1, ch__11, (ftnlen)44);
-#line 17767 ""
+#line 17754 ""
e_wsfe();
-#line 17767 ""
+#line 17754 ""
}
-#line 17769 ""
+#line 17756 ""
lnote = 0;
-#line 17770 ""
+#line 17757 ""
}
-#line 17771 ""
+#line 17758 ""
}
-#line 17772 ""
+#line 17759 ""
comnsp_2.flgndb = FALSE_;
/* Done with start-of-block stuff. Begin main loop over voices. */
-#line 17776 ""
- i__1 = all_1.nv;
-#line 17776 ""
- for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 17777 ""
+#line 17763 ""
+ i__2 = all_1.nv;
+#line 17763 ""
+ for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 17764 ""
i__7 = commvl_1.nvmx[all_1.iv - 1];
-#line 17777 ""
+#line 17764 ""
for (kv = 1; kv <= i__7; ++kv) {
-#line 17778 ""
+#line 17765 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 17779 ""
+#line 17766 ""
icm = commidi_1.midchan[all_1.iv + kv * 24 - 25];
/* A rather klugey way to set flag for figure in this voice */
/* Must always check figbass before figchk. */
-#line 17784 ""
+#line 17771 ""
if (all_1.figbass) {
-#line 17785 ""
+#line 17772 ""
ivf = 0;
-#line 17786 ""
+#line 17773 ""
if (commvl_1.ivx == 1) {
-#line 17787 ""
+#line 17774 ""
ivf = 1;
-#line 17788 ""
+#line 17775 ""
} else if (commvl_1.ivx == comfig_1.ivxfig2) {
-#line 17789 ""
+#line 17776 ""
ivf = 2;
-#line 17790 ""
+#line 17777 ""
}
-#line 17791 ""
+#line 17778 ""
if (ivf > 0) {
-#line 17791 ""
+#line 17778 ""
all_1.figchk[ivf - 1] = comfig_1.nfigs[ivf - 1] > 0;
-#line 17791 ""
+#line 17778 ""
}
-#line 17792 ""
+#line 17779 ""
}
-#line 17793 ""
+#line 17780 ""
if (commvl_1.ivx > 1) {
-#line 17794 ""
+#line 17781 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 17795 ""
+#line 17782 ""
addstr_(all_1.sepsymq + (all_1.iv - 2), &c__1, soutq,
&lsout, (ftnlen)1, (ftnlen)80);
-#line 17796 ""
+#line 17783 ""
} else {
/* Writing concatenation */
-#line 17797 ""
+#line 17784 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17797 ""
+#line 17784 ""
i__4[1] = 9, a__2[1] = "nextvoice";
-#line 17797 ""
+#line 17784 ""
s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)10);
-#line 17797 ""
+#line 17784 ""
addstr_(ch__10, &c__10, soutq, &lsout, (ftnlen)10, (
ftnlen)80);
-#line 17798 ""
+#line 17785 ""
}
-#line 17799 ""
+#line 17786 ""
}
-#line 17800 ""
+#line 17787 ""
if (comhead_1.ihdht > 0 && commvl_1.ivx == all_1.nv) {
/* Write header. First adjust height if needed to miss barno. */
-#line 17804 ""
+#line 17791 ""
if (comask_1.bar1syst && all_1.iline != 1) {
-#line 17805 ""
+#line 17792 ""
comhead_1.ihdht = comsln_1.irzbnd + 15 +
comsln_1.isnx;
-#line 17806 ""
+#line 17793 ""
}
/* Add user-defined vertical shift */
-#line 17810 ""
+#line 17797 ""
comhead_1.ihdht += comhead_1.ihdvrt;
-#line 17811 ""
+#line 17798 ""
lchead = lenstr_(comhead_1.headrq, &c__80, (ftnlen)80);
/* Writing concatenation */
-#line 17812 ""
+#line 17799 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17812 ""
+#line 17799 ""
i__4[1] = 10, a__2[1] = "zcharnote{";
-#line 17812 ""
+#line 17799 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17813 ""
+#line 17800 ""
s_wsfi(&io___1097);
-#line 17813 ""
+#line 17800 ""
do_fio(&c__1, (char *)&comhead_1.ihdht, (ftnlen)sizeof(
integer));
-#line 17813 ""
+#line 17800 ""
e_wsfi();
/* Writing concatenation */
-#line 17814 ""
+#line 17801 ""
i__3[0] = 13, a__1[0] = notexq;
-#line 17814 ""
+#line 17801 ""
i__3[1] = 2, a__1[1] = "}{";
-#line 17814 ""
+#line 17801 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 17814 ""
+#line 17801 ""
i__3[3] = 7, a__1[3] = "bigfont";
-#line 17814 ""
+#line 17801 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 17814 ""
+#line 17801 ""
i__3[5] = 10, a__1[5] = "kern-30pt ";
-#line 17814 ""
+#line 17801 ""
s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79);
-#line 17815 ""
+#line 17802 ""
addstr_(notexq, &c__34, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
/* Writing concatenation */
-#line 17816 ""
+#line 17803 ""
i__4[0] = lchead, a__2[0] = comhead_1.headrq;
-#line 17816 ""
+#line 17803 ""
i__4[1] = 1, a__2[1] = "}";
-#line 17816 ""
+#line 17803 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
-#line 17816 ""
+#line 17803 ""
i__10 = lchead + 1;
-#line 17816 ""
+#line 17803 ""
addstr_(ch__12, &i__10, soutq, &lsout, lchead + 1, (
ftnlen)80);
-#line 17817 ""
+#line 17804 ""
comhead_1.ihdht = 0;
-#line 17818 ""
+#line 17805 ""
}
-#line 17819 ""
+#line 17806 ""
if (comhead_1.lower && commvl_1.ivx == all_1.nv) {
-#line 17820 ""
+#line 17807 ""
lclow = lenstr_(comhead_1.lowerq, &c__80, (ftnlen)80);
/* Writing concatenation */
-#line 17821 ""
+#line 17808 ""
i__11[0] = 1, a__7[0] = all_1.sq;
-#line 17821 ""
+#line 17808 ""
i__11[1] = 14, a__7[1] = "zcharnote{-6}{";
-#line 17821 ""
+#line 17808 ""
i__11[2] = 1, a__7[2] = all_1.sq;
-#line 17821 ""
+#line 17808 ""
i__11[3] = 5, a__7[3] = "tempo";
-#line 17821 ""
+#line 17808 ""
i__11[4] = 1, a__7[4] = all_1.sq;
-#line 17821 ""
+#line 17808 ""
i__11[5] = 10, a__7[5] = "kern-10pt ";
-#line 17821 ""
+#line 17808 ""
i__11[6] = lclow, a__7[6] = comhead_1.lowerq;
-#line 17821 ""
+#line 17808 ""
i__11[7] = 1, a__7[7] = "}";
-#line 17821 ""
+#line 17808 ""
s_cat(ch__13, a__7, i__11, &c__8, (ftnlen)113);
-#line 17821 ""
+#line 17808 ""
i__10 = lclow + 33;
-#line 17821 ""
+#line 17808 ""
addstr_(ch__13, &i__10, soutq, &lsout, lclow + 33, (
ftnlen)80);
-#line 17824 ""
+#line 17811 ""
comhead_1.lower = FALSE_;
-#line 17825 ""
+#line 17812 ""
}
-#line 17826 ""
+#line 17813 ""
tnow = tstart[ib];
-#line 17827 ""
+#line 17814 ""
nofirst = TRUE_;
/* Done setting up voice ivx for start of block ib. Loop over notes in voice. */
-#line 17831 ""
+#line 17818 ""
i__10 = istop[ib];
-#line 17831 ""
+#line 17818 ""
for (all_1.jn = istart[ib]; all_1.jn <= i__10; ++all_1.jn) {
-#line 17832 ""
+#line 17819 ""
if (all_1.ivxo[all_1.jn - 1] != commvl_1.ivx) {
-#line 17832 ""
+#line 17819 ""
goto L10;
-#line 17832 ""
+#line 17819 ""
}
-#line 17833 ""
+#line 17820 ""
ip = all_1.ipo[all_1.jn - 1];
/* May have problem with not initializing islhgt, so do it here */
-#line 17837 ""
+#line 17824 ""
islhgt = 0;
-#line 17839 ""
+#line 17826 ""
if (nofirst) {
-#line 17840 ""
+#line 17827 ""
comoct_1.noctup = 0;
-#line 17841 ""
+#line 17828 ""
if (ncmid_(&all_1.iv, &ip) == 23) {
-#line 17841 ""
+#line 17828 ""
comoct_1.noctup = -2;
-#line 17841 ""
+#line 17828 ""
}
-#line 17842 ""
+#line 17829 ""
nofirst = FALSE_;
-#line 17843 ""
+#line 17830 ""
}
/* Check for internal floating figure (before last note of group). */
-#line 17847 ""
+#line 17834 ""
L12:
-#line 17847 ""
+#line 17834 ""
if (all_1.figbass) {
-#line 17848 ""
+#line 17835 ""
if (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
-#line 17849 ""
+#line 17836 ""
ivf = 1;
-#line 17850 ""
+#line 17837 ""
if (commvl_1.ivx > 1) {
-#line 17850 ""
+#line 17837 ""
ivf = 2;
-#line 17850 ""
+#line 17837 ""
}
-#line 17851 ""
+#line 17838 ""
if (all_1.figchk[ivf - 1] && (real)
comfig_1.itfig[ivf + (ifig[ivf - 1] << 1)
- 3] < tnow - comtol_1.tol) {
/* Bypassed figure location. Backup, place fig, return. */
-#line 17856 ""
+#line 17843 ""
offnsk = (tnow - comfig_1.itfig[ivf + (ifig[
ivf - 1] << 1) - 3]) / comnsp_2.space[
ib - 1];
-#line 17857 ""
+#line 17844 ""
putfig_(&ivf, &ifig[ivf - 1], &offnsk, &
all_1.figchk[ivf - 1], soutq, &lsout,
(ftnlen)80);
-#line 17859 ""
+#line 17846 ""
goto L12;
-#line 17860 ""
+#line 17847 ""
}
-#line 17861 ""
+#line 17848 ""
}
-#line 17862 ""
+#line 17849 ""
}
/* Put in \sk if needed */
-#line 17866 ""
+#line 17853 ""
if (all_1.to[all_1.jn - 1] > tnow + comtol_1.tol) {
/* Writing concatenation */
-#line 17867 ""
+#line 17854 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17867 ""
+#line 17854 ""
i__4[1] = 2, a__2[1] = "sk";
-#line 17867 ""
+#line 17854 ""
s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3);
-#line 17867 ""
+#line 17854 ""
addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (
ftnlen)80);
-#line 17868 ""
+#line 17855 ""
tnow += comnsp_2.space[ib - 1];
-#line 17869 ""
+#line 17856 ""
goto L12;
-#line 17870 ""
+#line 17857 ""
}
/* Check for user-defined shifts */
-#line 17874 ""
+#line 17861 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15)
|| bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],16)) {
-#line 17874 ""
+#line 17861 ""
putshft_(&commvl_1.ivx, &c_true, soutq, &lsout, (
ftnlen)80);
-#line 17874 ""
+#line 17861 ""
}
-#line 17876 ""
+#line 17863 ""
L21:
-#line 17876 ""
+#line 17863 ""
if (iaskb[commvl_1.ivx - 1] <= comas1_1.naskb && tnow >
comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] -
comtol_1.tol) {
-#line 17878 ""
+#line 17865 ""
if (comas1_1.task[iaskb[commvl_1.ivx - 1] - 1] >
tstart[ib] - comtol_1.tol) {
/* Insert placeholder for accidental skip */
/* Writing concatenation */
-#line 17882 ""
+#line 17869 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17882 ""
+#line 17869 ""
i__4[1] = 8, a__2[1] = "ask ";
-#line 17882 ""
+#line 17869 ""
s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)9);
-#line 17882 ""
+#line 17869 ""
addstr_(ch__15, &c__9, soutq, &lsout, (ftnlen)9, (
ftnlen)80);
-#line 17883 ""
+#line 17870 ""
++comas2_1.nasksys;
-#line 17884 ""
+#line 17871 ""
comas2_1.wasksys[comas2_1.nasksys - 1] =
comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1]
;
-#line 17885 ""
+#line 17872 ""
if (comas1_1.wask[iaskb[commvl_1.ivx - 1] - 1] >
0.f) {
-#line 17886 ""
+#line 17873 ""
comas2_1.elasksys[comas2_1.nasksys - 1] =
comas1_1.elask[iaskb[commvl_1.ivx - 1]
- 1];
-#line 17887 ""
+#line 17874 ""
} else {
/* This is a signal to permit negative ask's. Should really have elask>=0. */
-#line 17891 ""
+#line 17878 ""
comas2_1.elasksys[comas2_1.nasksys - 1] =
-comas1_1.elask[iaskb[commvl_1.ivx -
1] - 1];
-#line 17892 ""
+#line 17879 ""
}
-#line 17893 ""
+#line 17880 ""
}
/* May have skipped some task's in earlier blocks (due to void voice) */
-#line 17897 ""
+#line 17884 ""
++iaskb[commvl_1.ivx - 1];
-#line 17898 ""
+#line 17885 ""
goto L21;
-#line 17899 ""
+#line 17886 ""
}
-#line 17900 ""
+#line 17887 ""
if (all_1.figbass) {
-#line 17901 ""
+#line 17888 ""
if (commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
-#line 17902 ""
+#line 17889 ""
ivf = 1;
-#line 17903 ""
+#line 17890 ""
if (commvl_1.ivx > 1) {
-#line 17903 ""
+#line 17890 ""
ivf = 2;
-#line 17903 ""
+#line 17890 ""
}
-#line 17904 ""
+#line 17891 ""
if (all_1.figchk[ivf - 1] && (r__1 =
comfig_1.itfig[ivf + (ifig[ivf - 1] << 1)
- 3] - tnow, dabs(r__1)) < comtol_1.tol) {
/* Figure on a note. NB: later special check for late figs. */
-#line 17909 ""
+#line 17896 ""
putfig_(&ivf, &ifig[ivf - 1], &c_b1008, &
all_1.figchk[ivf - 1], soutq, &lsout,
(ftnlen)80);
-#line 17910 ""
+#line 17897 ""
}
-#line 17911 ""
+#line 17898 ""
}
-#line 17912 ""
+#line 17899 ""
}
/* Check for new clef here. */
-#line 17916 ""
+#line 17903 ""
if (isclef && bit_test(all_1.islur[commvl_1.ivx + ip * 24
- 25],11)) {
-#line 17917 ""
+#line 17904 ""
if (ptclef[all_1.iv - 1] > 0.f) {
/* Writing concatenation */
-#line 17918 ""
+#line 17905 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17918 ""
+#line 17905 ""
i__4[1] = 5, a__2[1] = "off{-";
-#line 17918 ""
+#line 17905 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17919 ""
+#line 17906 ""
if (ptclef[all_1.iv - 1] < 9.95f) {
-#line 17920 ""
+#line 17907 ""
s_wsfi(&io___1103);
-#line 17920 ""
+#line 17907 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
-#line 17920 ""
+#line 17907 ""
e_wsfi();
-#line 17921 ""
+#line 17908 ""
lnote = 9;
-#line 17922 ""
+#line 17909 ""
} else {
-#line 17923 ""
+#line 17910 ""
s_wsfi(&io___1104);
-#line 17923 ""
+#line 17910 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
-#line 17923 ""
+#line 17910 ""
e_wsfi();
-#line 17924 ""
+#line 17911 ""
lnote = 10;
-#line 17925 ""
+#line 17912 ""
}
/* Writing concatenation */
-#line 17926 ""
+#line 17913 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 17926 ""
+#line 17913 ""
i__4[1] = 3, a__2[1] = "pt}";
-#line 17926 ""
+#line 17913 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17927 ""
+#line 17914 ""
lnote += 3;
-#line 17928 ""
+#line 17915 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
(ftnlen)80);
-#line 17929 ""
+#line 17916 ""
}
-#line 17930 ""
+#line 17917 ""
clefsym_(&all_1.islur[all_1.iv + ip * 24 - 25],
notexq, &lnote, &nclef, (ftnlen)79);
/* 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' */
-#line 17934 ""
+#line 17921 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],2)
) {
/* Writing concatenation */
-#line 17934 ""
+#line 17921 ""
i__6[0] = 8, a__4[0] = notexq;
-#line 17934 ""
+#line 17921 ""
i__6[1] = 1, a__4[1] = "8";
-#line 17934 ""
+#line 17921 ""
i__6[2] = 1, a__4[2] = notexq + 9;
-#line 17934 ""
+#line 17921 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79);
-#line 17934 ""
+#line 17921 ""
}
-#line 17936 ""
+#line 17923 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 17937 ""
+#line 17924 ""
if (ptclef[all_1.iv - 1] > 0.f) {
/* Writing concatenation */
-#line 17938 ""
+#line 17925 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 17938 ""
+#line 17925 ""
i__4[1] = 4, a__2[1] = "off{";
-#line 17938 ""
+#line 17925 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17939 ""
+#line 17926 ""
if (ptclef[all_1.iv - 1] < 9.95f) {
-#line 17940 ""
+#line 17927 ""
s_wsfi(&io___1106);
-#line 17940 ""
+#line 17927 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
-#line 17940 ""
+#line 17927 ""
e_wsfi();
-#line 17941 ""
+#line 17928 ""
lnote = 8;
-#line 17942 ""
+#line 17929 ""
} else {
-#line 17943 ""
+#line 17930 ""
s_wsfi(&io___1107);
-#line 17943 ""
+#line 17930 ""
do_fio(&c__1, (char *)&ptclef[all_1.iv - 1], (
ftnlen)sizeof(real));
-#line 17943 ""
+#line 17930 ""
e_wsfi();
-#line 17944 ""
+#line 17931 ""
lnote = 9;
-#line 17945 ""
+#line 17932 ""
}
/* Writing concatenation */
-#line 17946 ""
+#line 17933 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 17946 ""
+#line 17933 ""
i__4[1] = 3, a__2[1] = "pt}";
-#line 17946 ""
+#line 17933 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 17947 ""
+#line 17934 ""
lnote += 3;
-#line 17948 ""
+#line 17935 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
(ftnlen)80);
-#line 17949 ""
+#line 17936 ""
}
-#line 17950 ""
+#line 17937 ""
}
/* Checking for literal TeX string BEFORE starting beams!! */
-#line 17954 ""
+#line 17941 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],16))
{
-#line 17955 ""
+#line 17942 ""
i__12 = comgrace_1.nlit;
-#line 17955 ""
+#line 17942 ""
for (il = 1; il <= i__12; ++il) {
-#line 17956 ""
+#line 17943 ""
if (comgrace_1.iplit[il - 1] == ip &&
comgrace_1.ivlit[il - 1] == commvl_1.ivx)
{
-#line 17956 ""
+#line 17943 ""
goto L125;
-#line 17956 ""
+#line 17943 ""
}
-#line 17957 ""
+#line 17944 ""
/* L124: */
-#line 17957 ""
+#line 17944 ""
}
-#line 17958 ""
+#line 17945 ""
s_wsle(&io___1109);
-#line 17958 ""
+#line 17945 ""
do_lio(&c__9, &c__1, "Problem finding index for lite"\
"ral string", (ftnlen)40);
-#line 17958 ""
+#line 17945 ""
e_wsle();
-#line 17959 ""
+#line 17946 ""
stop1_();
-#line 17960 ""
+#line 17947 ""
L125:
/* Write a type 1 tex string. */
-#line 17964 ""
+#line 17951 ""
if (comgrace_1.lenlit[il - 1] < 71) {
/* Add normally */
-#line 17968 ""
+#line 17955 ""
addstr_(comgrace_1.litq + (il - 1 << 7), &
comgrace_1.lenlit[il - 1], soutq, &lsout,
(ftnlen)128, (ftnlen)80);
-#line 17969 ""
+#line 17956 ""
} else {
/* Longer than 71. Write souq, Write string, start new soutq. */
-#line 17973 ""
+#line 17960 ""
if (comlast_1.islast) {
-#line 17973 ""
+#line 17960 ""
s_wsfe(&io___1110);
/* Writing concatenation */
-#line 17973 ""
+#line 17960 ""
i__4[0] = lsout, a__2[0] = soutq;
-#line 17973 ""
+#line 17960 ""
i__4[1] = 1, a__2[1] = "%";
-#line 17973 ""
+#line 17960 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
-#line 17973 ""
+#line 17960 ""
do_fio(&c__1, ch__12, lsout + 1);
-#line 17973 ""
+#line 17960 ""
e_wsfe();
-#line 17973 ""
+#line 17960 ""
}
-#line 17974 ""
+#line 17961 ""
if (comlast_1.islast) {
-#line 17974 ""
+#line 17961 ""
s_wsfe(&io___1111);
/* Writing concatenation */
-#line 17974 ""
+#line 17961 ""
i__4[0] = comgrace_1.lenlit[il - 1], a__2[0] =
comgrace_1.litq + (il - 1 << 7);
-#line 17974 ""
+#line 17961 ""
i__4[1] = 1, a__2[1] = "%";
-#line 17974 ""
+#line 17961 ""
s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)129);
-#line 17974 ""
+#line 17961 ""
do_fio(&c__1, ch__16, comgrace_1.lenlit[il -
1] + 1);
-#line 17974 ""
+#line 17961 ""
e_wsfe();
-#line 17974 ""
+#line 17961 ""
}
-#line 17975 ""
+#line 17962 ""
lsout = 0;
-#line 17976 ""
+#line 17963 ""
}
-#line 17977 ""
+#line 17964 ""
}
/* Arpeggio on a main (non-chordal) note? */
-#line 17981 ""
+#line 17968 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],27))
{
/* call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), */
-#line 17983 ""
+#line 17970 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 17983 ""
+#line 17970 ""
putarp_(&tnow, &commvl_1.ivx, &ip, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &i__12, soutq, &
lsout, (ftnlen)80);
-#line 17985 ""
+#line 17972 ""
}
/* See if a beam starts here */
-#line 17989 ""
+#line 17976 ""
if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[commvl_1.ivx
- 1] <= numbms[commvl_1.ivx] && all_1.ibm1[
commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] *
24 - 25] == ip || bit_test(all_1.nacc[
commvl_1.ivx + ip * 24 - 25],21)) {
-#line 17992 ""
+#line 17979 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],24)) {
/* Not a jump start */
-#line 17996 ""
+#line 17983 ""
if (comkbdrests_1.kbdrests && bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],
0) && ! bit_test(all_1.islur[commvl_1.ivx
+ ip * 24 - 25],29) && commvl_1.nvmx[
all_1.iv - 1] == 2 && all_1.nolev[
commvl_1.ivx + ip * 24 - 25] <= 50) {
-#line 17996 ""
+#line 17983 ""
chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
all_1.nn, all_1.islur, all_1.irest,
all_1.nolev, commvl_1.ivmx, all_1.nib,
@@ -42716,117 +42976,117 @@ L125:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
-#line 17996 ""
+#line 17983 ""
}
-#line 18002 ""
+#line 17989 ""
beamstrt_(notexq, &lnote, nornb, ihornb,
comnsp_2.space, &squez[1], &ib, (ftnlen)
79);
/* Shift beam start if notehead was shifted */
-#line 18006 ""
+#line 17993 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],8)) {
/* Writing concatenation */
-#line 18007 ""
+#line 17994 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18007 ""
+#line 17994 ""
i__4[1] = 5, a__2[1] = "loff{";
-#line 18007 ""
+#line 17994 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
-#line 18007 ""
+#line 17994 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)
6, (ftnlen)80);
-#line 18008 ""
+#line 17995 ""
} else if (bit_test(all_1.ipl[commvl_1.ivx + ip *
24 - 25],9)) {
/* Writing concatenation */
-#line 18009 ""
+#line 17996 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18009 ""
+#line 17996 ""
i__4[1] = 5, a__2[1] = "roff{";
-#line 18009 ""
+#line 17996 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
-#line 18009 ""
+#line 17996 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)
6, (ftnlen)80);
-#line 18010 ""
+#line 17997 ""
}
-#line 18011 ""
+#line 17998 ""
if (lnote > 0) {
-#line 18011 ""
+#line 17998 ""
addstr_(notexq, &lnote, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
-#line 18011 ""
+#line 17998 ""
}
-#line 18012 ""
+#line 17999 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],8) || bit_test(all_1.ipl[commvl_1.ivx
+ ip * 24 - 25],9)) {
-#line 18012 ""
+#line 17999 ""
addstr_("}", &c__1, soutq, &lsout, (ftnlen)1,
(ftnlen)80);
-#line 18012 ""
+#line 17999 ""
}
-#line 18014 ""
+#line 18001 ""
} else {
/* Jump start. Set marker for second part of a jump beam. Note ivbj2 was set */
/* to 0 at end of first part of jump beam */
-#line 18019 ""
+#line 18006 ""
combjmp_1.ivbj2 = commvl_1.ivx;
/* Check for xtup since we bypassed beamstrt wherein vxtup is normally set */
-#line 18023 ""
+#line 18010 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],28) && strtmid_1.ixrest[commvl_1.ivx
- 1] != 2) {
-#line 18023 ""
+#line 18010 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = TRUE_;
-#line 18023 ""
+#line 18010 ""
}
/* Since beamstrt is not called, and drawbm is normally set there, need to set */
/* it here. This could cause problems if someone tries a staff-jumping, */
/* unbarred beam, which I'll deal with when it comes up. */
-#line 18030 ""
+#line 18017 ""
comdraw_1.drawbm[commvl_1.ivx - 1] = TRUE_;
-#line 18031 ""
+#line 18018 ""
}
-#line 18032 ""
+#line 18019 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
-#line 18033 ""
+#line 18020 ""
all_1.beamon[commvl_1.ivx - 1] = TRUE_;
-#line 18034 ""
+#line 18021 ""
bspend = TRUE_;
-#line 18035 ""
+#line 18022 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
- 25],24)) {
-#line 18035 ""
+#line 18022 ""
bspend = TRUE_;
-#line 18035 ""
+#line 18022 ""
}
-#line 18036 ""
+#line 18023 ""
}
-#line 18037 ""
+#line 18024 ""
}
/* Setup for chords and possible slurs in chords */
-#line 18041 ""
+#line 18028 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* There is a chord on this note. Just rerun precrd. Klunky, but saves */
/* me from tracking down errors instroduced when I moved 1st call */
/* forward for accidental spacing analysis. */
-#line 18047 ""
+#line 18034 ""
if (all_1.beamon[commvl_1.ivx - 1]) {
-#line 18048 ""
+#line 18035 ""
precrd_(&commvl_1.ivx, &ip, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &all_1.nacc[
commvl_1.ivx + ip * 24 - 25], &all_1.ipl[
@@ -42835,57 +43095,57 @@ L125:
all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25), &c_true, &
icashft, (ftnlen)1);
-#line 18051 ""
+#line 18038 ""
} else {
-#line 18052 ""
+#line 18039 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18052 ""
+#line 18039 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__12, &all_1.islur[
commvl_1.ivx + ip * 24 - 25], &
commvl_1.nvmx[all_1.iv - 1], &
commvl_1.ivx, &all_1.nv);
-#line 18052 ""
+#line 18039 ""
precrd_(&commvl_1.ivx, &ip, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &all_1.nacc[
commvl_1.ivx + ip * 24 - 25], &all_1.ipl[
commvl_1.ivx + ip * 24 - 25], &
all_1.irest[commvl_1.ivx + ip * 24 - 25],
ch__6, &c_true, &icashft, (ftnlen)1);
-#line 18056 ""
+#line 18043 ""
}
-#line 18057 ""
+#line 18044 ""
}
/* Is there slur or grace activity? */
-#line 18061 ""
+#line 18048 ""
isgrace = bit_test(all_1.islur[commvl_1.ivx + ip * 24 -
25],4);
-#line 18062 ""
+#line 18049 ""
if (ip > 1) {
-#line 18062 ""
+#line 18049 ""
isgrace = isgrace || bit_test(all_1.ipl[commvl_1.ivx
+ (ip - 1) * 24 - 25],31);
-#line 18062 ""
+#line 18049 ""
}
/* isgrace if not 1st note in bar and previous note has Way-after grace. */
-#line 18066 ""
+#line 18053 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],0)
|| isgrace) {
-#line 18067 ""
+#line 18054 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
0)) {
-#line 18068 ""
+#line 18055 ""
if (comslur_1.fontslur) {
/* Call routine for non-postscript slurs */
-#line 18072 ""
+#line 18059 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18072 ""
+#line 18059 ""
doslur_(&all_1.nolev[commvl_1.ivx + ip * 24 -
25], all_1.isdat1, all_1.isdat2,
all_1.isdat3, &all_1.nsdat, &ip, &
@@ -42902,14 +43162,14 @@ L125:
- 25] - 1], &all_1.nacc[commvl_1.ivx
+ ip * 24 - 25], (ftnlen)80, (ftnlen)
1);
-#line 18077 ""
+#line 18064 ""
} else {
/* Postscript slurs */
-#line 18081 ""
+#line 18068 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18081 ""
+#line 18068 ""
dopsslur_(&all_1.nolev[commvl_1.ivx + ip * 24
- 25], all_1.isdat1, all_1.isdat2,
all_1.isdat3, all_1.isdat4, &
@@ -42926,33 +43186,33 @@ L125:
commvl_1.ivx + ip * 24 - 25] - 1], &
all_1.nacc[commvl_1.ivx + ip * 24 -
25], (ftnlen)80, (ftnlen)1);
-#line 18087 ""
+#line 18074 ""
}
-#line 18088 ""
+#line 18075 ""
}
-#line 18089 ""
+#line 18076 ""
if (isgrace) {
/* Grace note. */
-#line 18093 ""
+#line 18080 ""
iphold = ip;
-#line 18094 ""
+#line 18081 ""
isgrace = FALSE_;
-#line 18095 ""
+#line 18082 ""
if (ip > 1) {
-#line 18095 ""
+#line 18082 ""
isgrace = bit_test(all_1.ipl[commvl_1.ivx + (
ip - 1) * 24 - 25],31);
-#line 18095 ""
+#line 18082 ""
}
-#line 18096 ""
+#line 18083 ""
if (isgrace) {
-#line 18096 ""
+#line 18083 ""
--iphold;
-#line 18096 ""
+#line 18083 ""
}
-#line 18097 ""
+#line 18084 ""
isgrace = isgrace || ! bit_test(all_1.ipl[
commvl_1.ivx + ip * 24 - 25],31) && !
bit_test(all_1.ipl[commvl_1.ivx + ip * 24
@@ -42961,13 +43221,13 @@ L125:
/* Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace */
/* on current note. Do A-grace on current note, and W-grace at barend, later. */
-#line 18103 ""
+#line 18090 ""
if (isgrace) {
-#line 18104 ""
+#line 18091 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18104 ""
+#line 18091 ""
i__13 = ncmid_(&all_1.iv, &ip);
-#line 18104 ""
+#line 18091 ""
dograce_(&commvl_1.ivx, &iphold, ptgr, soutq,
&lsout, &i__12, &all_1.nacc[
commvl_1.ivx + ip * 24 - 25], &ig, &
@@ -42984,233 +43244,233 @@ L125:
all_1.iv - 1], (ftnlen)80, (ftnlen)1);
/* 130324 */
/* * tnote(ipl2(ivx,ip)),ulq) */
-#line 18111 ""
+#line 18098 ""
if (comgrace_1.slurg[ig - 1]) {
/* Terminate slur started in dograce. Get direction of main note stem */
-#line 18115 ""
+#line 18102 ""
if (! all_1.beamon[commvl_1.ivx - 1]) {
/* Separate note. Get stem direction. */
-#line 18119 ""
+#line 18106 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18119 ""
+#line 18106 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25],
&i__12, &all_1.islur[
commvl_1.ivx + ip * 24 - 25],
&commvl_1.nvmx[all_1.iv - 1],
&commvl_1.ivx, &all_1.nv);
-#line 18119 ""
+#line 18106 ""
stemup = *(unsigned char *)&ch__6[0]
== 'u';
-#line 18121 ""
+#line 18108 ""
} else {
/* In a beam */
-#line 18125 ""
+#line 18112 ""
stemup = *(unsigned char *)&all_1.ulq[
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25]
== 'u';
-#line 18126 ""
+#line 18113 ""
}
/* Stop the shift if whole note */
-#line 18130 ""
+#line 18117 ""
stemup = stemup || all_1.tnote[
comipl2_1.ipl2[commvl_1.ivx + ip *
24 - 25] - 1] > 63.f;
-#line 18132 ""
+#line 18119 ""
L__1 = ! comgrace_1.upg[ig - 1];
-#line 18132 ""
+#line 18119 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18132 ""
+#line 18119 ""
endslur_(&stemup, &L__1, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &
c__0, &comslur_1.ndxslur, &c__0, &
i__12, soutq, &lsout, &
comslur_1.fontslur, (ftnlen)80);
-#line 18134 ""
+#line 18121 ""
}
-#line 18135 ""
+#line 18122 ""
}
-#line 18136 ""
+#line 18123 ""
}
-#line 18137 ""
+#line 18124 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],
24)) {
/* Start slur on main note for After- or Way-after-grace. */
/* ???? ndxslur = log2(33554431-listslur) */
-#line 18142 ""
+#line 18129 ""
i__12 = 16777215 - comslur_1.listslur;
-#line 18142 ""
+#line 18129 ""
comslur_1.ndxslur = log2_(&i__12);
/* Get note name */
-#line 18146 ""
+#line 18133 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18146 ""
+#line 18133 ""
notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__12, (ftnlen)8);
/* Get slur direction */
-#line 18150 ""
+#line 18137 ""
*(unsigned char *)slurudq = 'u';
-#line 18151 ""
+#line 18138 ""
if (! all_1.beamon[commvl_1.ivx - 1]) {
-#line 18152 ""
+#line 18139 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18152 ""
+#line 18139 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &i__12,
&all_1.islur[commvl_1.ivx + ip * 24 -
25], &commvl_1.nvmx[all_1.iv - 1], &
commvl_1.ivx, &all_1.nv);
-#line 18152 ""
+#line 18139 ""
if (*(unsigned char *)&ch__6[0] == 'u') {
-#line 18152 ""
+#line 18139 ""
*(unsigned char *)slurudq = 'd';
-#line 18152 ""
+#line 18139 ""
}
-#line 18154 ""
+#line 18141 ""
} else {
-#line 18155 ""
+#line 18142 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx
+ all_1.ibmcnt[commvl_1.ivx - 1] * 24
- 25] == 'u') {
-#line 18155 ""
+#line 18142 ""
*(unsigned char *)slurudq = 'd';
-#line 18155 ""
+#line 18142 ""
}
-#line 18156 ""
+#line 18143 ""
}
/* c Replace ndxslur by 11-ndxslur when printing only. */
/* Replace ndxslur by 23-ndxslur when printing only. */
/* if (11-ndxslur .lt. 10) then */
-#line 18162 ""
+#line 18149 ""
if (23 - comslur_1.ndxslur < 10) {
/* notexq = sq//'islur'//slurudq//chax(59-ndxslur) */
/* Writing concatenation */
-#line 18164 ""
+#line 18151 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 18164 ""
+#line 18151 ""
i__5[1] = 5, a__3[1] = "islur";
-#line 18164 ""
+#line 18151 ""
i__5[2] = 1, a__3[2] = slurudq;
-#line 18164 ""
+#line 18151 ""
i__12 = 71 - comslur_1.ndxslur;
-#line 18164 ""
+#line 18151 ""
chax_(ch__6, (ftnlen)1, &i__12);
-#line 18164 ""
+#line 18151 ""
i__5[3] = 1, a__3[3] = ch__6;
-#line 18164 ""
+#line 18151 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 18164 ""
+#line 18151 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 18166 ""
+#line 18153 ""
i__12 = lnoten + 8;
-#line 18166 ""
+#line 18153 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
-#line 18167 ""
+#line 18154 ""
} else if (23 - comslur_1.ndxslur < 20) {
/* Writing concatenation */
-#line 18168 ""
+#line 18155 ""
i__14[0] = 1, a__8[0] = all_1.sq;
-#line 18168 ""
+#line 18155 ""
i__14[1] = 5, a__8[1] = "islur";
-#line 18168 ""
+#line 18155 ""
i__14[2] = 1, a__8[2] = slurudq;
-#line 18168 ""
+#line 18155 ""
i__14[3] = 2, a__8[3] = "{1";
-#line 18168 ""
+#line 18155 ""
i__12 = 61 - comslur_1.ndxslur;
-#line 18168 ""
+#line 18155 ""
chax_(ch__6, (ftnlen)1, &i__12);
-#line 18168 ""
+#line 18155 ""
i__14[4] = 1, a__8[4] = ch__6;
-#line 18168 ""
+#line 18155 ""
i__14[5] = 1, a__8[5] = "}";
-#line 18168 ""
+#line 18155 ""
i__14[6] = lnoten, a__8[6] = noteq;
-#line 18168 ""
+#line 18155 ""
s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79);
-#line 18170 ""
+#line 18157 ""
i__12 = lnoten + 11;
-#line 18170 ""
+#line 18157 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
-#line 18171 ""
+#line 18158 ""
} else {
/* Writing concatenation */
-#line 18172 ""
+#line 18159 ""
i__14[0] = 1, a__8[0] = all_1.sq;
-#line 18172 ""
+#line 18159 ""
i__14[1] = 5, a__8[1] = "islur";
-#line 18172 ""
+#line 18159 ""
i__14[2] = 1, a__8[2] = slurudq;
-#line 18172 ""
+#line 18159 ""
i__14[3] = 2, a__8[3] = "{2";
-#line 18172 ""
+#line 18159 ""
i__12 = 51 - comslur_1.ndxslur;
-#line 18172 ""
+#line 18159 ""
chax_(ch__6, (ftnlen)1, &i__12);
-#line 18172 ""
+#line 18159 ""
i__14[4] = 1, a__8[4] = ch__6;
-#line 18172 ""
+#line 18159 ""
i__14[5] = 1, a__8[5] = "}";
-#line 18172 ""
+#line 18159 ""
i__14[6] = lnoten, a__8[6] = noteq;
-#line 18172 ""
+#line 18159 ""
s_cat(notexq, a__8, i__14, &c__7, (ftnlen)79);
-#line 18174 ""
+#line 18161 ""
i__12 = lnoten + 11;
-#line 18174 ""
+#line 18161 ""
addstr_(notexq, &i__12, soutq, &lsout, (
ftnlen)79, (ftnlen)80);
-#line 18175 ""
+#line 18162 ""
}
/* call setbits(ipl(ivx,ip),4,23,ndxslur) */
-#line 18177 ""
+#line 18164 ""
setbits_(&all_1.ipl[commvl_1.ivx + ip * 24 - 25],
&c__5, &c__23, &comslur_1.ndxslur);
-#line 18178 ""
+#line 18165 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],31)) {
-#line 18178 ""
+#line 18165 ""
comslur_1.listslur = bit_set(
comslur_1.listslur,comslur_1.ndxslur);
-#line 18178 ""
+#line 18165 ""
}
/* Starting slur on W-grace on THIS note. Record ndxslur. */
-#line 18183 ""
+#line 18170 ""
}
-#line 18184 ""
+#line 18171 ""
}
/* Process dynamic marks */
-#line 18188 ""
+#line 18175 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],26))
{
-#line 18189 ""
+#line 18176 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18189 ""
+#line 18176 ""
L__1 = all_1.nodur[commvl_1.ivx + ip * 24 - 25] >= 64;
-#line 18189 ""
+#line 18176 ""
dodyn_(&commvl_1.ivx, &ip, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__12, &all_1.ipl[
commvl_1.ivx + ip * 24 - 25], &all_1.islur[
@@ -43220,64 +43480,64 @@ L125:
commvl_1.ivx - 1], ihornb, nornb, all_1.ulq, &
all_1.ibmcnt[commvl_1.ivx - 1], &L__1, soutq,
&lsout, (ftnlen)1, (ftnlen)80);
-#line 18193 ""
+#line 18180 ""
}
/* Check for chord notes. Moved up from below, 10/27/96 so chord orns done 1st. */
-#line 18197 ""
+#line 18184 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],10)) {
/* Need a duration to set type of note head */
/* Clumsy test, but vxtup is not set until main note is processed. */
-#line 18203 ""
+#line 18190 ""
if (! (comxtup_1.vxtup[commvl_1.ivx - 1] || bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],28)))
{
-#line 18204 ""
+#line 18191 ""
nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 18205 ""
+#line 18192 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + ip *
24 - 25],2) || ip > 1 && bit_test(all_1.irest[
commvl_1.ivx + (ip - 1) * 24 - 25],2)) {
/* In a 2-note tremolo */
-#line 18210 ""
+#line 18197 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],2)) {
/* First note of tremolo, duration is on next note */
-#line 18214 ""
+#line 18201 ""
nodu = all_1.nodur[commvl_1.ivx + (ip + 1) *
24 - 25];
-#line 18215 ""
+#line 18202 ""
} else {
-#line 18216 ""
+#line 18203 ""
nodu = all_1.nodur[commvl_1.ivx + ip * 24 -
25];
-#line 18217 ""
+#line 18204 ""
}
-#line 18218 ""
+#line 18205 ""
} else if ((all_1.mult[commvl_1.ivx + ip * 24 - 25] &
15) - 8 < 0) {
-#line 18219 ""
+#line 18206 ""
nodu = 32;
-#line 18220 ""
+#line 18207 ""
} else {
-#line 18221 ""
+#line 18208 ""
nodu = 16;
-#line 18222 ""
+#line 18209 ""
}
-#line 18223 ""
+#line 18210 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18223 ""
+#line 18210 ""
L__1 = bit_test(all_1.nacc[commvl_1.ivx + ip * 24 -
25],27);
-#line 18223 ""
+#line 18210 ""
docrd_(&commvl_1.ivx, &ip, &nodu, &i__12, &all_1.iv, &
tnow, soutq, &lsout, all_1.ulq, &all_1.ibmcnt[
commvl_1.ivx - 1], &all_1.islur[commvl_1.ivx
@@ -43287,42 +43547,42 @@ L125:
ihornb, nornb, &all_1.stemlen, &L__1, &
all_1.nacc[commvl_1.ivx + ip * 24 - 25],
all_1.irest, (ftnlen)80, (ftnlen)1);
-#line 18228 ""
+#line 18215 ""
}
/* Now that chords are done, add stuff to midi file */
-#line 18232 ""
+#line 18219 ""
if (commidi_1.ismidi) {
-#line 18232 ""
+#line 18219 ""
i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] +
commvel_1.miditran[cominsttrans_1.instno[
all_1.iv - 1] - 1];
-#line 18232 ""
+#line 18219 ""
i__13 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7;
-#line 18232 ""
+#line 18219 ""
L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],0);
-#line 18232 ""
+#line 18219 ""
addmidi_(&icm, &i__12, &i__13, &commidisig_1.midisig,
&all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip
* 24 - 25] - 1], &L__1, &c_false);
-#line 18232 ""
+#line 18219 ""
}
/* 130316 */
/* Check for breath or caesura */
-#line 18241 ""
+#line 18228 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],28))
{
-#line 18242 ""
+#line 18229 ""
putcb_(&commvl_1.ivx, &ip, notexq, &lnote, (ftnlen)79)
;
-#line 18243 ""
+#line 18230 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 18244 ""
+#line 18231 ""
}
/* Check for main-note ornaments. ')' on dotted notes go in with note, not here. */
@@ -43331,73 +43591,73 @@ L125:
/* isacc = iand(iornq(ivx,ip),4194287) .gt. 0 */
/* isacc = iand(iornq(ivx,ip),541065199) .gt. 0 */
-#line 18252 ""
+#line 18239 ""
isacc = (all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
1614807023) > 0;
/* isacc=.true. if any ornament except segno */
-#line 18256 ""
+#line 18243 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)
&& all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0) {
/* If ). is only ornament, bypass. If with others, temporarirly zero the bit. */
-#line 18260 ""
+#line 18247 ""
i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
25]);
-#line 18260 ""
+#line 18247 ""
if (pow_ii(&c__2, &i__12) != all_1.nodur[commvl_1.ivx
+ ip * 24 - 25]) {
-#line 18261 ""
+#line 18248 ""
if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] &
516079) == 0) {
/* ). is the only non-segno ornament */
-#line 18265 ""
+#line 18252 ""
isacc = FALSE_;
-#line 18266 ""
+#line 18253 ""
} else {
/* There are other ornaments in addition */
-#line 18270 ""
+#line 18257 ""
rpndot = TRUE_;
-#line 18271 ""
+#line 18258 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] =
bit_clear(all_1.iornq[commvl_1.ivx +
ip * 24 - 1],13);
-#line 18272 ""
+#line 18259 ""
}
-#line 18273 ""
+#line 18260 ""
}
-#line 18274 ""
+#line 18261 ""
}
-#line 18275 ""
+#line 18262 ""
if (isacc && ! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
/* Check for centered whole-bar rest with fermata (bits 10 or 14). */
-#line 18279 ""
+#line 18266 ""
if ((all_1.iornq[commvl_1.ivx + ip * 24 - 1] & 17408)
> 0 && bit_test(all_1.irest[commvl_1.ivx + ip
* 24 - 25],0) && all_1.nodur[commvl_1.ivx +
ip * 24 - 25] == all_1.lenbar && ! (
all_1.firstgulp && all_1.ibar == 1 &&
all_1.lenb0 > 0)) {
-#line 18283 ""
+#line 18270 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = TRUE_;
-#line 18284 ""
+#line 18271 ""
goto L30;
-#line 18285 ""
+#line 18272 ""
}
-#line 18286 ""
+#line 18273 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18286 ""
+#line 18273 ""
L__1 = bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
,10);
-#line 18286 ""
+#line 18273 ""
putorn_(&all_1.iornq[commvl_1.ivx + ip * 24 - 1], &
all_1.nolev[commvl_1.ivx + ip * 24 - 25], &
all_1.nolev[commvl_1.ivx + ip * 24 - 25], &
@@ -43409,66 +43669,66 @@ L125:
all_1.stemlen, notexq, &lnote, &ip, &islhgt, &
all_1.beamon[commvl_1.ivx - 1], &L__1, (
ftnlen)1, (ftnlen)79);
-#line 18291 ""
+#line 18278 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 18292 ""
+#line 18279 ""
}
-#line 18293 ""
+#line 18280 ""
if (rpndot) {
-#line 18294 ""
+#line 18281 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = bit_set(
all_1.iornq[commvl_1.ivx + ip * 24 - 1],13);
-#line 18295 ""
+#line 18282 ""
rpndot = FALSE_;
-#line 18296 ""
+#line 18283 ""
}
-#line 18297 ""
+#line 18284 ""
L30:
/* Check for main note accidental */
-#line 18301 ""
+#line 18288 ""
if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 3) > 0 && !
bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],
17)) {
-#line 18303 ""
+#line 18290 ""
ihshft = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
- 25], &c__7, &c__10);
-#line 18304 ""
+#line 18291 ""
if (ihshft != 0) {
-#line 18304 ""
+#line 18291 ""
ihshft += -107;
-#line 18304 ""
+#line 18291 ""
}
-#line 18305 ""
+#line 18292 ""
if (! bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
10) && bit_test(all_1.ipl[commvl_1.ivx + ip *
24 - 25],8)) {
-#line 18305 ""
+#line 18292 ""
ihshft += -20;
-#line 18305 ""
+#line 18292 ""
}
/* Not a chord, and left-shifted main note, so left-shift accid */
-#line 18310 ""
+#line 18297 ""
i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24
- 25], &c__6, &c__4);
-#line 18310 ""
+#line 18297 ""
i__13 = ncmid_(&all_1.iv, &ip);
-#line 18310 ""
+#line 18297 ""
L__1 = bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],31);
-#line 18310 ""
+#line 18297 ""
doacc_(&ihshft, &i__12, notexq, &lnote, &all_1.nacc[
commvl_1.ivx + ip * 24 - 25], &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &i__13, &L__1, (
ftnlen)79);
-#line 18313 ""
+#line 18300 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 18314 ""
+#line 18301 ""
}
/* Lower dot for lower-voice notes. Conditions are: */
@@ -43479,168 +43739,168 @@ L30:
/* . 5. Flag (lowdot) is set to true */
/* 6. Not in an xtuplet */
-#line 18324 ""
+#line 18311 ""
if (comarp_1.lowdot && commvl_1.nvmx[all_1.iv - 1] == 2 &&
commvl_1.ivx <= all_1.nv && all_1.nodur[
commvl_1.ivx + ip * 24 - 25] != 0) {
-#line 18326 ""
+#line 18313 ""
i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 -
25]);
-#line 18326 ""
+#line 18313 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],0) && pow_ii(&c__2, &i__12) !=
all_1.nodur[commvl_1.ivx + ip * 24 - 25] && (
all_1.nolev[commvl_1.ivx + ip * 24 - 25] -
ncmid_(&commvl_1.ivx, &ip)) % 2 == 0) {
-#line 18329 ""
+#line 18316 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],19)) {
/* Note already in movdot list. Drop by 2. */
-#line 18333 ""
+#line 18320 ""
comcc_1.updot[commvl_1.ivx + (comcc_1.ndotmv[
commvl_1.ivx - 1] + 1) * 24 - 25] +=
-2.f;
-#line 18335 ""
+#line 18322 ""
} else {
/* Not in list so just move it right now */
-#line 18339 ""
+#line 18326 ""
i__12 = igetbits_(&all_1.islur[commvl_1.ivx +
ip * 24 - 25], &c__1, &c__3);
-#line 18339 ""
+#line 18326 ""
dotmov_(&c_b1007, &c_b1008, soutq, &lsout, &
i__12, (ftnlen)80);
-#line 18341 ""
+#line 18328 ""
}
-#line 18342 ""
+#line 18329 ""
}
-#line 18343 ""
+#line 18330 ""
}
/* Check for dotted main notes with moved dots. Chord notes done elsewhere. */
/* Added check rules out special chordal 2nds, but later must check */
/* substituted chord note for dot shift that now applies to main note. */
-#line 18349 ""
+#line 18336 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],19))
{
-#line 18350 ""
+#line 18337 ""
++comcc_1.ndotmv[commvl_1.ivx - 1];
-#line 18351 ""
+#line 18338 ""
i__12 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24
- 25], &c__1, &c__3);
-#line 18351 ""
+#line 18338 ""
dotmov_(&comcc_1.updot[commvl_1.ivx + comcc_1.ndotmv[
commvl_1.ivx - 1] * 24 - 25], &comcc_1.rtdot[
commvl_1.ivx + comcc_1.ndotmv[commvl_1.ivx -
1] * 24 - 25], soutq, &lsout, &i__12, (ftnlen)
80);
-#line 18353 ""
+#line 18340 ""
}
/* Stemlength changes */
-#line 18357 ""
+#line 18344 ""
if (bit_test(all_1.mult[commvl_1.ivx + ip * 24 - 25],27))
{
-#line 18358 ""
+#line 18345 ""
dstemlen = igetbits_(&all_1.mult[commvl_1.ivx + ip *
24 - 25], &c__6, &c__10) * .5f - 4.f;
/* Writing concatenation */
-#line 18359 ""
+#line 18346 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18359 ""
+#line 18346 ""
i__4[1] = 12, a__2[1] = "stdstemfalse";
-#line 18359 ""
+#line 18346 ""
s_cat(ch__18, a__2, i__4, &c__2, (ftnlen)13);
-#line 18359 ""
+#line 18346 ""
addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, (
ftnlen)80);
-#line 18360 ""
+#line 18347 ""
stemshort = dstemlen * .667f + 4.66f;
/* Writing concatenation */
-#line 18361 ""
+#line 18348 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18361 ""
+#line 18348 ""
i__4[1] = 11, a__2[1] = "stemlength{";
-#line 18361 ""
+#line 18348 ""
s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)12);
-#line 18361 ""
+#line 18348 ""
addstr_(ch__5, &c__12, soutq, &lsout, (ftnlen)12, (
ftnlen)80);
-#line 18362 ""
+#line 18349 ""
s_wsfi(&io___1119);
-#line 18362 ""
+#line 18349 ""
do_fio(&c__1, (char *)&stemshort, (ftnlen)sizeof(real)
);
-#line 18362 ""
+#line 18349 ""
e_wsfi();
/* Writing concatenation */
-#line 18363 ""
+#line 18350 ""
i__4[0] = 4, a__2[0] = notexq;
-#line 18363 ""
+#line 18350 ""
i__4[1] = 1, a__2[1] = "}";
-#line 18363 ""
+#line 18350 ""
s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5);
-#line 18363 ""
+#line 18350 ""
addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, (
ftnlen)80);
-#line 18364 ""
+#line 18351 ""
} else if (ip > 1) {
-#line 18365 ""
+#line 18352 ""
if (bit_test(all_1.mult[commvl_1.ivx + (ip - 1) * 24
- 25],27)) {
/* Writing concatenation */
-#line 18365 ""
+#line 18352 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18365 ""
+#line 18352 ""
i__4[1] = 16, a__2[1] = "stemlength{4.66}";
-#line 18365 ""
+#line 18352 ""
s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)17);
-#line 18365 ""
+#line 18352 ""
addstr_(ch__7, &c__17, soutq, &lsout, (ftnlen)17,
(ftnlen)80);
-#line 18365 ""
+#line 18352 ""
}
/* Cancel shortening. Looks like it gets automatically restored if new inst. or */
/* new line, so no need to worry about affecting other lines */
-#line 18371 ""
+#line 18358 ""
}
/* Zero out slur-height marker for raising ornaments */
-#line 18375 ""
+#line 18362 ""
islhgt = 0;
/* Now start with spacing notes. Is a beam start pending? */
-#line 18379 ""
+#line 18366 ""
if (bspend && all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] > all_1.ibm1[
commvl_1.ivx + all_1.ibmcnt[commvl_1.ivx - 1] *
24 - 25]) {
-#line 18381 ""
+#line 18368 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 4) {
/* Special path for single note at end of otherwise beamed xtup */
-#line 18385 ""
+#line 18372 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
-#line 18386 ""
+#line 18373 ""
} else {
-#line 18387 ""
+#line 18374 ""
if (comkbdrests_1.kbdrests && bit_test(
all_1.irest[commvl_1.ivx + ip * 24 - 25],
0) && ! bit_test(all_1.islur[commvl_1.ivx
+ ip * 24 - 25],29) && commvl_1.nvmx[
all_1.iv - 1] == 2 && all_1.nolev[
commvl_1.ivx + ip * 24 - 25] <= 50) {
-#line 18387 ""
+#line 18374 ""
chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
all_1.nn, all_1.islur, all_1.irest,
all_1.nolev, commvl_1.ivmx, all_1.nib,
@@ -43649,29 +43909,29 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
-#line 18387 ""
+#line 18374 ""
}
-#line 18393 ""
+#line 18380 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 -
25],29) && bit_test(all_1.irest[
commvl_1.ivx + ip * 24 - 25],24)) {
/* Writing concatenation */
-#line 18395 ""
+#line 18382 ""
chax_(ch__6, (ftnlen)1, &c__92);
-#line 18395 ""
+#line 18382 ""
i__4[0] = 1, a__2[0] = ch__6;
-#line 18395 ""
+#line 18382 ""
i__4[1] = 2, a__2[1] = "sk";
-#line 18395 ""
+#line 18382 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18396 ""
+#line 18383 ""
lnote = 3;
-#line 18397 ""
+#line 18384 ""
} else {
-#line 18398 ""
+#line 18385 ""
beamn1_(notexq, &lnote, (ftnlen)79);
/* if (isbjmp .and. */
-#line 18400 ""
+#line 18387 ""
if (combjmp_1.isbjmp && combjmp_1.ivbj2 != 0
&& (all_1.mult[commvl_1.ivx + ip * 24
- 25] & 15) - 8 > combjmp_1.multbj1) {
@@ -43682,263 +43942,263 @@ L30:
/* Try adding e.g. \nbbu1 if needed to increase multiplicity. Add */
/* character in reverse order to start of notexq. */
-#line 18409 ""
+#line 18396 ""
if (combjmp_1.ivbj1 < 9) {
/* Writing concatenation */
-#line 18410 ""
+#line 18397 ""
*(unsigned char *)&ch__6[0] =
combjmp_1.ivbj1 + 48;
-#line 18410 ""
+#line 18397 ""
i__4[0] = 1, a__2[0] = ch__6;
-#line 18410 ""
+#line 18397 ""
i__4[1] = lnote, a__2[1] = notexq;
-#line 18410 ""
+#line 18397 ""
s_cat(notexq, a__2, i__4, &c__2, (
ftnlen)79);
-#line 18411 ""
+#line 18398 ""
++lnote;
-#line 18412 ""
+#line 18399 ""
} else {
/* Writing concatenation */
-#line 18413 ""
+#line 18400 ""
i__9[0] = 2, a__6[0] = "{1";
-#line 18413 ""
+#line 18400 ""
*(unsigned char *)&ch__6[0] =
combjmp_1.ivbj1 + 38;
-#line 18413 ""
+#line 18400 ""
i__9[1] = 1, a__6[1] = ch__6;
-#line 18413 ""
+#line 18400 ""
i__9[2] = 1, a__6[2] = "}";
-#line 18413 ""
+#line 18400 ""
i__9[3] = lnote, a__6[3] = notexq;
-#line 18413 ""
+#line 18400 ""
s_cat(notexq, a__6, i__9, &c__4, (
ftnlen)79);
-#line 18415 ""
+#line 18402 ""
lnote += 4;
-#line 18416 ""
+#line 18403 ""
}
/* Writing concatenation */
-#line 18417 ""
+#line 18404 ""
i__6[0] = 2, a__4[0] = "bb";
-#line 18417 ""
+#line 18404 ""
i__6[1] = 1, a__4[1] = all_1.ulq + (
combjmp_1.ivbj1 + (all_1.ibmcnt[
combjmp_1.ivbj1 - 1] - 1) * 24 -
25);
-#line 18417 ""
+#line 18404 ""
i__6[2] = lnote, a__4[2] = notexq;
-#line 18417 ""
+#line 18404 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)
79);
-#line 18419 ""
+#line 18406 ""
lnote += 3;
-#line 18420 ""
+#line 18407 ""
if ((15 & all_1.mult[commvl_1.ivx + ip *
24 - 25]) - 8 == 3) {
/* Writing concatenation */
-#line 18421 ""
+#line 18408 ""
i__4[0] = 1, a__2[0] = "b";
-#line 18421 ""
+#line 18408 ""
i__4[1] = lnote, a__2[1] = notexq;
-#line 18421 ""
+#line 18408 ""
s_cat(notexq, a__2, i__4, &c__2, (
ftnlen)79);
-#line 18422 ""
+#line 18409 ""
++lnote;
-#line 18423 ""
+#line 18410 ""
}
/* Writing concatenation */
-#line 18424 ""
+#line 18411 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 18424 ""
+#line 18411 ""
i__6[1] = 1, a__4[1] = "n";
-#line 18424 ""
+#line 18411 ""
i__6[2] = lnote, a__4[2] = notexq;
-#line 18424 ""
+#line 18411 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)
79);
-#line 18425 ""
+#line 18412 ""
lnote += 2;
-#line 18426 ""
+#line 18413 ""
}
-#line 18427 ""
+#line 18414 ""
}
-#line 18428 ""
+#line 18415 ""
}
-#line 18429 ""
+#line 18416 ""
bspend = FALSE_;
/* Is a beam ending? */
-#line 18433 ""
+#line 18420 ""
} else if (numbms[commvl_1.ivx] > 0 && all_1.ibmcnt[
commvl_1.ivx - 1] <= numbms[commvl_1.ivx] && (
all_1.ibm2[commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25] == ip || bit_test(
all_1.nacc[commvl_1.ivx + ip * 24 - 25],20))) {
-#line 18436 ""
+#line 18423 ""
if (bspend) {
/* Must be a single-note ending of a jump-beam */
-#line 18440 ""
+#line 18427 ""
bspend = FALSE_;
-#line 18441 ""
+#line 18428 ""
}
-#line 18442 ""
+#line 18429 ""
beamend_(notexq, &lnote, (ftnlen)79);
-#line 18443 ""
+#line 18430 ""
if (combjmp_1.isbjmp && commvl_1.ivx ==
combjmp_1.ivbj1) {
/* Jump beam segment is ending, check if multiplicity DECREASES */
-#line 18447 ""
+#line 18434 ""
if (comnsp_2.space[ib] > comnsp_2.space[ib - 1]) {
/* Decrease multiplicity 3-1, 3-2, or 2-1. Spaces are 2,4, or 8. */
-#line 18451 ""
+#line 18438 ""
if (commvl_1.ivx < 10) {
-#line 18452 ""
+#line 18439 ""
*(unsigned char *)&ch__6[0] =
commvl_1.ivx + 48;
-#line 18452 ""
+#line 18439 ""
s_copy(ivxq, ch__6, (ftnlen)4, (ftnlen)1);
-#line 18453 ""
+#line 18440 ""
livx = 1;
-#line 18454 ""
+#line 18441 ""
} else {
/* Writing concatenation */
-#line 18455 ""
+#line 18442 ""
i__6[0] = 2, a__4[0] = "{1";
-#line 18455 ""
+#line 18442 ""
*(unsigned char *)&ch__6[0] =
commvl_1.ivx - 10;
-#line 18455 ""
+#line 18442 ""
i__6[1] = 1, a__4[1] = ch__6;
-#line 18455 ""
+#line 18442 ""
i__6[2] = 1, a__4[2] = "}";
-#line 18455 ""
+#line 18442 ""
s_cat(ivxq, a__4, i__6, &c__3, (ftnlen)4);
-#line 18456 ""
+#line 18443 ""
livx = 4;
-#line 18457 ""
+#line 18444 ""
}
/* Changes to get staffcrossall.pmx to work. Not clear how. */
/* if (nint(space(ib+1)-space(ib)) .eq. 6) then */
-#line 18460 ""
+#line 18447 ""
if (comnsp_2.space[ib] == 8.f &&
comnsp_2.space[ib - 1] == 2.f) {
/* Writing concatenation */
-#line 18461 ""
+#line 18448 ""
i__15[0] = 1, a__9[0] = all_1.sq;
-#line 18461 ""
+#line 18448 ""
i__15[1] = 4, a__9[1] = "tbbb";
-#line 18461 ""
+#line 18448 ""
i__15[2] = 1, a__9[2] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 18461 ""
+#line 18448 ""
i__15[3] = livx, a__9[3] = ivxq;
-#line 18461 ""
+#line 18448 ""
i__15[4] = 1, a__9[4] = all_1.sq;
-#line 18461 ""
+#line 18448 ""
i__15[5] = 3, a__9[5] = "tbb";
-#line 18461 ""
+#line 18448 ""
i__15[6] = 1, a__9[6] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 18461 ""
+#line 18448 ""
i__15[7] = livx, a__9[7] = ivxq;
-#line 18461 ""
+#line 18448 ""
i__15[8] = lnote, a__9[8] = notexq;
-#line 18461 ""
+#line 18448 ""
s_cat(notexq, a__9, i__15, &c__9, (ftnlen)
79);
-#line 18464 ""
+#line 18451 ""
lnote = lnote + 11 + (livx << 1);
/* else if (nint(space(ib+1)-space(ib)) .eq. 4) then */
-#line 18466 ""
+#line 18453 ""
} else if (comnsp_2.space[ib] == 8.f &&
comnsp_2.space[ib - 1] == 4.f) {
/* Writing concatenation */
-#line 18467 ""
+#line 18454 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 18467 ""
+#line 18454 ""
i__5[1] = 3, a__3[1] = "tbb";
-#line 18467 ""
+#line 18454 ""
i__5[2] = 1, a__3[2] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 18467 ""
+#line 18454 ""
i__5[3] = livx, a__3[3] = ivxq;
-#line 18467 ""
+#line 18454 ""
i__5[4] = lnote, a__3[4] = notexq;
-#line 18467 ""
+#line 18454 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)
79);
-#line 18469 ""
+#line 18456 ""
lnote = lnote + 5 + livx;
/* else */
-#line 18471 ""
+#line 18458 ""
} else if (comnsp_2.space[ib] == 4.f &&
comnsp_2.space[ib - 1] == 2.f) {
/* Writing concatenation */
-#line 18472 ""
+#line 18459 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 18472 ""
+#line 18459 ""
i__5[1] = 4, a__3[1] = "tbbb";
-#line 18472 ""
+#line 18459 ""
i__5[2] = 1, a__3[2] = all_1.ulq + (
commvl_1.ivx + all_1.ibmcnt[
commvl_1.ivx - 1] * 24 - 25);
-#line 18472 ""
+#line 18459 ""
i__5[3] = livx, a__3[3] = ivxq;
-#line 18472 ""
+#line 18459 ""
i__5[4] = lnote, a__3[4] = notexq;
-#line 18472 ""
+#line 18459 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)
79);
-#line 18474 ""
+#line 18461 ""
lnote = lnote + 6 + livx;
-#line 18475 ""
+#line 18462 ""
}
-#line 18476 ""
+#line 18463 ""
}
-#line 18477 ""
+#line 18464 ""
}
-#line 18478 ""
+#line 18465 ""
if (! bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25]
,20)) {
-#line 18479 ""
+#line 18466 ""
comxtup_1.vxtup[commvl_1.ivx - 1] = FALSE_;
-#line 18480 ""
+#line 18467 ""
nornb[commvl_1.ivx - 1] = 0;
-#line 18481 ""
+#line 18468 ""
++all_1.ibmcnt[commvl_1.ivx - 1];
-#line 18482 ""
+#line 18469 ""
all_1.beamon[commvl_1.ivx - 1] = FALSE_;
-#line 18483 ""
+#line 18470 ""
}
/* Or if we're in the middle of a beam */
-#line 18487 ""
+#line 18474 ""
} else if (numbms[commvl_1.ivx] > 0 && all_1.beamon[
commvl_1.ivx - 1]) {
/* Added 130127 */
-#line 18491 ""
+#line 18478 ""
if (comkbdrests_1.kbdrests && bit_test(all_1.irest[
commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(
all_1.islur[commvl_1.ivx + ip * 24 - 25],29)
&& commvl_1.nvmx[all_1.iv - 1] == 2 &&
all_1.nolev[commvl_1.ivx + ip * 24 - 25] <=
50) {
-#line 18491 ""
+#line 18478 ""
chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
all_1.nn, all_1.islur, all_1.irest,
all_1.nolev, commvl_1.ivmx, all_1.nib, &
@@ -43947,14 +44207,14 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
-#line 18491 ""
+#line 18478 ""
}
-#line 18497 ""
+#line 18484 ""
beamid_(notexq, &lnote, (ftnlen)79);
/* Or whole-bar rest */
-#line 18501 ""
+#line 18488 ""
} else if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],0) && all_1.nodur[commvl_1.ivx + ip * 24 - 25]
== all_1.lenbar && ! (all_1.firstgulp &&
@@ -43965,18 +44225,18 @@ L30:
/* Rule out pickup bar, blank rests, non-centered. Remember islur b19=> rp */
-#line 18509 ""
+#line 18496 ""
cwrest[commvl_1.ivx] = TRUE_;
-#line 18510 ""
+#line 18497 ""
iscwr = TRUE_;
-#line 18511 ""
+#line 18498 ""
notex_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[
commvl_1.ivx - 1], (ftnlen)79);
-#line 18512 ""
+#line 18499 ""
tnow += all_1.lenbar;
-#line 18513 ""
+#line 18500 ""
goto L10;
-#line 18514 ""
+#line 18501 ""
} else if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0) {
/* Before writing note or rest, check for keyboard rest height adjustment. */
@@ -43985,14 +44245,14 @@ L30:
/* 2. There are two voices on the staff */
/* 3. No user-def height adjustments have been applied (nolev<50) */
-#line 18522 ""
+#line 18509 ""
if (comkbdrests_1.kbdrests && bit_test(all_1.irest[
commvl_1.ivx + ip * 24 - 25],0) && ! bit_test(
all_1.islur[commvl_1.ivx + ip * 24 - 25],29)
&& commvl_1.nvmx[all_1.iv - 1] == 2 &&
all_1.nolev[commvl_1.ivx + ip * 24 - 25] <=
50) {
-#line 18525 ""
+#line 18512 ""
chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx,
all_1.nn, all_1.islur, all_1.irest,
all_1.nolev, commvl_1.ivmx, all_1.nib, &
@@ -44001,199 +44261,199 @@ L30:
comkbdrests_1.levtopr,
comkbdrests_1.levbotr, all_1.mult,
all_1.ipl);
-#line 18528 ""
+#line 18515 ""
}
-#line 18529 ""
+#line 18516 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],4)
) {
/* Deal with single stem tremolo */
/* Get up-downness, borrowed from notex */
-#line 18534 ""
+#line 18521 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18534 ""
+#line 18521 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__12, &all_1.islur[
commvl_1.ivx + ip * 24 - 25], &
commvl_1.nvmx[all_1.iv - 1], &
commvl_1.ivx, &all_1.nv);
-#line 18534 ""
+#line 18521 ""
if (*(unsigned char *)&ch__6[0] == 'u') {
-#line 18536 ""
+#line 18523 ""
*(unsigned char *)udq = 'u';
-#line 18537 ""
+#line 18524 ""
} else {
-#line 18538 ""
+#line 18525 ""
*(unsigned char *)udq = 'l';
-#line 18539 ""
+#line 18526 ""
}
-#line 18540 ""
+#line 18527 ""
multtrem = igetbits_(&all_1.ipl[commvl_1.ivx + ip
* 24 - 25], &c__2, &c__5) + 1;
-#line 18541 ""
+#line 18528 ""
if (all_1.nodur[commvl_1.ivx + ip * 24 - 25] < 64)
{
/* Writing concatenation */
-#line 18542 ""
+#line 18529 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18542 ""
+#line 18529 ""
i__4[1] = 2, a__2[1] = "tr";
-#line 18542 ""
+#line 18529 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18543 ""
+#line 18530 ""
} else {
/* Writing concatenation */
-#line 18544 ""
+#line 18531 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18544 ""
+#line 18531 ""
i__4[1] = 2, a__2[1] = "Tr";
-#line 18544 ""
+#line 18531 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18545 ""
+#line 18532 ""
}
-#line 18546 ""
+#line 18533 ""
lnote = 3;
-#line 18547 ""
+#line 18534 ""
if (multtrem == 2) {
/* Writing concatenation */
-#line 18548 ""
+#line 18535 ""
i__4[0] = 3, a__2[0] = notexq;
-#line 18548 ""
+#line 18535 ""
i__4[1] = 1, a__2[1] = "r";
-#line 18548 ""
+#line 18535 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18549 ""
+#line 18536 ""
lnote = 4;
-#line 18550 ""
+#line 18537 ""
} else if (multtrem == 3) {
/* Writing concatenation */
-#line 18551 ""
+#line 18538 ""
i__4[0] = 3, a__2[0] = notexq;
-#line 18551 ""
+#line 18538 ""
i__4[1] = 2, a__2[1] = "rr";
-#line 18551 ""
+#line 18538 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18552 ""
+#line 18539 ""
lnote = 5;
-#line 18553 ""
+#line 18540 ""
}
/* Get a numerical pitch argument */
-#line 18557 ""
+#line 18544 ""
lineno = all_1.nolev[commvl_1.ivx + ip * 24 - 25]
- ncmid_(&all_1.iv, &ip) + 4;
-#line 18558 ""
+#line 18545 ""
if (lineno < 0 || lineno > 9) {
-#line 18559 ""
+#line 18546 ""
s_wsfi(&io___1127);
-#line 18559 ""
+#line 18546 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 18559 ""
+#line 18546 ""
do_fio(&c__1, (char *)&lineno, (ftnlen)sizeof(
integer));
-#line 18559 ""
+#line 18546 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 18559 ""
+#line 18546 ""
e_wsfi();
-#line 18560 ""
+#line 18547 ""
lnoten = 4;
-#line 18561 ""
+#line 18548 ""
} else {
-#line 18562 ""
+#line 18549 ""
*(unsigned char *)&ch__6[0] = lineno + 48;
-#line 18562 ""
+#line 18549 ""
s_copy(noteq, ch__6, (ftnlen)8, (ftnlen)1);
-#line 18563 ""
+#line 18550 ""
lnoten = 1;
-#line 18564 ""
+#line 18551 ""
}
/* Writing concatenation */
-#line 18565 ""
+#line 18552 ""
i__9[0] = lnote, a__6[0] = notexq;
-#line 18565 ""
+#line 18552 ""
i__9[1] = 1, a__6[1] = "m";
-#line 18565 ""
+#line 18552 ""
i__9[2] = 1, a__6[2] = udq;
-#line 18565 ""
+#line 18552 ""
i__9[3] = lnoten, a__6[3] = noteq;
-#line 18565 ""
+#line 18552 ""
s_cat(notexq, a__6, i__9, &c__4, (ftnlen)79);
-#line 18566 ""
+#line 18553 ""
lnote = lnote + 2 + lnoten;
-#line 18567 ""
+#line 18554 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79,
(ftnlen)80);
-#line 18568 ""
+#line 18555 ""
}
/* Get code for a separate note or rest */
/* If nacc(ivx,ip)(30-31)=1 (dotted chordal 2nd including main note), */
/* pitch will be shifted +/-1 inside notex. */
-#line 18574 ""
+#line 18561 ""
notex_(notexq, &lnote, (ftnlen)79);
-#line 18575 ""
+#line 18562 ""
}
/* Right offset? This may cause trouble */
-#line 18579 ""
+#line 18566 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8)) {
/* Writing concatenation */
-#line 18580 ""
+#line 18567 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18580 ""
+#line 18567 ""
i__4[1] = 5, a__2[1] = "loff{";
-#line 18580 ""
+#line 18567 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
-#line 18580 ""
+#line 18567 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, (
ftnlen)80);
-#line 18581 ""
+#line 18568 ""
} else if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25]
,9)) {
/* Writing concatenation */
-#line 18582 ""
+#line 18569 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18582 ""
+#line 18569 ""
i__4[1] = 5, a__2[1] = "roff{";
-#line 18582 ""
+#line 18569 ""
s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)6);
-#line 18582 ""
+#line 18569 ""
addstr_(ch__17, &c__6, soutq, &lsout, (ftnlen)6, (
ftnlen)80);
-#line 18583 ""
+#line 18570 ""
}
-#line 18584 ""
+#line 18571 ""
if (strtmid_1.ixrest[commvl_1.ivx - 1] == 0 && lnote > 0)
{
-#line 18585 ""
+#line 18572 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 18586 ""
+#line 18573 ""
}
-#line 18587 ""
+#line 18574 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],8) ||
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],9)
) {
-#line 18587 ""
+#line 18574 ""
addstr_("}", &c__1, soutq, &lsout, (ftnlen)1, (ftnlen)
80);
-#line 18587 ""
+#line 18574 ""
}
/* Terminate user-defined offsets. Fix format */
-#line 18592 ""
+#line 18579 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],15)
|| bit_test(all_1.irest[commvl_1.ivx + ip * 24 -
25],17)) {
-#line 18592 ""
+#line 18579 ""
putshft_(&commvl_1.ivx, &c_false, soutq, &lsout, (
ftnlen)80);
-#line 18592 ""
+#line 18579 ""
}
/* Deal with After- and Way-after-graces. First, if end of bar, compute space */
@@ -44201,137 +44461,137 @@ L30:
/* rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. */
/* But will still need to add extra space as hardspace. */
-#line 18600 ""
+#line 18587 ""
if (ip == all_1.nn[commvl_1.ivx - 1] && (bit_test(
all_1.ipl[commvl_1.ivx + ip * 24 - 25],31) ||
bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
29))) {
-#line 18602 ""
+#line 18589 ""
i__12 = comgrace_1.ngrace;
-#line 18602 ""
+#line 18589 ""
for (ig = 1; ig <= i__12; ++ig) {
-#line 18603 ""
+#line 18590 ""
if (comgrace_1.ipg[ig - 1] == ip &&
comgrace_1.ivg[ig - 1] == commvl_1.ivx) {
-#line 18603 ""
+#line 18590 ""
goto L78;
-#line 18603 ""
+#line 18590 ""
}
-#line 18604 ""
+#line 18591 ""
/* L77: */
-#line 18604 ""
+#line 18591 ""
}
-#line 18605 ""
+#line 18592 ""
s_wsle(&io___1128);
-#line 18605 ""
+#line 18592 ""
do_lio(&c__9, &c__1, "Problem finding grace index "\
"at \"do 77\"", (ftnlen)38);
-#line 18605 ""
+#line 18592 ""
e_wsle();
-#line 18606 ""
+#line 18593 ""
stop1_();
-#line 18607 ""
+#line 18594 ""
L78:
/* Get elemskip to end of bar. WON'T WORK IF XTUPS !! */
-#line 18611 ""
+#line 18598 ""
esk = 0.f;
-#line 18612 ""
+#line 18599 ""
i__12 = comnsp_2.nb;
-#line 18612 ""
+#line 18599 ""
for (iib = ib; iib <= i__12; ++iib) {
-#line 18613 ""
+#line 18600 ""
if (iib == ib) {
-#line 18614 ""
+#line 18601 ""
itleft = i_nint(&all_1.to[comipl2_1.ipl2[
commvl_1.ivx + ip * 24 - 25] - 1]);
-#line 18615 ""
+#line 18602 ""
} else {
-#line 18616 ""
+#line 18603 ""
itleft = i_nint(&tstart[ib]);
-#line 18617 ""
+#line 18604 ""
}
-#line 18618 ""
+#line 18605 ""
if (iib < comnsp_2.nb) {
-#line 18619 ""
+#line 18606 ""
itright = i_nint(&tstart[iib + 1]);
-#line 18620 ""
+#line 18607 ""
} else {
-#line 18621 ""
+#line 18608 ""
itright = all_1.lenbar;
-#line 18622 ""
+#line 18609 ""
}
-#line 18623 ""
+#line 18610 ""
esk += feon_(&comnsp_2.space[ib - 1]) * (itright
- itleft) / comnsp_2.space[ib - 1];
-#line 18625 ""
+#line 18612 ""
/* L40: */
-#line 18625 ""
+#line 18612 ""
}
-#line 18626 ""
+#line 18613 ""
ptsavail = comask_1.poenom * esk - comask_1.wheadpt;
-#line 18627 ""
+#line 18614 ""
if (comgrace_1.nng[ig - 1] == 1) {
-#line 18628 ""
+#line 18615 ""
wgr = spfacs_1.grafac;
-#line 18629 ""
+#line 18616 ""
} else {
-#line 18630 ""
+#line 18617 ""
wgr = comgrace_1.nng[ig - 1] * spfacs_1.emgfac;
-#line 18631 ""
+#line 18618 ""
i__12 = comgrace_1.nng[ig - 1];
-#line 18631 ""
+#line 18618 ""
for (ing = 1; ing <= i__12; ++ing) {
-#line 18632 ""
+#line 18619 ""
if (comgrace_1.naccg[comgrace_1.ngstrt[ig - 1]
- 1 + ing - 1] > 0) {
-#line 18632 ""
+#line 18619 ""
wgr += spfacs_1.acgfac;
-#line 18632 ""
+#line 18619 ""
}
-#line 18633 ""
+#line 18620 ""
/* L41: */
-#line 18633 ""
+#line 18620 ""
}
-#line 18634 ""
+#line 18621 ""
}
-#line 18635 ""
+#line 18622 ""
ptgr[ig - 1] = wgr * comask_1.wheadpt;
-#line 18636 ""
+#line 18623 ""
ptsneed = (wgr + .5f) * comask_1.wheadpt;
-#line 18637 ""
+#line 18624 ""
ptsndg[commvl_1.ivx - 1] = 0.f;
-#line 18638 ""
+#line 18625 ""
if (ptsavail < ptsneed) {
-#line 18639 ""
+#line 18626 ""
ptsndg[commvl_1.ivx - 1] = ptsneed;
-#line 18640 ""
+#line 18627 ""
eskndg[commvl_1.ivx - 1] = esk;
-#line 18641 ""
+#line 18628 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],31)) {
/* Convert GW to GA */
-#line 18645 ""
+#line 18632 ""
all_1.ipl[commvl_1.ivx + ip * 24 - 25] =
bit_set(bit_clear(all_1.ipl[
commvl_1.ivx + ip * 24 - 25],31),29);
-#line 18646 ""
+#line 18633 ""
}
-#line 18647 ""
+#line 18634 ""
}
-#line 18648 ""
+#line 18635 ""
}
/* Check for GA */
-#line 18652 ""
+#line 18639 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],29)) {
-#line 18652 ""
+#line 18639 ""
i__12 = ncmid_(&all_1.iv, &ip);
-#line 18652 ""
+#line 18639 ""
dograce_(&commvl_1.ivx, &ip, ptgr, soutq, &lsout, &
i__12, &all_1.nacc[commvl_1.ivx + ip * 24 -
25], &ig, &all_1.ipl[commvl_1.ivx + ip * 24 -
@@ -44339,87 +44599,87 @@ L78:
&c__0, &c__0, &c__0, &c_b1008, all_1.ulq, &
cominsttrans_1.instno[all_1.iv - 1], (ftnlen)
80, (ftnlen)1);
-#line 18652 ""
+#line 18639 ""
}
/* 130324 */
/* * .false.,0,0,0,0,0,0,0.,ulq) */
/* Update running time */
-#line 18661 ""
+#line 18648 ""
tnow += comnsp_2.space[ib - 1];
-#line 18662 ""
+#line 18649 ""
L10:
-#line 18662 ""
+#line 18649 ""
;
-#line 18662 ""
+#line 18649 ""
}
/* Have finished last note in this voice and block */
-#line 18666 ""
+#line 18653 ""
r__1 = all_1.to[istop[ib] - 1] + comnsp_2.space[ib - 1];
-#line 18666 ""
+#line 18653 ""
itendb = i_nint(&r__1);
-#line 18667 ""
+#line 18654 ""
if (all_1.figbass && commvl_1.ivx == 1 || commvl_1.ivx ==
comfig_1.ivxfig2) {
-#line 18668 ""
+#line 18655 ""
ivf = 1;
-#line 18669 ""
+#line 18656 ""
if (commvl_1.ivx > 1) {
-#line 18669 ""
+#line 18656 ""
ivf = 2;
-#line 18669 ""
+#line 18656 ""
}
-#line 18670 ""
+#line 18657 ""
L17:
-#line 18670 ""
+#line 18657 ""
if (all_1.figchk[ivf - 1] && comfig_1.itfig[ivf + (ifig[
ivf - 1] << 1) - 3] < itendb) {
/* There's at least one figure left. offnsk could be <0 */
-#line 18674 ""
+#line 18661 ""
offnsk = (tnow - comfig_1.itfig[ivf + (ifig[ivf - 1]
<< 1) - 3]) / comnsp_2.space[ib - 1];
-#line 18675 ""
+#line 18662 ""
putfig_(&ivf, &ifig[ivf - 1], &offnsk, &all_1.figchk[
ivf - 1], soutq, &lsout, (ftnlen)80);
-#line 18676 ""
+#line 18663 ""
goto L17;
-#line 18677 ""
+#line 18664 ""
}
-#line 18678 ""
+#line 18665 ""
}
/* Check for flag, dot, or upstem on last note of bar. */
-#line 18682 ""
+#line 18669 ""
if (ib == comnsp_2.nb) {
-#line 18683 ""
+#line 18670 ""
ip = all_1.ipo[comipl2_1.ipl2[commvl_1.ivx + all_1.nn[
commvl_1.ivx - 1] * 24 - 25] - 1];
-#line 18684 ""
+#line 18671 ""
comnsp_2.flgndv[commvl_1.ivx - 1] = 0.f;
-#line 18685 ""
+#line 18672 ""
if ((r__1 = all_1.tnote[comipl2_1.ipl2[commvl_1.ivx + ip *
24 - 25] - 1] - comnsp_2.space[ib - 1], dabs(
r__1)) < comtol_1.tol) {
-#line 18686 ""
+#line 18673 ""
if (comnsp_2.space[ib - 1] < 16.f - comtol_1.tol) {
/* Note in last space, smaller than a quarter note. */
-#line 18690 ""
+#line 18677 ""
i__10 = ncmid_(&all_1.iv, &ip);
-#line 18690 ""
+#line 18677 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[commvl_1.ivx
+ ip * 24 - 25], &i__10, &all_1.islur[
commvl_1.ivx + ip * 24 - 25], &
commvl_1.nvmx[all_1.iv - 1], &
commvl_1.ivx, &all_1.nv);
-#line 18690 ""
+#line 18677 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24
- 25],0) && *(unsigned char *)&ch__6[0] ==
'u' || isdotted_(all_1.nodur, &
@@ -44428,9 +44688,9 @@ L17:
/* Upstem non-rest, or dotted */
/* Computing MAX */
-#line 18697 ""
+#line 18684 ""
i__10 = 1, i__12 = numbms[commvl_1.ivx];
-#line 18697 ""
+#line 18684 ""
if (numbms[commvl_1.ivx] > 0 && ip ==
all_1.ibm2[commvl_1.ivx + max(i__10,
i__12) * 24 - 25] && ! isdotted_(
@@ -44438,70 +44698,70 @@ L17:
/* In beam and not dotted, so use smaller space */
-#line 18704 ""
+#line 18691 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.upstmfac;
-#line 18705 ""
+#line 18692 ""
} else {
-#line 18706 ""
+#line 18693 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.flagfac;
-#line 18707 ""
+#line 18694 ""
}
-#line 18708 ""
+#line 18695 ""
}
-#line 18709 ""
+#line 18696 ""
} else {
/* Last space, nonflagged (no beam) only worry dot or up */
-#line 18713 ""
+#line 18700 ""
if (isdotted_(all_1.nodur, &commvl_1.ivx, &ip)) {
-#line 18714 ""
+#line 18701 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.flagfac;
-#line 18715 ""
+#line 18702 ""
} else /* if(complicated condition) */ {
-#line 18715 ""
+#line 18702 ""
i__10 = ncmid_(&all_1.iv, &ip);
-#line 18715 ""
+#line 18702 ""
udqq_(ch__6, (ftnlen)1, &all_1.nolev[
commvl_1.ivx + ip * 24 - 25], &i__10,
&all_1.islur[commvl_1.ivx + ip * 24 -
25], &commvl_1.nvmx[all_1.iv - 1], &
commvl_1.ivx, &all_1.nv);
-#line 18715 ""
+#line 18702 ""
if (all_1.tnote[comipl2_1.ipl2[commvl_1.ivx +
ip * 24 - 25] - 1] < 64.f && *(
unsigned char *)&ch__6[0] == 'u') {
/* Upstem on last note , non-flagged */
-#line 18721 ""
+#line 18708 ""
comnsp_2.flgndv[commvl_1.ivx - 1] =
spfacs_1.upstmfac;
-#line 18722 ""
+#line 18709 ""
}
-#line 18722 ""
+#line 18709 ""
}
-#line 18723 ""
+#line 18710 ""
}
-#line 18724 ""
+#line 18711 ""
}
/* Check for right-shifted chordal note */
-#line 18728 ""
+#line 18715 ""
if (bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],20))
{
-#line 18728 ""
+#line 18715 ""
comnsp_2.flgndv[commvl_1.ivx - 1] = spfacs_1.rtshfac;
-#line 18728 ""
+#line 18715 ""
}
-#line 18729 ""
+#line 18716 ""
comnsp_2.flgndb = comnsp_2.flgndb || comnsp_2.flgndv[
commvl_1.ivx - 1] > 0.f;
-#line 18730 ""
+#line 18717 ""
if (commidi_1.ismidi) {
/* For midi, set flags for accidentals on last note of bar. Assume they affect */
@@ -44513,102 +44773,102 @@ L17:
/* c Old old lbacc(icm) = iand(nacc(ivx,ip),7) */
/* New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) */
-#line 18741 ""
+#line 18728 ""
if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0)
{
/* Explicit accidental on last main note in bar */
-#line 18745 ""
+#line 18732 ""
i__10 = comslm_1.naccbl[icm];
-#line 18745 ""
+#line 18732 ""
for (kacc = 1; kacc <= i__10; ++kacc) {
-#line 18746 ""
+#line 18733 ""
if (comslm_1.laccbl[icm + kacc * 25 - 25] ==
all_1.nolev[commvl_1.ivx + ip * 24 -
25]) {
-#line 18746 ""
+#line 18733 ""
goto L56;
-#line 18746 ""
+#line 18733 ""
}
-#line 18747 ""
+#line 18734 ""
/* L55: */
-#line 18747 ""
+#line 18734 ""
}
-#line 18748 ""
+#line 18735 ""
++comslm_1.naccbl[icm];
-#line 18749 ""
+#line 18736 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = all_1.nolev[commvl_1.ivx + ip * 24
- 25];
-#line 18750 ""
+#line 18737 ""
i__10 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] &
7;
-#line 18750 ""
+#line 18737 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = iashft_(&i__10);
-#line 18751 ""
+#line 18738 ""
}
-#line 18752 ""
+#line 18739 ""
L56:
-#line 18753 ""
+#line 18740 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 - 25],
10) && commidi_1.crdacc) {
-#line 18754 ""
+#line 18741 ""
i__10 = comtrill_1.icrd2;
-#line 18754 ""
+#line 18741 ""
for (icrd = comtrill_1.icrd1; icrd <= i__10;
++icrd) {
-#line 18755 ""
+#line 18742 ""
iacc = igetbits_(&comtrill_1.icrdat[icrd - 1],
&c__3, &c__20);
-#line 18756 ""
+#line 18743 ""
if (iacc > 0) {
/* Explicit accidental on chord note at end of bar */
-#line 18760 ""
+#line 18747 ""
nolevc = igetbits_(&comtrill_1.icrdat[
icrd - 1], &c__7, &c__12);
-#line 18761 ""
+#line 18748 ""
i__12 = comslm_1.naccbl[icm];
-#line 18761 ""
+#line 18748 ""
for (kacc = 1; kacc <= i__12; ++kacc) {
-#line 18762 ""
+#line 18749 ""
if (comslm_1.laccbl[icm + kacc * 25 -
25] == nolevc) {
-#line 18762 ""
+#line 18749 ""
goto L59;
-#line 18762 ""
+#line 18749 ""
}
-#line 18763 ""
+#line 18750 ""
/* L58: */
-#line 18763 ""
+#line 18750 ""
}
-#line 18764 ""
+#line 18751 ""
++comslm_1.naccbl[icm];
-#line 18765 ""
+#line 18752 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm]
* 25 - 25] = nolevc;
-#line 18766 ""
+#line 18753 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm]
* 25 - 25] = iashft_(&iacc);
-#line 18767 ""
+#line 18754 ""
}
-#line 18768 ""
+#line 18755 ""
L59:
-#line 18769 ""
+#line 18756 ""
/* L57: */
-#line 18769 ""
+#line 18756 ""
;
-#line 18769 ""
+#line 18756 ""
}
-#line 18770 ""
+#line 18757 ""
}
/* if (lbacc(icm).eq.0 .and. accb4(icm)) then */
-#line 18772 ""
+#line 18759 ""
i__10 = commidi_1.naccim[icm];
-#line 18772 ""
+#line 18759 ""
for (kacc = 1; kacc <= i__10; ++kacc) {
/* If naccim(icm)>0, */
@@ -44617,207 +44877,209 @@ L59:
/* explicit action from just above. Assuming any accid on last note in bar, */
/* either explicit or implicit, has same effect on 1st note of next bar. */
-#line 18780 ""
+#line 18767 ""
if (all_1.nolev[commvl_1.ivx + ip * 24 - 25] ==
commidi_1.laccim[icm + kacc * 25 - 25]) {
-#line 18780 ""
+#line 18767 ""
goto L66;
-#line 18780 ""
+#line 18767 ""
}
-#line 18781 ""
+#line 18768 ""
if (bit_test(all_1.ipl[commvl_1.ivx + ip * 24 -
25],10)) {
-#line 18782 ""
+#line 18769 ""
i__12 = comtrill_1.icrd2;
-#line 18782 ""
+#line 18769 ""
for (icrd = comtrill_1.icrd1; icrd <= i__12;
++icrd) {
-#line 18783 ""
+#line 18770 ""
if ((lbit_shift(comtrill_1.icrdat[icrd -
1], (ftnlen)-12) & 127) ==
commidi_1.laccim[icm + kacc * 25
- 25]) {
-#line 18783 ""
+#line 18770 ""
goto L66;
-#line 18783 ""
+#line 18770 ""
}
-#line 18785 ""
+#line 18772 ""
/* L67: */
-#line 18785 ""
+#line 18772 ""
}
-#line 18786 ""
+#line 18773 ""
}
-#line 18787 ""
+#line 18774 ""
goto L65;
-#line 18788 ""
+#line 18775 ""
L66:
/* So far we know there is a main or chord note at level laccim(icm,kacc). So */
/* it will get a bl-accid if it didn't just already get one. */
-#line 18793 ""
+#line 18780 ""
i__12 = comslm_1.naccbl[icm];
-#line 18793 ""
+#line 18780 ""
for (macc = 1; macc <= i__12; ++macc) {
-#line 18794 ""
+#line 18781 ""
if (comslm_1.laccbl[icm + macc * 25 - 25] ==
commidi_1.laccim[icm + kacc * 25 - 25]
) {
-#line 18794 ""
+#line 18781 ""
goto L65;
-#line 18794 ""
+#line 18781 ""
}
-#line 18795 ""
+#line 18782 ""
/* L68: */
-#line 18795 ""
+#line 18782 ""
}
-#line 18796 ""
+#line 18783 ""
++comslm_1.naccbl[icm];
-#line 18797 ""
+#line 18784 ""
comslm_1.laccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = commidi_1.laccim[icm + kacc * 25 -
25];
-#line 18798 ""
+#line 18785 ""
comslm_1.jaccbl[icm + comslm_1.naccbl[icm] * 25 -
25] = commidi_1.jaccim[icm + kacc * 25 -
25];
-#line 18799 ""
+#line 18786 ""
L65:
-#line 18799 ""
+#line 18786 ""
;
-#line 18799 ""
+#line 18786 ""
}
-#line 18800 ""
+#line 18787 ""
}
-#line 18801 ""
+#line 18788 ""
}
-#line 18802 ""
-/* L11: */
-#line 18802 ""
+#line 18789 ""
+/* L1199: */
+#line 18789 ""
}
-#line 18802 ""
+#line 18790 ""
+/* L11: */
+#line 18790 ""
}
/* Close out the notes group */
/* Writing concatenation */
-#line 18806 ""
+#line 18794 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18806 ""
+#line 18794 ""
i__4[1] = 2, a__2[1] = "en";
-#line 18806 ""
+#line 18794 ""
s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)3);
-#line 18806 ""
+#line 18794 ""
addstr_(ch__14, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80);
-#line 18807 ""
+#line 18795 ""
if (comlast_1.islast && lsout > 0) {
-#line 18807 ""
+#line 18795 ""
s_wsfe(&io___1141);
/* Writing concatenation */
-#line 18807 ""
+#line 18795 ""
i__4[0] = lsout, a__2[0] = soutq;
-#line 18807 ""
+#line 18795 ""
i__4[1] = 1, a__2[1] = "%";
-#line 18807 ""
+#line 18795 ""
s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)81);
-#line 18807 ""
+#line 18795 ""
do_fio(&c__1, ch__12, lsout + 1);
-#line 18807 ""
+#line 18795 ""
e_wsfe();
-#line 18807 ""
+#line 18795 ""
}
-#line 18808 ""
+#line 18796 ""
/* L16: */
-#line 18808 ""
+#line 18796 ""
}
/* Check for way-after graces at end of bar. We could not link these to notes */
/* as in midbar since there is no note following grace! Also, set flag if */
/* hardspace is needed. Also, save nvmx, ivmx for use in space checks on reloop. */
-#line 18814 ""
+#line 18802 ""
isgrace = FALSE_;
-#line 18815 ""
- i__2 = all_1.nv;
-#line 18815 ""
- for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
-#line 18816 ""
+#line 18803 ""
+ i__1 = all_1.nv;
+#line 18803 ""
+ for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 18804 ""
comnsp_2.nvmxsav[all_1.iv - 1] = commvl_1.nvmx[all_1.iv - 1];
-#line 18817 ""
- i__7 = commvl_1.nvmx[all_1.iv - 1];
-#line 18817 ""
- for (kv = 1; kv <= i__7; ++kv) {
-#line 18818 ""
+#line 18805 ""
+ i__2 = commvl_1.nvmx[all_1.iv - 1];
+#line 18805 ""
+ for (kv = 1; kv <= i__2; ++kv) {
+#line 18806 ""
comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25] = commvl_1.ivmx[
all_1.iv + kv * 24 - 25];
-#line 18819 ""
+#line 18807 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 18820 ""
+#line 18808 ""
comnsp_2.ptsgnd = 0.f;
-#line 18821 ""
+#line 18809 ""
if ((bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1]
* 24 - 25],29) || bit_test(all_1.ipl[commvl_1.ivx +
all_1.nn[commvl_1.ivx - 1] * 24 - 25],31)) && ptsndg[
commvl_1.ivx - 1] > 0.f) {
-#line 18823 ""
+#line 18811 ""
comnsp_2.flgndb = TRUE_;
-#line 18824 ""
+#line 18812 ""
if (ptsndg[commvl_1.ivx - 1] > comnsp_2.ptsgnd) {
-#line 18825 ""
+#line 18813 ""
comnsp_2.ptsgnd = ptsndg[commvl_1.ivx - 1];
-#line 18826 ""
+#line 18814 ""
comnsp_2.eskgnd = eskndg[commvl_1.ivx - 1];
-#line 18827 ""
+#line 18815 ""
}
-#line 18828 ""
+#line 18816 ""
}
-#line 18829 ""
+#line 18817 ""
if (bit_test(all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] *
24 - 25],31)) {
/* This voice has a way-after grace here at end of bar */
-#line 18833 ""
+#line 18821 ""
if (! isgrace) {
/* This is the first one, so set up the string */
-#line 18837 ""
+#line 18825 ""
isgrace = TRUE_;
-#line 18838 ""
+#line 18826 ""
ivlast = 1;
/* Writing concatenation */
-#line 18839 ""
+#line 18827 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18839 ""
+#line 18827 ""
i__4[1] = 6, a__2[1] = "znotes";
-#line 18839 ""
+#line 18827 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 18840 ""
+#line 18828 ""
lsout = 7;
-#line 18841 ""
+#line 18829 ""
}
-#line 18842 ""
- i__1 = all_1.iv - 1;
-#line 18842 ""
- for (iiv = ivlast; iiv <= i__1; ++iiv) {
-#line 18843 ""
+#line 18830 ""
+ i__7 = all_1.iv - 1;
+#line 18830 ""
+ for (iiv = ivlast; iiv <= i__7; ++iiv) {
+#line 18831 ""
addstr_(all_1.sepsymq + (iiv - 1), &c__1, soutq, &lsout, (
ftnlen)1, (ftnlen)80);
-#line 18844 ""
+#line 18832 ""
/* L76: */
-#line 18844 ""
+#line 18832 ""
}
-#line 18845 ""
+#line 18833 ""
ivlast = all_1.iv;
/* No need to put in 'nextvoice', even if 2 lines/staff */
-#line 18849 ""
- i__1 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]);
-#line 18849 ""
+#line 18837 ""
+ i__7 = ncmid_(&all_1.iv, &all_1.nn[commvl_1.ivx - 1]);
+#line 18837 ""
dograce_(&commvl_1.ivx, &all_1.nn[commvl_1.ivx - 1], ptgr,
- soutq, &lsout, &i__1, &all_1.nacc[commvl_1.ivx +
+ soutq, &lsout, &i__7, &all_1.nacc[commvl_1.ivx +
all_1.nn[commvl_1.ivx - 1] * 24 - 25], &ig, &
all_1.ipl[commvl_1.ivx + all_1.nn[commvl_1.ivx - 1] *
24 - 25], &c_true, &c_false, &c__0, &c__0, &c__0, &
@@ -44826,437 +45088,439 @@ L65:
ftnlen)1);
/* 130324 */
/* * .false.,0,0,0,0,0,0,0.,ulq) */
-#line 18854 ""
+#line 18842 ""
}
-#line 18855 ""
-/* L75: */
-#line 18855 ""
+#line 18843 ""
+/* L7599: */
+#line 18843 ""
}
-#line 18855 ""
+#line 18844 ""
+/* L75: */
+#line 18844 ""
}
-#line 18856 ""
+#line 18845 ""
if (isgrace) {
/* Writing concatenation */
-#line 18857 ""
+#line 18846 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18857 ""
+#line 18846 ""
i__4[1] = 3, a__2[1] = "en%";
-#line 18857 ""
+#line 18846 ""
s_cat(ch__20, a__2, i__4, &c__2, (ftnlen)4);
-#line 18857 ""
+#line 18846 ""
addstr_(ch__20, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80);
-#line 18858 ""
+#line 18847 ""
if (comlast_1.islast && lsout > 0) {
-#line 18858 ""
+#line 18847 ""
s_wsfe(&io___1144);
-#line 18858 ""
+#line 18847 ""
do_fio(&c__1, soutq, lsout);
-#line 18858 ""
+#line 18847 ""
e_wsfe();
-#line 18858 ""
+#line 18847 ""
}
-#line 18859 ""
+#line 18848 ""
}
-#line 18860 ""
+#line 18849 ""
lsout = 0;
/* Write multibar rest. Assuming nv = 1 and do not worry about cwbrest */
/* This has to be the only use of atnextbar */
-#line 18865 ""
+#line 18854 ""
if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) {
-#line 18866 ""
+#line 18855 ""
if (comignorenats_1.newmbrhgt) {
/* Writing concatenation */
-#line 18867 ""
+#line 18856 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 18867 ""
+#line 18856 ""
i__9[1] = 3, a__6[1] = "def";
-#line 18867 ""
+#line 18856 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 18867 ""
+#line 18856 ""
i__9[3] = 7, a__6[3] = "mbrhgt{";
-#line 18867 ""
+#line 18856 ""
s_cat(soutq, a__6, i__9, &c__4, (ftnlen)80);
-#line 18868 ""
+#line 18857 ""
if (comignorenats_1.mbrhgt <= -10) {
-#line 18869 ""
+#line 18858 ""
s_wsfi(&io___1145);
-#line 18869 ""
+#line 18858 ""
do_fio(&c__1, (char *)&comignorenats_1.mbrhgt, (ftnlen)sizeof(
integer));
-#line 18869 ""
+#line 18858 ""
e_wsfi();
-#line 18870 ""
+#line 18859 ""
lsout = 15;
-#line 18871 ""
+#line 18860 ""
} else if (comignorenats_1.mbrhgt >= 10 || comignorenats_1.mbrhgt
<= -1) {
-#line 18872 ""
+#line 18861 ""
s_wsfi(&io___1146);
-#line 18872 ""
+#line 18861 ""
do_fio(&c__1, (char *)&comignorenats_1.mbrhgt, (ftnlen)sizeof(
integer));
-#line 18872 ""
+#line 18861 ""
e_wsfi();
-#line 18873 ""
+#line 18862 ""
lsout = 14;
-#line 18874 ""
+#line 18863 ""
} else {
/* Writing concatenation */
-#line 18875 ""
+#line 18864 ""
i__4[0] = 12, a__2[0] = soutq;
-#line 18875 ""
+#line 18864 ""
*(unsigned char *)&ch__6[0] = comignorenats_1.mbrhgt + 48;
-#line 18875 ""
+#line 18864 ""
i__4[1] = 1, a__2[1] = ch__6;
-#line 18875 ""
+#line 18864 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 18876 ""
+#line 18865 ""
lsout = 13;
-#line 18877 ""
+#line 18866 ""
}
/* Writing concatenation */
-#line 18878 ""
+#line 18867 ""
i__4[0] = lsout, a__2[0] = soutq;
-#line 18878 ""
+#line 18867 ""
i__4[1] = 2, a__2[1] = "}%";
-#line 18878 ""
+#line 18867 ""
s_cat(soutq, a__2, i__4, &c__2, (ftnlen)80);
-#line 18879 ""
+#line 18868 ""
s_wsfe(&io___1147);
-#line 18879 ""
+#line 18868 ""
do_fio(&c__1, soutq, lsout + 2);
-#line 18879 ""
+#line 18868 ""
e_wsfe();
-#line 18880 ""
+#line 18869 ""
comignorenats_1.newmbrhgt = FALSE_;
-#line 18881 ""
+#line 18870 ""
}
/* Writing concatenation */
-#line 18882 ""
+#line 18871 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 18882 ""
+#line 18871 ""
i__3[1] = 3, a__1[1] = "def";
-#line 18882 ""
+#line 18871 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 18882 ""
+#line 18871 ""
i__3[3] = 10, a__1[3] = "atnextbar{";
-#line 18882 ""
+#line 18871 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 18882 ""
+#line 18871 ""
i__3[5] = 6, a__1[5] = "znotes";
-#line 18882 ""
+#line 18871 ""
s_cat(soutq, a__1, i__3, &c__6, (ftnlen)80);
-#line 18883 ""
+#line 18872 ""
lsout = 22;
/* Writing concatenation */
-#line 18884 ""
+#line 18873 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18884 ""
+#line 18873 ""
i__4[1] = 6, a__2[1] = "mbrest";
-#line 18884 ""
+#line 18873 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18885 ""
+#line 18874 ""
lnote = 7;
-#line 18886 ""
+#line 18875 ""
istring_(&comgrace_1.mbrest, noteq, &len, (ftnlen)8);
/* Writing concatenation */
-#line 18887 ""
+#line 18876 ""
i__4[0] = lnote, a__2[0] = notexq;
-#line 18887 ""
+#line 18876 ""
i__4[1] = len, a__2[1] = noteq;
-#line 18887 ""
+#line 18876 ""
s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79);
-#line 18888 ""
+#line 18877 ""
lnote += len;
-#line 18889 ""
+#line 18878 ""
mtrspc = i_nint(&comgrace_1.xb4mbr);
-#line 18890 ""
+#line 18879 ""
comgrace_1.xb4mbr = 0.f;
-#line 18891 ""
+#line 18880 ""
istring_(&mtrspc, noteq, &len, (ftnlen)8);
/* Writing concatenation */
-#line 18892 ""
+#line 18881 ""
i__6[0] = lnote, a__4[0] = notexq;
-#line 18892 ""
+#line 18881 ""
i__6[1] = len, a__4[1] = noteq;
-#line 18892 ""
+#line 18881 ""
i__6[2] = 1, a__4[2] = "0";
-#line 18892 ""
+#line 18881 ""
s_cat(notexq, a__4, i__6, &c__3, (ftnlen)79);
-#line 18893 ""
+#line 18882 ""
lnote = lnote + len + 1;
-#line 18894 ""
- i__7 = all_1.nv;
-#line 18894 ""
- for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
-#line 18895 ""
+#line 18883 ""
+ i__1 = all_1.nv;
+#line 18883 ""
+ for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 18884 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (ftnlen)80);
-#line 18896 ""
+#line 18885 ""
if (all_1.iv < all_1.nv) {
-#line 18896 ""
+#line 18885 ""
addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
(ftnlen)1, (ftnlen)80);
-#line 18896 ""
+#line 18885 ""
}
-#line 18897 ""
+#line 18886 ""
/* L62: */
-#line 18897 ""
+#line 18886 ""
}
/* Writing concatenation */
-#line 18898 ""
+#line 18887 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18898 ""
+#line 18887 ""
i__4[1] = 4, a__2[1] = "en}%";
-#line 18898 ""
+#line 18887 ""
s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5);
-#line 18898 ""
+#line 18887 ""
addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80);
-#line 18899 ""
+#line 18888 ""
s_wsfe(&io___1150);
-#line 18899 ""
+#line 18888 ""
do_fio(&c__1, soutq, lsout);
-#line 18899 ""
+#line 18888 ""
e_wsfe();
-#line 18900 ""
+#line 18889 ""
lsout = 0;
-#line 18901 ""
+#line 18890 ""
if (comshort_1.ishort > 0) {
-#line 18902 ""
+#line 18891 ""
comshort_1.mbrsum += comgrace_1.mbrest;
-#line 18903 ""
+#line 18892 ""
++comshort_1.nmbr;
-#line 18904 ""
+#line 18893 ""
}
-#line 18905 ""
+#line 18894 ""
if (comgrace_1.mbrest > 1) {
-#line 18906 ""
+#line 18895 ""
r__1 = comgrace_1.mbrest - 1 + .01f;
-#line 18906 ""
+#line 18895 ""
ndig = (integer) r_lg10(&r__1) + 1;
-#line 18907 ""
+#line 18896 ""
ci__1.cierr = 0;
-#line 18907 ""
+#line 18896 ""
ci__1.ciunit = 11;
/* Writing concatenation */
-#line 18907 ""
+#line 18896 ""
i__6[0] = 6, a__4[0] = "(a14,i";
-#line 18907 ""
- i__7 = ndig + 48;
-#line 18907 ""
- chax_(ch__6, (ftnlen)1, &i__7);
-#line 18907 ""
+#line 18896 ""
+ i__1 = ndig + 48;
+#line 18896 ""
+ chax_(ch__6, (ftnlen)1, &i__1);
+#line 18896 ""
i__6[1] = 1, a__4[1] = ch__6;
-#line 18907 ""
+#line 18896 ""
i__6[2] = 4, a__4[2] = ",a1)";
-#line 18907 ""
+#line 18896 ""
ci__1.cifmt = (s_cat(ch__9, a__4, i__6, &c__3, (ftnlen)11), ch__9)
;
-#line 18907 ""
+#line 18896 ""
s_wsfe(&ci__1);
/* Writing concatenation */
-#line 18907 ""
+#line 18896 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 18907 ""
+#line 18896 ""
i__9[1] = 7, a__6[1] = "advance";
-#line 18907 ""
+#line 18896 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 18907 ""
+#line 18896 ""
i__9[3] = 5, a__6[3] = "barno";
-#line 18907 ""
+#line 18896 ""
s_cat(ch__4, a__6, i__9, &c__4, (ftnlen)14);
-#line 18907 ""
+#line 18896 ""
do_fio(&c__1, ch__4, (ftnlen)14);
-#line 18907 ""
+#line 18896 ""
i__2 = comgrace_1.mbrest - 1;
-#line 18907 ""
+#line 18896 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 18907 ""
+#line 18896 ""
do_fio(&c__1, "%", (ftnlen)1);
-#line 18907 ""
+#line 18896 ""
e_wsfe();
-#line 18909 ""
+#line 18898 ""
}
-#line 18910 ""
+#line 18899 ""
} else if (iscwr) {
/* Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar */
/* to check for new clef and add space by redefining \CenterBar */
-#line 18915 ""
+#line 18904 ""
comclefrests_1.centrests = TRUE_;
/* Writing concatenation */
-#line 18916 ""
+#line 18905 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 18916 ""
+#line 18905 ""
i__9[1] = 3, a__6[1] = "def";
-#line 18916 ""
+#line 18905 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 18916 ""
+#line 18905 ""
i__9[3] = 8, a__6[3] = "value{0}";
-#line 18916 ""
+#line 18905 ""
s_cat(ch__18, a__6, i__9, &c__4, (ftnlen)13);
-#line 18916 ""
+#line 18905 ""
addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, (ftnlen)80);
/* Writing concatenation */
-#line 18917 ""
+#line 18906 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 18917 ""
+#line 18906 ""
i__3[1] = 3, a__1[1] = "def";
-#line 18917 ""
+#line 18906 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 18917 ""
+#line 18906 ""
i__3[3] = 10, a__1[3] = "atnextbar{";
-#line 18917 ""
+#line 18906 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 18917 ""
+#line 18906 ""
i__3[5] = 6, a__1[5] = "znotes";
-#line 18917 ""
+#line 18906 ""
s_cat(ch__21, a__1, i__3, &c__6, (ftnlen)22);
-#line 18917 ""
+#line 18906 ""
addstr_(ch__21, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80);
-#line 18919 ""
- i__7 = all_1.nv;
-#line 18919 ""
- for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
+#line 18908 ""
+ i__1 = all_1.nv;
+#line 18908 ""
+ for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
/* added */
-#line 18921 ""
+#line 18910 ""
lnote = 0;
-#line 18923 ""
+#line 18912 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 18923 ""
+#line 18912 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 18924 ""
+#line 18913 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 18925 ""
+#line 18914 ""
if (cwrest[commvl_1.ivx]) {
/* Writing concatenation */
-#line 18926 ""
+#line 18915 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18926 ""
+#line 18915 ""
i__4[1] = 10, a__2[1] = "CenterBar{";
-#line 18926 ""
+#line 18915 ""
s_cat(ch__9, a__2, i__4, &c__2, (ftnlen)11);
-#line 18926 ""
+#line 18915 ""
addstr_(ch__9, &c__11, soutq, &lsout, (ftnlen)11, (ftnlen)
80);
-#line 18927 ""
+#line 18916 ""
if (! comcwrf_1.cwrferm[commvl_1.ivx - 1]) {
-#line 18928 ""
+#line 18917 ""
if (lcwr[commvl_1.ivx - 1] >= 11 && *(unsigned char *)
&cwrq[(commvl_1.ivx - 1) * 79 + 10] != 'p') {
/* Kluge to use new definitions for centered, stacked rests */
-#line 18932 ""
+#line 18921 ""
if (s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 + 1),
"liftpause", (ftnlen)9, (ftnlen)9) == 0 ||
s_cmp(cwrq + ((commvl_1.ivx - 1) * 79 +
1), "liftPAuse", (ftnlen)9, (ftnlen)9) ==
0) {
-#line 18932 ""
+#line 18921 ""
*(unsigned char *)&cwrq[(commvl_1.ivx - 1) *
79 + 9] = 'c';
-#line 18932 ""
+#line 18921 ""
}
-#line 18935 ""
+#line 18924 ""
}
-#line 18936 ""
+#line 18925 ""
addstr_(cwrq + (commvl_1.ivx - 1) * 79, &lcwr[
commvl_1.ivx - 1], soutq, &lsout, lcwr[
commvl_1.ivx - 1], (ftnlen)80);
/* Writing concatenation */
-#line 18938 ""
+#line 18927 ""
i__6[0] = 6, a__4[0] = "}{-2}{";
-#line 18938 ""
+#line 18927 ""
i__6[1] = 1, a__4[1] = all_1.sq;
-#line 18938 ""
+#line 18927 ""
i__6[2] = 6, a__4[2] = "value}";
-#line 18938 ""
+#line 18927 ""
s_cat(ch__18, a__4, i__6, &c__3, (ftnlen)13);
-#line 18938 ""
+#line 18927 ""
addstr_(ch__18, &c__13, soutq, &lsout, (ftnlen)13, (
ftnlen)80);
-#line 18939 ""
+#line 18928 ""
} else {
/* Fermata on centered rest. Will need to fix up level. */
/* 12/6/07 shift it left so it's centered over rest */
/* Writing concatenation */
-#line 18944 ""
+#line 18933 ""
i__15[0] = lnote, a__9[0] = notexq;
-#line 18944 ""
+#line 18933 ""
i__15[1] = 1, a__9[1] = all_1.sq;
-#line 18944 ""
+#line 18933 ""
i__15[2] = 13, a__9[2] = "loffset{.33}{";
-#line 18944 ""
+#line 18933 ""
i__15[3] = 1, a__9[3] = all_1.sq;
-#line 18944 ""
+#line 18933 ""
i__15[4] = 11, a__9[4] = "fermataup7}";
-#line 18944 ""
+#line 18933 ""
i__15[5] = lcwr[commvl_1.ivx - 1], a__9[5] = cwrq + (
commvl_1.ivx - 1) * 79;
-#line 18944 ""
+#line 18933 ""
i__15[6] = 6, a__9[6] = "}{-2}{";
-#line 18944 ""
+#line 18933 ""
i__15[7] = 1, a__9[7] = all_1.sq;
-#line 18944 ""
+#line 18933 ""
i__15[8] = 6, a__9[8] = "value}";
-#line 18944 ""
+#line 18933 ""
s_cat(notexq, a__9, i__15, &c__9, (ftnlen)79);
-#line 18947 ""
+#line 18936 ""
lnote = lnote + 26 + lcwr[commvl_1.ivx - 1] + 13;
-#line 18948 ""
+#line 18937 ""
addstr_(notexq, &lnote, soutq, &lsout, (ftnlen)79, (
ftnlen)80);
-#line 18949 ""
+#line 18938 ""
comcwrf_1.cwrferm[commvl_1.ivx - 1] = FALSE_;
-#line 18950 ""
+#line 18939 ""
}
-#line 18951 ""
+#line 18940 ""
}
-#line 18952 ""
+#line 18941 ""
/* L61: */
-#line 18952 ""
+#line 18941 ""
}
-#line 18953 ""
+#line 18942 ""
if (all_1.iv != all_1.nv) {
-#line 18953 ""
+#line 18942 ""
addstr_(all_1.sepsymq + (all_1.iv - 1), &c__1, soutq, &lsout,
(ftnlen)1, (ftnlen)80);
-#line 18953 ""
+#line 18942 ""
}
-#line 18954 ""
+#line 18943 ""
/* L60: */
-#line 18954 ""
+#line 18943 ""
}
-#line 18955 ""
+#line 18944 ""
if (comlast_1.islast) {
/* Writing concatenation */
-#line 18956 ""
+#line 18945 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 18956 ""
+#line 18945 ""
i__4[1] = 4, a__2[1] = "en}%";
-#line 18956 ""
+#line 18945 ""
s_cat(ch__19, a__2, i__4, &c__2, (ftnlen)5);
-#line 18956 ""
+#line 18945 ""
addstr_(ch__19, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80);
-#line 18957 ""
+#line 18946 ""
if (lsout > 0) {
-#line 18957 ""
+#line 18946 ""
s_wsfe(&io___1152);
-#line 18957 ""
+#line 18946 ""
do_fio(&c__1, soutq, lsout);
-#line 18957 ""
+#line 18946 ""
e_wsfe();
-#line 18957 ""
+#line 18946 ""
}
-#line 18958 ""
+#line 18947 ""
}
-#line 18959 ""
+#line 18948 ""
}
/* End of block for centered whole-bar rests and multi-bar rests */
@@ -45264,52 +45528,54 @@ L65:
/* If at end of block, save durations of last notes in bar, for possible use */
/* if clef changes at start of next bar */
-#line 18966 ""
+#line 18955 ""
if (all_1.ibar == all_1.nbars) {
-#line 18967 ""
- i__7 = all_1.nv;
-#line 18967 ""
- for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
-#line 18968 ""
+#line 18956 ""
+ i__1 = all_1.nv;
+#line 18956 ""
+ for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
+#line 18957 ""
i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 18968 ""
+#line 18957 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 18969 ""
+#line 18958 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 18970 ""
+#line 18959 ""
comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[
comipl2_1.ipl2[commvl_1.ivx + all_1.nn[commvl_1.ivx -
1] * 24 - 25] - 1];
-#line 18971 ""
-/* L63: */
-#line 18971 ""
+#line 18960 ""
+/* L6399: */
+#line 18960 ""
}
-#line 18971 ""
+#line 18961 ""
+/* L63: */
+#line 18961 ""
}
-#line 18972 ""
+#line 18962 ""
}
/* Update time for midi. This is only used for the event track */
-#line 18976 ""
+#line 18966 ""
if (commidi_1.ismidi) {
-#line 18977 ""
+#line 18967 ""
comevent_1.miditime += all_1.lenbar * 15;
/* If pickup, write the real time signature to the event track. Cannot use */
/* mtrnuml since it was reset to 0, have to recompute it */
-#line 18982 ""
+#line 18972 ""
if (all_1.lenb0 == all_1.lenbar) {
-#line 18982 ""
- i__2 = all_1.mtrdenl * all_1.lenb1 / 64;
-#line 18982 ""
- midievent_("m", &i__2, &all_1.mtrdenl, (ftnlen)1);
-#line 18982 ""
+#line 18972 ""
+ i__1 = all_1.mtrdenl * all_1.lenb1 / 64;
+#line 18972 ""
+ midievent_("m", &i__1, &all_1.mtrdenl, (ftnlen)1);
+#line 18972 ""
}
-#line 18984 ""
+#line 18974 ""
}
-#line 18985 ""
+#line 18975 ""
return 0;
} /* make2bar_ */
@@ -45373,187 +45639,191 @@ L65:
/* i.e., with squez=1. Use after parsing into line to decide if */
/* spacing needs to be "flattened" among notes groups. */
-/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
-/* logical rest,firstline,newmeter,gotclef */
-#line 19034 ""
+#line 19022 ""
linecom_1.elskb = 0.f;
-#line 19035 ""
+#line 19023 ""
linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = 1e3f;
-#line 19036 ""
+#line 19024 ""
i__1 = a1ll_2.nv;
-#line 19036 ""
+#line 19024 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
-#line 19037 ""
+#line 19025 ""
i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
-#line 19037 ""
+#line 19025 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 19038 ""
+#line 19026 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
-#line 19039 ""
+#line 19027 ""
if (a1ll_2.ibar > 1) {
-#line 19040 ""
+#line 19028 ""
a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx +
a1ll_2.ibar * 24 - 25] - a1ll_2.nib[c1ommvl_1.ivx + (
a1ll_2.ibar - 1) * 24 - 25];
-#line 19041 ""
+#line 19029 ""
} else {
-#line 19042 ""
+#line 19030 ""
a1ll_2.nn[c1ommvl_1.ivx - 1] = a1ll_2.nib[c1ommvl_1.ivx +
a1ll_2.ibar * 24 - 25];
-#line 19043 ""
+#line 19031 ""
}
-#line 19044 ""
-/* L1: */
-#line 19044 ""
+#line 19032 ""
+/* L1999: */
+#line 19032 ""
}
-#line 19044 ""
+#line 19033 ""
+/* L1: */
+#line 19033 ""
}
/* initialize list note counter, time(iv), curr. note(iv) */
-#line 19048 ""
+#line 19037 ""
ilnc = 1;
-#line 19049 ""
- i__2 = a1ll_2.nv;
-#line 19049 ""
- for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
-#line 19050 ""
- i__1 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
-#line 19050 ""
- for (kv = 1; kv <= i__1; ++kv) {
-#line 19051 ""
+#line 19038 ""
+ i__1 = a1ll_2.nv;
+#line 19038 ""
+ for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
+#line 19039 ""
+ i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 19039 ""
+ for (kv = 1; kv <= i__2; ++kv) {
+#line 19040 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
-#line 19052 ""
+#line 19041 ""
cnn[c1ommvl_1.ivx - 1] = 1;
-#line 19053 ""
+#line 19042 ""
a1ll_2.ivxo[ilnc - 1] = c1ommvl_1.ivx;
-#line 19054 ""
+#line 19043 ""
a1ll_2.ipo[ilnc - 1] = 1;
-#line 19055 ""
+#line 19044 ""
a1ll_2.to[ilnc - 1] = 0.f;
-#line 19056 ""
+#line 19045 ""
tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &c1ommvl_1.ivx, &c__1,
c1ommvl_1.nacc);
-#line 19057 ""
+#line 19046 ""
xit[c1ommvl_1.ivx - 1] = tnote[ilnc - 1];
-#line 19058 ""
+#line 19047 ""
if ((r__1 = xit[c1ommvl_1.ivx - 1] - a1ll_2.lenbar, dabs(r__1)) <
comtol_1.tol) {
-#line 19058 ""
+#line 19047 ""
xit[c1ommvl_1.ivx - 1] = 1e3f;
-#line 19058 ""
+#line 19047 ""
}
-#line 19059 ""
+#line 19048 ""
++ilnc;
-#line 19060 ""
-/* L4: */
-#line 19060 ""
+#line 19049 ""
+/* L4999: */
+#line 19049 ""
}
-#line 19060 ""
+#line 19050 ""
+/* L4: */
+#line 19050 ""
}
/* Build the list */
-#line 19064 ""
+#line 19054 ""
L5:
/* Determine which voice comes next from end of notes done so far. */
/* tmin is the earliest ending time of notes done so far */
-#line 19069 ""
+#line 19059 ""
tmin = 1e3f;
-#line 19070 ""
+#line 19060 ""
i__1 = a1ll_2.nv;
-#line 19070 ""
+#line 19060 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
-#line 19071 ""
+#line 19061 ""
i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
-#line 19071 ""
+#line 19061 ""
for (kv = 1; kv <= i__2; ++kv) {
-#line 19072 ""
+#line 19062 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
/* Computing MIN */
-#line 19073 ""
+#line 19063 ""
r__1 = tmin, r__2 = xit[c1ommvl_1.ivx - 1];
-#line 19073 ""
+#line 19063 ""
tminn = dmin(r__1,r__2);
-#line 19074 ""
+#line 19064 ""
if (tminn < tmin) {
-#line 19075 ""
+#line 19065 ""
tmin = tminn;
-#line 19076 ""
+#line 19066 ""
ivnext = c1ommvl_1.ivx;
-#line 19077 ""
+#line 19067 ""
}
-#line 19078 ""
-/* L6: */
-#line 19078 ""
+#line 19068 ""
+/* L6999: */
+#line 19068 ""
}
-#line 19078 ""
+#line 19069 ""
+/* L6: */
+#line 19069 ""
}
-#line 19079 ""
+#line 19070 ""
if (tmin > 999.f) {
-#line 19079 ""
+#line 19070 ""
goto L7;
-#line 19079 ""
+#line 19070 ""
}
-#line 19080 ""
+#line 19071 ""
a1ll_2.ivxo[ilnc - 1] = ivnext;
-#line 19081 ""
+#line 19072 ""
++cnn[ivnext - 1];
-#line 19082 ""
+#line 19073 ""
a1ll_2.ipo[ilnc - 1] = cnn[ivnext - 1];
-#line 19083 ""
+#line 19074 ""
a1ll_2.to[ilnc - 1] = tmin;
/* Check if this voice is done */
-#line 19087 ""
+#line 19078 ""
tnote[ilnc - 1] = fnote_(a1ll_2.nodur, &ivnext, &cnn[ivnext - 1],
c1ommvl_1.nacc);
-#line 19088 ""
+#line 19079 ""
if (cnn[ivnext - 1] == a1ll_2.nn[ivnext - 1]) {
-#line 19089 ""
+#line 19080 ""
xit[ivnext - 1] = 1e3f;
-#line 19090 ""
+#line 19081 ""
} else {
-#line 19091 ""
+#line 19082 ""
xit[ivnext - 1] += tnote[ilnc - 1];
-#line 19092 ""
+#line 19083 ""
}
-#line 19093 ""
+#line 19084 ""
++ilnc;
-#line 19094 ""
+#line 19085 ""
goto L5;
-#line 19095 ""
+#line 19086 ""
L7:
-#line 19096 ""
+#line 19087 ""
ntot = ilnc - 1;
-#line 19097 ""
+#line 19088 ""
if (ntot > 600) {
-#line 19098 ""
+#line 19089 ""
printl_(" ", (ftnlen)1);
-#line 19099 ""
+#line 19090 ""
printl_("Cannot have more than 600 notes per bar, stopping", (ftnlen)
49);
-#line 19100 ""
+#line 19091 ""
stop1_();
-#line 19101 ""
+#line 19092 ""
}
-#line 19102 ""
- i__2 = ntot - 1;
-#line 19102 ""
- for (in = 1; in <= i__2; ++in) {
-#line 19103 ""
+#line 19093 ""
+ i__1 = ntot - 1;
+#line 19093 ""
+ for (in = 1; in <= i__1; ++in) {
+#line 19094 ""
a1ll_2.tno[in - 1] = a1ll_2.to[in] - a1ll_2.to[in - 1];
-#line 19104 ""
+#line 19095 ""
/* L8: */
-#line 19104 ""
+#line 19095 ""
}
-#line 19105 ""
+#line 19096 ""
a1ll_2.tno[ntot - 1] = fnote_(a1ll_2.nodur, &a1ll_2.ivxo[ntot - 1], &
a1ll_2.ipo[ntot - 1], c1ommvl_1.nacc);
-#line 19106 ""
+#line 19097 ""
tnote[ntot - 1] = a1ll_2.tno[ntot - 1];
/* Debug writes */
@@ -45568,198 +45838,198 @@ L7:
/* Done w/ list. Initialize loop for building note blocks: */
-#line 19120 ""
+#line 19111 ""
ib = 1;
-#line 19121 ""
+#line 19112 ""
istart[0] = 1;
-#line 19122 ""
+#line 19113 ""
space[0] = 0.f;
-#line 19123 ""
+#line 19114 ""
in = 1;
/* Start the loop */
-#line 19127 ""
+#line 19118 ""
L9:
-#line 19128 ""
+#line 19119 ""
if (in == ntot) {
-#line 19129 ""
+#line 19120 ""
if (space[ib - 1] < comtol_1.tol) {
-#line 19130 ""
+#line 19121 ""
space[ib - 1] = a1ll_2.tno[in - 1];
/* Last gap in bar is spanned by a note, so cannot need a squeeze. */
-#line 19134 ""
+#line 19125 ""
squez[ib - 1] = 1.f;
-#line 19135 ""
+#line 19126 ""
}
-#line 19136 ""
+#line 19127 ""
istop[ib - 1] = ntot;
/* From here flow out of this if block and into block-setup */
-#line 19140 ""
+#line 19131 ""
} else if (space[ib - 1] < comtol_1.tol) {
/* space hasn't been set yet, so tentatively set: */
-#line 19144 ""
+#line 19135 ""
space[ib - 1] = a1ll_2.tno[in - 1];
-#line 19145 ""
+#line 19136 ""
if (space[ib - 1] < comtol_1.tol) {
-#line 19146 ""
+#line 19137 ""
++in;
-#line 19147 ""
+#line 19138 ""
} else {
/* Tentative space tno(in) is non-zero. Set squez, which will be kept (since */
/* it is a unique property of the particular increment starting here) : */
-#line 19152 ""
+#line 19143 ""
squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
a1ll_2.to);
-#line 19153 ""
+#line 19144 ""
istop[ib - 1] = in;
-#line 19154 ""
+#line 19145 ""
}
-#line 19155 ""
+#line 19146 ""
goto L9;
-#line 19156 ""
+#line 19147 ""
} else if (a1ll_2.tno[in] < comtol_1.tol) {
/* This is not the last note in the space, so */
-#line 19160 ""
+#line 19151 ""
++in;
-#line 19161 ""
+#line 19152 ""
goto L9;
-#line 19162 ""
+#line 19153 ""
} else if ((r__1 = a1ll_2.tno[in] - space[ib - 1], dabs(r__1)) <
comtol_1.tol) {
/* Next increment has same space. Does it have same squez? */
-#line 19166 ""
- i__2 = in + 1;
-#line 19166 ""
- xsquez = getsquez_(&i__2, &ntot, &space[ib - 1], tnote, a1ll_2.to);
+#line 19157 ""
+ i__1 = in + 1;
+#line 19157 ""
+ xsquez = getsquez_(&i__1, &ntot, &space[ib - 1], tnote, a1ll_2.to);
/* If it does have the same squez, loop, otherwise flow out */
-#line 19170 ""
+#line 19161 ""
if ((r__1 = xsquez - squez[ib - 1], dabs(r__1)) < comtol_1.tol) {
/* Keep spacing the same, update tentative stop point */
-#line 19174 ""
+#line 19165 ""
++in;
-#line 19175 ""
+#line 19166 ""
istop[ib - 1] = in;
-#line 19176 ""
+#line 19167 ""
goto L9;
-#line 19177 ""
+#line 19168 ""
}
-#line 19178 ""
+#line 19169 ""
}
/* At this point istart, istop, space, and squez are good, so close out block */
-#line 19182 ""
+#line 19173 ""
tstart[ib - 1] = a1ll_2.to[istart[ib - 1] - 1];
/* Compute elemskips assuming no flattening to increase min space. The formula */
/* is only correct if f1eon(t) = sqrt(t/2); more generally (after possible */
/* flattening in pmxb), elsperns = squez*feon(space/squez) */
-#line 19188 ""
+#line 19179 ""
r__1 = space[ib - 1] * squez[ib - 1];
-#line 19188 ""
+#line 19179 ""
elsperns = f1eon_(&r__1);
-#line 19189 ""
+#line 19180 ""
if (istop[ib - 1] == ntot) {
-#line 19190 ""
+#line 19181 ""
r__1 = (a1ll_2.lenbar - tstart[ib - 1]) / space[ib - 1];
-#line 19190 ""
+#line 19181 ""
nnsk = i_nint(&r__1);
-#line 19191 ""
+#line 19182 ""
} else {
-#line 19192 ""
+#line 19183 ""
r__1 = (a1ll_2.to[istop[ib - 1]] - tstart[ib - 1]) / space[ib - 1];
-#line 19192 ""
+#line 19183 ""
nnsk = i_nint(&r__1);
-#line 19193 ""
+#line 19184 ""
}
-#line 19194 ""
+#line 19185 ""
linecom_1.elskb += elsperns * nnsk;
-#line 19195 ""
+#line 19186 ""
if (c1omnotes_1.nptr[c1omnotes_1.ibarcnt] > c1omnotes_1.nptr[
c1omnotes_1.ibarcnt - 1]) {
-#line 19196 ""
+#line 19187 ""
catspace_(&space[ib - 1], &squez[ib - 1], &nnsk);
-#line 19197 ""
+#line 19188 ""
} else {
/* This is the first entry for this bar */
-#line 19201 ""
+#line 19192 ""
c1omnotes_1.nnpd[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
nnsk;
-#line 19202 ""
+#line 19193 ""
c1omnotes_1.durb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
space[ib - 1];
-#line 19203 ""
+#line 19194 ""
c1omnotes_1.sqzb[c1omnotes_1.nptr[c1omnotes_1.ibarcnt - 1] - 1] =
squez[ib - 1];
-#line 19204 ""
+#line 19195 ""
++c1omnotes_1.nptr[c1omnotes_1.ibarcnt];
-#line 19205 ""
+#line 19196 ""
}
/* Update minimum space spanned by a note */
-#line 19209 ""
+#line 19200 ""
if ((r__1 = squez[ib - 1] - 1, dabs(r__1)) < comtol_1.tol) {
/* Computing MIN */
-#line 19209 ""
+#line 19200 ""
r__2 = linecom_1.tnminb[c1omnotes_1.ibarcnt - 1], r__3 = space[ib - 1]
;
-#line 19209 ""
+#line 19200 ""
linecom_1.tnminb[c1omnotes_1.ibarcnt - 1] = dmin(r__2,r__3);
-#line 19209 ""
+#line 19200 ""
}
-#line 19211 ""
+#line 19202 ""
if (istop[ib - 1] == ntot) {
-#line 19211 ""
+#line 19202 ""
goto L15;
-#line 19211 ""
+#line 19202 ""
}
/* End of spatial accounting for now */
-#line 19215 ""
+#line 19206 ""
++ib;
-#line 19216 ""
+#line 19207 ""
istart[ib - 1] = istop[ib - 2] + 1;
-#line 19217 ""
+#line 19208 ""
in = istart[ib - 1];
/* Set tentative block space for new block */
-#line 19221 ""
+#line 19212 ""
space[ib - 1] = a1ll_2.tno[in - 1];
-#line 19222 ""
+#line 19213 ""
if (space[ib - 1] > comtol_1.tol) {
-#line 19222 ""
+#line 19213 ""
squez[ib - 1] = getsquez_(&in, &ntot, &space[ib - 1], tnote,
a1ll_2.to);
-#line 19222 ""
+#line 19213 ""
}
-#line 19224 ""
+#line 19215 ""
istop[ib - 1] = in;
-#line 19225 ""
+#line 19216 ""
goto L9;
-#line 19226 ""
+#line 19217 ""
L15:
/* nb = ib */
@@ -45770,7 +46040,7 @@ L15:
/* write(*,'(16f5.1)')(space(ib),ib=1,nb) */
/* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */
-#line 19236 ""
+#line 19227 ""
return 0;
} /* makeabar_ */
@@ -45800,129 +46070,129 @@ L15:
/* We now store "conductor" events in mmidi(numchan,.), and count bytes */
/* with imidi(numchan) */
-#line 19255 ""
+#line 19246 ""
i__1 = comevent_1.miditime - comevent_1.lasttime;
-#line 19255 ""
+#line 19246 ""
idur = isetvarlen_(&i__1, &nbytes);
-#line 19256 ""
+#line 19247 ""
commidi_1.imidi[commidi_1.numchan] = commidi_1.imidi[commidi_1.numchan] +
nbytes + 1;
-#line 19257 ""
+#line 19248 ""
i__1 = nbytes;
-#line 19257 ""
+#line 19248 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 19258 ""
+#line 19249 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] - i__) * 25 - 25] = (shortint) (idur % 256)
;
-#line 19259 ""
+#line 19250 ""
idur = lbit_shift(idur, (ftnlen)-8);
-#line 19260 ""
+#line 19251 ""
/* L1: */
-#line 19260 ""
+#line 19251 ""
}
-#line 19261 ""
+#line 19252 ""
commidi_1.mmidi[commidi_1.numchan + commidi_1.imidi[commidi_1.numchan] *
25 - 25] = 255;
-#line 19262 ""
+#line 19253 ""
if (*(unsigned char *)typeq == 't') {
/* Tempo event. in1 = quarters per minute (integer) */
-#line 19266 ""
+#line 19257 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 81;
-#line 19267 ""
+#line 19258 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 3;
-#line 19268 ""
+#line 19259 ""
r__1 = 6e7f / *in1;
-#line 19268 ""
+#line 19259 ""
misperq = i_nint(&r__1);
-#line 19269 ""
+#line 19260 ""
for (i__ = 1; i__ <= 3; ++i__) {
-#line 19270 ""
+#line 19261 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 6 - i__) * 25 - 25] = (shortint) (
misperq % 256);
-#line 19271 ""
+#line 19262 ""
misperq = lbit_shift(misperq, (ftnlen)-8);
-#line 19272 ""
+#line 19263 ""
/* L2: */
-#line 19272 ""
+#line 19263 ""
}
-#line 19273 ""
+#line 19264 ""
commidi_1.imidi[commidi_1.numchan] += 5;
-#line 19274 ""
+#line 19265 ""
} else if (*(unsigned char *)typeq == 'm') {
/* Meter event. in1=numerator, in2=denom (power of 2) */
-#line 19278 ""
+#line 19269 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 88;
-#line 19279 ""
+#line 19270 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 4;
-#line 19280 ""
+#line 19271 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 3) * 25 - 25] = (shortint) (*in1);
-#line 19281 ""
+#line 19272 ""
if (*in2 > 0) {
-#line 19282 ""
+#line 19273 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = (shortint) log2_(in2)
;
-#line 19283 ""
+#line 19274 ""
} else {
-#line 19284 ""
+#line 19275 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = 0;
-#line 19285 ""
+#line 19276 ""
}
-#line 19286 ""
+#line 19277 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 5) * 25 - 25] = 24;
-#line 19287 ""
+#line 19278 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 6) * 25 - 25] = 8;
-#line 19288 ""
+#line 19279 ""
commidi_1.imidi[commidi_1.numchan] += 6;
-#line 19289 ""
+#line 19280 ""
} else if (*(unsigned char *)typeq == 'k') {
/* Keychange event. in1 = isig */
-#line 19293 ""
+#line 19284 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 1) * 25 - 25] = 89;
-#line 19294 ""
+#line 19285 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 2) * 25 - 25] = 2;
-#line 19295 ""
+#line 19286 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 3) * 25 - 25] = (shortint) ((*in1 + 256)
% 256);
-#line 19296 ""
+#line 19287 ""
commidi_1.mmidi[commidi_1.numchan + (commidi_1.imidi[
commidi_1.numchan] + 4) * 25 - 25] = 0;
-#line 19297 ""
+#line 19288 ""
commidi_1.imidi[commidi_1.numchan] += 4;
-#line 19298 ""
+#line 19289 ""
} else {
-#line 19299 ""
+#line 19290 ""
s_wsle(&io___1176);
-#line 19299 ""
+#line 19290 ""
do_lio(&c__9, &c__1, "Program flameout in midievent", (ftnlen)29);
-#line 19299 ""
+#line 19290 ""
e_wsle();
-#line 19300 ""
+#line 19291 ""
stop1_();
-#line 19301 ""
+#line 19292 ""
}
-#line 19302 ""
+#line 19293 ""
comevent_1.lasttime = comevent_1.miditime;
-#line 19303 ""
+#line 19294 ""
return 0;
} /* midievent_ */
@@ -45945,51 +46215,51 @@ L15:
static cilist io___1180 = { 0, 0, 0, "(a)", 0 };
-#line 19308 ""
+#line 19299 ""
*done = FALSE_;
-#line 19309 ""
+#line 19300 ""
io___1177.ciunit = *iuin;
-#line 19309 ""
+#line 19300 ""
i__1 = s_rsfe(&io___1177);
-#line 19309 ""
+#line 19300 ""
if (i__1 != 0) {
-#line 19309 ""
+#line 19300 ""
goto L1;
-#line 19309 ""
+#line 19300 ""
}
-#line 19309 ""
+#line 19300 ""
i__1 = do_fio(&c__1, outq, (ftnlen)129);
-#line 19309 ""
+#line 19300 ""
if (i__1 != 0) {
-#line 19309 ""
+#line 19300 ""
goto L1;
-#line 19309 ""
+#line 19300 ""
}
-#line 19309 ""
+#line 19300 ""
i__1 = e_rsfe();
-#line 19309 ""
+#line 19300 ""
if (i__1 != 0) {
-#line 19309 ""
+#line 19300 ""
goto L1;
-#line 19309 ""
+#line 19300 ""
}
-#line 19310 ""
+#line 19301 ""
lenout = llen_(outq, &c__129, (ftnlen)129);
-#line 19311 ""
+#line 19302 ""
io___1180.ciunit = *iuout;
-#line 19311 ""
+#line 19302 ""
s_wsfe(&io___1180);
-#line 19311 ""
+#line 19302 ""
do_fio(&c__1, outq, lenout);
-#line 19311 ""
+#line 19302 ""
e_wsfe();
-#line 19312 ""
+#line 19303 ""
return 0;
-#line 19313 ""
+#line 19304 ""
L1:
-#line 19313 ""
+#line 19304 ""
*done = TRUE_;
-#line 19314 ""
+#line 19305 ""
return 0;
} /* moveln_ */
@@ -46009,55 +46279,55 @@ L1:
/* This is called when (a) macro recording is just starting and */
/* (b) at the start of a new line, if recording is on */
-#line 19330 ""
+#line 19321 ""
if (! commac_1.mrecord) {
/* Starting the macro */
-#line 19334 ""
+#line 19325 ""
c1ommac_1.ip1mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount;
-#line 19335 ""
+#line 19326 ""
c1ommac_1.il1mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
-#line 19336 ""
+#line 19327 ""
c1ommac_1.ic1mac[commac_1.macnum - 1] = *iccount;
-#line 19337 ""
+#line 19328 ""
commac_1.mrecord = TRUE_;
-#line 19338 ""
+#line 19329 ""
}
-#line 19339 ""
+#line 19330 ""
if (*iccount < 128) {
-#line 19340 ""
+#line 19331 ""
i__1 = *iccount;
-#line 19340 ""
+#line 19331 ""
*ndxm = i_indx(lineq + i__1, "M", 128 - i__1, (ftnlen)1);
-#line 19341 ""
+#line 19332 ""
if (*ndxm > 0) {
-#line 19341 ""
+#line 19332 ""
i__1 = *iccount;
-#line 19341 ""
+#line 19332 ""
i__2 = 128 - *iccount;
-#line 19341 ""
+#line 19332 ""
*ndxm = ntindex_(lineq + i__1, "M", &i__2, 128 - i__1, (ftnlen)1);
-#line 19341 ""
+#line 19332 ""
}
-#line 19343 ""
+#line 19334 ""
if (*ndxm > 0) {
/* This line ends the macro. */
-#line 19347 ""
+#line 19338 ""
c1ommac_1.ip2mac[commac_1.macnum - 1] = inbuff_1.ipbuf -
inbuff_1.lbuf[inbuff_1.ilbuf - 2] + *iccount + *ndxm;
-#line 19348 ""
+#line 19339 ""
c1ommac_1.il2mac[commac_1.macnum - 1] = inbuff_1.ilbuf - 1;
-#line 19349 ""
+#line 19340 ""
commac_1.mrecord = FALSE_;
-#line 19350 ""
+#line 19341 ""
}
-#line 19351 ""
+#line 19342 ""
}
-#line 19352 ""
+#line 19343 ""
return 0;
} /* mrec1_ */
@@ -46079,39 +46349,39 @@ integer ncmid_(integer *iv, integer *ip)
static cilist io___1183 = { 0, 6, 0, 0, 0 };
-#line 19372 ""
+#line 19363 ""
if (comcc_1.ncc[*iv - 1] == 1) {
-#line 19373 ""
+#line 19364 ""
ret_val = comcc_1.ncmidcc[*iv - 1];
-#line 19374 ""
+#line 19365 ""
} else {
-#line 19375 ""
+#line 19366 ""
xtime = all_2.to[comipl2_1.ipl2[commvl_1.ivx + *ip * 24 - 25] - 1];
-#line 19376 ""
+#line 19367 ""
for (icc = comcc_1.ncc[*iv - 1]; icc >= 1; --icc) {
-#line 19377 ""
+#line 19368 ""
if (xtime > comcc_1.tcc[*iv + icc * 24 - 25] - comtol_1.tol) {
-#line 19378 ""
+#line 19369 ""
ret_val = comcc_1.ncmidcc[*iv + icc * 24 - 25];
-#line 19379 ""
+#line 19370 ""
return ret_val;
-#line 19380 ""
+#line 19371 ""
}
-#line 19381 ""
+#line 19372 ""
/* L1: */
-#line 19381 ""
+#line 19372 ""
}
-#line 19382 ""
+#line 19373 ""
s_wsle(&io___1183);
-#line 19382 ""
+#line 19373 ""
do_lio(&c__9, &c__1, "Problem in ncmid()", (ftnlen)18);
-#line 19382 ""
+#line 19373 ""
e_wsle();
-#line 19383 ""
+#line 19374 ""
s_stop("", (ftnlen)0);
-#line 19384 ""
+#line 19375 ""
}
-#line 19385 ""
+#line 19376 ""
return ret_val;
} /* ncmid_ */
@@ -46126,21 +46396,21 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
/* Return middle line of a clef */
-#line 19391 ""
+#line 19382 ""
if (*(unsigned char *)clefq == '8') {
/* treblelowoct; will treat as treble for this purpose */
-#line 19395 ""
+#line 19386 ""
ret_val = 35;
-#line 19396 ""
+#line 19387 ""
} else {
-#line 19397 ""
+#line 19388 ""
ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) /
2 << 1) + 21;
-#line 19398 ""
+#line 19389 ""
}
-#line 19399 ""
+#line 19390 ""
return ret_val;
} /* ncmidf_ */
@@ -46150,60 +46420,60 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
static integer j;
extern integer ncmidf_(char *, ftnlen);
-#line 19422 ""
+#line 19413 ""
commvl_1.nvmx[*jv - 1] = 1;
-#line 19423 ""
+#line 19414 ""
commvl_1.ivmx[*jv - 1] = *jv;
-#line 19424 ""
+#line 19415 ""
all_1.itsofar[*jv - 1] = 0;
-#line 19425 ""
+#line 19416 ""
all_1.nnl[*jv - 1] = 0;
-#line 19426 ""
+#line 19417 ""
comfb_1.nfb[*jv - 1] = 0;
-#line 19427 ""
+#line 19418 ""
if (all_1.firstgulp || *change) {
-#line 19428 ""
+#line 19419 ""
comcc_1.ncmidcc[*jv - 1] = ncmidf_(clefq, (ftnlen)1);
-#line 19429 ""
+#line 19420 ""
} else {
-#line 19430 ""
+#line 19421 ""
comcc_1.ncmidcc[*jv - 1] = comcc_1.ncmidcc[*jv + comcc_1.ncc[*jv - 1]
* 24 - 25];
-#line 19431 ""
+#line 19422 ""
}
-#line 19432 ""
+#line 19423 ""
comcc_1.tcc[*jv - 1] = 0.f;
-#line 19433 ""
+#line 19424 ""
comcc_1.ncc[*jv - 1] = 1;
-#line 19434 ""
+#line 19425 ""
comudsp_1.nudoff[*jv - 1] = 0;
-#line 19435 ""
+#line 19426 ""
comcc_1.ndotmv[*jv - 1] = 0;
-#line 19436 ""
+#line 19427 ""
for (j = 1; j <= 200; ++j) {
-#line 19437 ""
+#line 19428 ""
all_1.irest[*jv + j * 24 - 25] = 0;
-#line 19438 ""
+#line 19429 ""
all_1.islur[*jv + j * 24 - 25] = 0;
-#line 19439 ""
+#line 19430 ""
all_1.ipl[*jv + j * 24 - 25] = 0;
-#line 19440 ""
+#line 19431 ""
all_1.nacc[*jv + j * 24 - 25] = 0;
-#line 19441 ""
+#line 19432 ""
all_1.iornq[*jv + j * 24 - 1] = 0;
-#line 19442 ""
+#line 19433 ""
all_1.mult[*jv + j * 24 - 25] = 0;
-#line 19443 ""
+#line 19434 ""
if (*jv <= 2) {
-#line 19443 ""
+#line 19434 ""
all_1.isfig[*jv + (j << 1) - 3] = FALSE_;
-#line 19443 ""
+#line 19434 ""
}
-#line 19444 ""
+#line 19435 ""
/* L5: */
-#line 19444 ""
+#line 19435 ""
}
-#line 19445 ""
+#line 19436 ""
return 0;
} /* newvoice_ */
@@ -46230,118 +46500,118 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
/* Returns name of note level with octave transpositions, updates noctup. */
-#line 19454 ""
+#line 19445 ""
nupfroma = (*nolev + 1) % 7;
-#line 19455 ""
+#line 19446 ""
iname = nupfroma + 97;
-#line 19456 ""
+#line 19447 ""
ioctup = (*nolev + 1) / 7 - 4;
-#line 19457 ""
+#line 19448 ""
chax_(ch__1, (ftnlen)1, &iname);
-#line 19457 ""
+#line 19448 ""
*(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
-#line 19458 ""
+#line 19449 ""
if (*ncmid == 23) {
-#line 19458 ""
+#line 19449 ""
upcaseq_(ch__1, (ftnlen)1, noteqt, (ftnlen)1);
-#line 19458 ""
+#line 19449 ""
*(unsigned char *)noteqt = *(unsigned char *)&ch__1[0];
-#line 19458 ""
+#line 19449 ""
}
-#line 19459 ""
+#line 19450 ""
if (ioctup == comoct_1.noctup) {
-#line 19460 ""
+#line 19451 ""
s_copy(noteq, noteqt, (ftnlen)8, (ftnlen)1);
-#line 19461 ""
+#line 19452 ""
*lnote = 1;
/* Must ALWAYS check if lnote=1 for use with functions requiring a blank */
-#line 19465 ""
+#line 19456 ""
} else if (ioctup > comoct_1.noctup) {
/* Raise octave. Encase in {} */
-#line 19469 ""
+#line 19460 ""
ici__1.icierr = 0;
-#line 19469 ""
+#line 19460 ""
ici__1.icirnum = 1;
-#line 19469 ""
+#line 19460 ""
ici__1.icirlen = 8;
-#line 19469 ""
+#line 19460 ""
ici__1.iciunit = noteq;
-#line 19469 ""
+#line 19460 ""
ici__1.icifmt = "(8a1)";
-#line 19469 ""
+#line 19460 ""
s_wsfi(&ici__1);
-#line 19469 ""
+#line 19460 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 19469 ""
+#line 19460 ""
i__1 = ioctup - 1;
-#line 19469 ""
+#line 19460 ""
for (i__ = comoct_1.noctup; i__ <= i__1; ++i__) {
-#line 19469 ""
+#line 19460 ""
chax_(ch__2, (ftnlen)1, &c__39);
-#line 19469 ""
+#line 19460 ""
*(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
-#line 19469 ""
+#line 19460 ""
do_fio(&c__1, ch__1, (ftnlen)1);
-#line 19469 ""
+#line 19460 ""
}
-#line 19469 ""
+#line 19460 ""
do_fio(&c__1, noteqt, (ftnlen)1);
-#line 19469 ""
+#line 19460 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 19469 ""
+#line 19460 ""
e_wsfi();
-#line 19471 ""
+#line 19462 ""
*lnote = ioctup + 3 - comoct_1.noctup;
-#line 19472 ""
+#line 19463 ""
comoct_1.noctup = ioctup;
-#line 19473 ""
+#line 19464 ""
} else {
/* Lower octave */
-#line 19477 ""
+#line 19468 ""
ici__1.icierr = 0;
-#line 19477 ""
+#line 19468 ""
ici__1.icirnum = 1;
-#line 19477 ""
+#line 19468 ""
ici__1.icirlen = 8;
-#line 19477 ""
+#line 19468 ""
ici__1.iciunit = noteq;
-#line 19477 ""
+#line 19468 ""
ici__1.icifmt = "(8a1)";
-#line 19477 ""
+#line 19468 ""
s_wsfi(&ici__1);
-#line 19477 ""
+#line 19468 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 19477 ""
+#line 19468 ""
i__1 = comoct_1.noctup - 1;
-#line 19477 ""
+#line 19468 ""
for (i__ = ioctup; i__ <= i__1; ++i__) {
-#line 19477 ""
+#line 19468 ""
chax_(ch__2, (ftnlen)1, &c__96);
-#line 19477 ""
+#line 19468 ""
*(unsigned char *)&ch__1[0] = *(unsigned char *)&ch__2[0];
-#line 19477 ""
+#line 19468 ""
do_fio(&c__1, ch__1, (ftnlen)1);
-#line 19477 ""
+#line 19468 ""
}
-#line 19477 ""
+#line 19468 ""
do_fio(&c__1, noteqt, (ftnlen)1);
-#line 19477 ""
+#line 19468 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 19477 ""
+#line 19468 ""
e_wsfi();
-#line 19479 ""
+#line 19470 ""
*lnote = comoct_1.noctup + 3 - ioctup;
-#line 19480 ""
+#line 19471 ""
comoct_1.noctup = ioctup;
-#line 19481 ""
+#line 19472 ""
}
-#line 19482 ""
+#line 19473 ""
return 0;
} /* notefq_ */
@@ -46393,971 +46663,971 @@ integer ncmidf_(char *clefq, ftnlen clefq_len)
/* Returns non-beamed full note name */
-#line 19512 ""
+#line 19503 ""
ip = all_1.ipo[all_1.jn - 1];
-#line 19513 ""
+#line 19504 ""
nole = all_1.nolev[commvl_1.ivx + ip * 24 - 25];
/* Check for special situations with 2nds (see precrd) */
-#line 19517 ""
+#line 19508 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],30)) {
-#line 19518 ""
+#line 19509 ""
--nole;
-#line 19519 ""
+#line 19510 ""
} else if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],31)) {
-#line 19520 ""
+#line 19511 ""
++nole;
-#line 19521 ""
+#line 19512 ""
}
-#line 19522 ""
+#line 19513 ""
nodu = all_1.nodur[commvl_1.ivx + ip * 24 - 25];
-#line 19523 ""
+#line 19514 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 19524 ""
+#line 19515 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 19524 ""
+#line 19515 ""
udqq_(ch__1, (ftnlen)1, &nole, &i__1, &all_1.islur[commvl_1.ivx + ip *
24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &
all_1.nv);
-#line 19524 ""
+#line 19515 ""
*(unsigned char *)udq = *(unsigned char *)&ch__1[0];
-#line 19526 ""
+#line 19517 ""
}
/* Check figure level */
/* if (figbass .and. isfig(ivx,ip) */
/* * .and. .not.btest(irest(ivx,ip),0)) then */
-#line 19532 ""
+#line 19523 ""
if (all_1.figbass && ! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],
0) && (commvl_1.ivx == 1 && all_1.isfig[(ip << 1) - 2] ||
commvl_1.ivx == comfig_1.ivxfig2 && all_1.isfig[(ip << 1) - 1])) {
-#line 19535 ""
+#line 19526 ""
if (*(unsigned char *)udq == 'u' || nodu >= 64) {
/* Upper or no stem, fnole (in noleunits) set by notehead */
-#line 19539 ""
+#line 19530 ""
fnole = (real) nole;
-#line 19540 ""
+#line 19531 ""
} else {
/* Lower stem, fnole set by bottom of stem */
-#line 19544 ""
+#line 19535 ""
fnole = nole - all_1.stemlen;
-#line 19545 ""
+#line 19536 ""
}
-#line 19546 ""
+#line 19537 ""
zmin = fnole - ncmid_(&commvl_1.ivx, &ip) + 4;
-#line 19547 ""
+#line 19538 ""
if (commvl_1.ivx == 1) {
/* Computing MAX */
-#line 19548 ""
+#line 19539 ""
r__1 = 4 - zmin;
-#line 19548 ""
+#line 19539 ""
i__1 = all_1.ifigdr[(all_1.iline << 1) - 2], i__2 = i_nint(&r__1);
-#line 19548 ""
+#line 19539 ""
all_1.ifigdr[(all_1.iline << 1) - 2] = max(i__1,i__2);
-#line 19549 ""
+#line 19540 ""
} else {
/* Computing MAX */
-#line 19550 ""
+#line 19541 ""
r__1 = 4 - zmin;
-#line 19550 ""
+#line 19541 ""
i__1 = all_1.ifigdr[(all_1.iline << 1) - 1], i__2 = i_nint(&r__1);
-#line 19550 ""
+#line 19541 ""
all_1.ifigdr[(all_1.iline << 1) - 1] = max(i__1,i__2);
-#line 19551 ""
+#line 19542 ""
}
-#line 19552 ""
+#line 19543 ""
}
-#line 19553 ""
+#line 19544 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 19554 ""
+#line 19545 ""
i__1 = ncmid_(&all_1.iv, &ip);
-#line 19554 ""
+#line 19545 ""
notefq_(noteq, &lnoten, &nole, &i__1, (ftnlen)8);
-#line 19555 ""
+#line 19546 ""
if (lnoten == 1) {
-#line 19555 ""
+#line 19546 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 19555 ""
+#line 19546 ""
}
-#line 19556 ""
+#line 19547 ""
if (nodu == 1) {
/* Writing concatenation */
-#line 19557 ""
+#line 19548 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19557 ""
+#line 19548 ""
i__3[1] = 4, a__1[1] = "cccc";
-#line 19557 ""
+#line 19548 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19557 ""
+#line 19548 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19557 ""
+#line 19548 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19558 ""
+#line 19549 ""
*lnote = lnoten + 6;
-#line 19559 ""
+#line 19550 ""
} else if (nodu == 2) {
/* Writing concatenation */
-#line 19560 ""
+#line 19551 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19560 ""
+#line 19551 ""
i__3[1] = 3, a__1[1] = "ccc";
-#line 19560 ""
+#line 19551 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19560 ""
+#line 19551 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19560 ""
+#line 19551 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19561 ""
+#line 19552 ""
*lnote = lnoten + 5;
-#line 19562 ""
+#line 19553 ""
} else if (nodu == 4) {
/* Writing concatenation */
-#line 19563 ""
+#line 19554 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19563 ""
+#line 19554 ""
i__3[1] = 2, a__1[1] = "cc";
-#line 19563 ""
+#line 19554 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19563 ""
+#line 19554 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19563 ""
+#line 19554 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19564 ""
+#line 19555 ""
*lnote = lnoten + 4;
-#line 19565 ""
+#line 19556 ""
} else if (nodu == 8) {
/* Writing concatenation */
-#line 19566 ""
+#line 19557 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19566 ""
+#line 19557 ""
i__3[1] = 1, a__1[1] = "c";
-#line 19566 ""
+#line 19557 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19566 ""
+#line 19557 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19566 ""
+#line 19557 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19567 ""
+#line 19558 ""
*lnote = lnoten + 3;
-#line 19568 ""
+#line 19559 ""
} else if (nodu == 16) {
/* Writing concatenation */
-#line 19569 ""
+#line 19560 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19569 ""
+#line 19560 ""
i__3[1] = 1, a__1[1] = "q";
-#line 19569 ""
+#line 19560 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19569 ""
+#line 19560 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19569 ""
+#line 19560 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19570 ""
+#line 19561 ""
*lnote = lnoten + 3;
-#line 19571 ""
+#line 19562 ""
} else if (nodu == 32) {
/* Writing concatenation */
-#line 19572 ""
+#line 19563 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19572 ""
+#line 19563 ""
i__3[1] = 1, a__1[1] = "h";
-#line 19572 ""
+#line 19563 ""
i__3[2] = 1, a__1[2] = udq;
-#line 19572 ""
+#line 19563 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19572 ""
+#line 19563 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19573 ""
+#line 19564 ""
*lnote = lnoten + 3;
-#line 19574 ""
+#line 19565 ""
} else if (nodu == 64) {
/* Writing concatenation */
-#line 19575 ""
+#line 19566 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 19575 ""
+#line 19566 ""
i__4[1] = 2, a__2[1] = "wh";
-#line 19575 ""
+#line 19566 ""
i__4[2] = lnoten, a__2[2] = noteq;
-#line 19575 ""
+#line 19566 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
-#line 19576 ""
+#line 19567 ""
*lnote = lnoten + 3;
-#line 19577 ""
+#line 19568 ""
} else if (nodu == 128) {
/* notexq =sq//'zbreve'//noteq(1:lnoten)//sq//'sk' */
/* lnote = lnoten+10 */
/* Writing concatenation */
-#line 19580 ""
+#line 19571 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 19580 ""
+#line 19571 ""
i__4[1] = 5, a__2[1] = "breve";
-#line 19580 ""
+#line 19571 ""
i__4[2] = lnoten, a__2[2] = noteq;
-#line 19580 ""
+#line 19571 ""
s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
-#line 19581 ""
+#line 19572 ""
*lnote = lnoten + 6;
-#line 19582 ""
+#line 19573 ""
} else {
-#line 19583 ""
+#line 19574 ""
s_copy(dotq, "p", (ftnlen)4, (ftnlen)1);
-#line 19584 ""
+#line 19575 ""
ldot = 1;
-#line 19585 ""
+#line 19576 ""
if (bit_test(all_1.iornq[commvl_1.ivx + ip * 24 - 1],13)) {
/* Dotted note with ')' ornament */
-#line 19589 ""
+#line 19580 ""
s_copy(dotq, "m", (ftnlen)4, (ftnlen)1);
-#line 19590 ""
+#line 19581 ""
} else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],3)) {
/* Double dot */
-#line 19594 ""
+#line 19585 ""
s_copy(dotq, "pp", (ftnlen)4, (ftnlen)2);
-#line 19595 ""
+#line 19586 ""
ldot = 2;
-#line 19596 ""
+#line 19587 ""
}
-#line 19597 ""
+#line 19588 ""
if (nodu >= 192) {
/* Writing concatenation */
-#line 19598 ""
+#line 19589 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19598 ""
+#line 19589 ""
i__3[1] = 5, a__1[1] = "breve";
-#line 19598 ""
+#line 19589 ""
i__3[2] = ldot, a__1[2] = dotq;
-#line 19598 ""
+#line 19589 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19598 ""
+#line 19589 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19599 ""
+#line 19590 ""
*lnote = lnoten + 6 + ldot;
-#line 19600 ""
+#line 19591 ""
} else if (nodu >= 96) {
/* Writing concatenation */
-#line 19601 ""
+#line 19592 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 19601 ""
+#line 19592 ""
i__3[1] = 2, a__1[1] = "wh";
-#line 19601 ""
+#line 19592 ""
i__3[2] = ldot, a__1[2] = dotq;
-#line 19601 ""
+#line 19592 ""
i__3[3] = lnoten, a__1[3] = noteq;
-#line 19601 ""
+#line 19592 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19602 ""
+#line 19593 ""
*lnote = lnoten + 3 + ldot;
-#line 19603 ""
+#line 19594 ""
} else if (nodu >= 48) {
/* Writing concatenation */
-#line 19604 ""
+#line 19595 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19604 ""
+#line 19595 ""
i__5[1] = 1, a__3[1] = "h";
-#line 19604 ""
+#line 19595 ""
i__5[2] = 1, a__3[2] = udq;
-#line 19604 ""
+#line 19595 ""
i__5[3] = ldot, a__3[3] = dotq;
-#line 19604 ""
+#line 19595 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 19604 ""
+#line 19595 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19605 ""
+#line 19596 ""
*lnote = lnoten + 3 + ldot;
-#line 19606 ""
+#line 19597 ""
} else if (nodu >= 24) {
/* Writing concatenation */
-#line 19607 ""
+#line 19598 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19607 ""
+#line 19598 ""
i__5[1] = 1, a__3[1] = "q";
-#line 19607 ""
+#line 19598 ""
i__5[2] = 1, a__3[2] = udq;
-#line 19607 ""
+#line 19598 ""
i__5[3] = ldot, a__3[3] = dotq;
-#line 19607 ""
+#line 19598 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 19607 ""
+#line 19598 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19608 ""
+#line 19599 ""
*lnote = lnoten + 3 + ldot;
-#line 19609 ""
+#line 19600 ""
} else if (nodu >= 12) {
/* Writing concatenation */
-#line 19610 ""
+#line 19601 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19610 ""
+#line 19601 ""
i__5[1] = 1, a__3[1] = "c";
-#line 19610 ""
+#line 19601 ""
i__5[2] = 1, a__3[2] = udq;
-#line 19610 ""
+#line 19601 ""
i__5[3] = ldot, a__3[3] = dotq;
-#line 19610 ""
+#line 19601 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 19610 ""
+#line 19601 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19611 ""
+#line 19602 ""
*lnote = lnoten + 3 + ldot;
-#line 19612 ""
+#line 19603 ""
} else if (nodu >= 6) {
/* Writing concatenation */
-#line 19613 ""
+#line 19604 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19613 ""
+#line 19604 ""
i__5[1] = 2, a__3[1] = "cc";
-#line 19613 ""
+#line 19604 ""
i__5[2] = 1, a__3[2] = udq;
-#line 19613 ""
+#line 19604 ""
i__5[3] = ldot, a__3[3] = dotq;
-#line 19613 ""
+#line 19604 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 19613 ""
+#line 19604 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19614 ""
+#line 19605 ""
*lnote = lnoten + 4 + ldot;
-#line 19615 ""
+#line 19606 ""
compoi_1.ispoi = TRUE_;
-#line 19616 ""
+#line 19607 ""
} else {
/* Writing concatenation */
-#line 19617 ""
+#line 19608 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19617 ""
+#line 19608 ""
i__5[1] = 3, a__3[1] = "ccc";
-#line 19617 ""
+#line 19608 ""
i__5[2] = 1, a__3[2] = udq;
-#line 19617 ""
+#line 19608 ""
i__5[3] = ldot, a__3[3] = dotq;
-#line 19617 ""
+#line 19608 ""
i__5[4] = lnoten, a__3[4] = noteq;
-#line 19617 ""
+#line 19608 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19618 ""
+#line 19609 ""
*lnote = lnoten + 5 + ldot;
-#line 19619 ""
+#line 19610 ""
compoi_1.ispoi = TRUE_;
-#line 19620 ""
+#line 19611 ""
}
-#line 19621 ""
+#line 19612 ""
if (*(unsigned char *)dotq == 'm') {
/* Need another call to the note, in case the first one has octave shifts */
-#line 19625 ""
+#line 19616 ""
if (lnoten == 2) {
/* Writing concatenation */
-#line 19626 ""
+#line 19617 ""
i__3[0] = *lnote, a__1[0] = notexq;
-#line 19626 ""
+#line 19617 ""
i__3[1] = 1, a__1[1] = "{";
-#line 19626 ""
+#line 19617 ""
i__3[2] = 1, a__1[2] = noteq + 1;
-#line 19626 ""
+#line 19617 ""
i__3[3] = 1, a__1[3] = "}";
-#line 19626 ""
+#line 19617 ""
s_cat(notexq, a__1, i__3, &c__4, (ftnlen)79);
-#line 19627 ""
+#line 19618 ""
*lnote += 3;
-#line 19628 ""
+#line 19619 ""
} else {
-#line 19629 ""
+#line 19620 ""
i__1 = lnoten - 2;
/* Writing concatenation */
-#line 19629 ""
+#line 19620 ""
i__6[0] = *lnote, a__4[0] = notexq;
-#line 19629 ""
+#line 19620 ""
i__6[1] = lnoten - 1 - i__1, a__4[1] = noteq + i__1;
-#line 19629 ""
+#line 19620 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19630 ""
+#line 19621 ""
++(*lnote);
-#line 19631 ""
+#line 19622 ""
}
-#line 19632 ""
+#line 19623 ""
}
-#line 19633 ""
+#line 19624 ""
}
-#line 19634 ""
+#line 19625 ""
} else if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],29)) {
/* Blank rest */
/* Writing concatenation */
-#line 19638 ""
+#line 19629 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19638 ""
+#line 19629 ""
i__6[1] = 2, a__4[1] = "sk";
-#line 19638 ""
+#line 19629 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19639 ""
+#line 19630 ""
*lnote = 3;
-#line 19640 ""
+#line 19631 ""
} else {
/* Non-blank rest */
-#line 19644 ""
+#line 19635 ""
*lnote = 0;
-#line 19645 ""
+#line 19636 ""
nole = (nole + 20) % 100 - 20;
/* Kluge to get pause symbol for rp: */
-#line 19649 ""
+#line 19640 ""
if (bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],19)) {
-#line 19649 ""
+#line 19640 ""
nodu = 64;
-#line 19649 ""
+#line 19640 ""
}
-#line 19650 ""
+#line 19641 ""
if (nodu <= 28) {
/* Normal rest < or = double-dotted quarter */
-#line 19654 ""
+#line 19645 ""
lrest = 3;
-#line 19655 ""
+#line 19646 ""
if (nodu > 14) {
/* Writing concatenation */
-#line 19656 ""
+#line 19647 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19656 ""
+#line 19647 ""
i__6[1] = 2, a__4[1] = "qp";
-#line 19656 ""
+#line 19647 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19657 ""
+#line 19648 ""
} else if (nodu > 7) {
/* Writing concatenation */
-#line 19658 ""
+#line 19649 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19658 ""
+#line 19649 ""
i__6[1] = 2, a__4[1] = "ds";
-#line 19658 ""
+#line 19649 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19659 ""
+#line 19650 ""
} else if (nodu > 3) {
/* Writing concatenation */
-#line 19660 ""
+#line 19651 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19660 ""
+#line 19651 ""
i__6[1] = 2, a__4[1] = "qs";
-#line 19660 ""
+#line 19651 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19661 ""
+#line 19652 ""
} else if (nodu > 1) {
/* Writing concatenation */
-#line 19662 ""
+#line 19653 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19662 ""
+#line 19653 ""
i__6[1] = 2, a__4[1] = "hs";
-#line 19662 ""
+#line 19653 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19663 ""
+#line 19654 ""
} else {
/* Writing concatenation */
-#line 19664 ""
+#line 19655 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19664 ""
+#line 19655 ""
i__6[1] = 3, a__4[1] = "qqs";
-#line 19664 ""
+#line 19655 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19665 ""
+#line 19656 ""
lrest = 4;
-#line 19666 ""
+#line 19657 ""
}
/* Special case for rest at start of F-tuplet inside a forced beam */
-#line 19670 ""
+#line 19661 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18) &&
bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],19)) {
/* Writing concatenation */
-#line 19672 ""
+#line 19663 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 19672 ""
+#line 19663 ""
i__4[1] = 3, a__2[1] = "pt4";
-#line 19672 ""
+#line 19663 ""
i__4[2] = lrest, a__2[2] = restq;
-#line 19672 ""
+#line 19663 ""
s_cat(restq, a__2, i__4, &c__3, (ftnlen)40);
-#line 19673 ""
+#line 19664 ""
lrest += 4;
-#line 19674 ""
+#line 19665 ""
}
-#line 19675 ""
+#line 19666 ""
s_copy(notexq, restq, (ftnlen)79, (ftnlen)40);
-#line 19676 ""
+#line 19667 ""
*lnote = lrest;
/* At this point notexq=restq,lnote=lrest are name of rest. Now raise if necc. */
-#line 19680 ""
+#line 19671 ""
if (nole != 0) {
-#line 19681 ""
+#line 19672 ""
if (abs(nole) < 10) {
-#line 19682 ""
+#line 19673 ""
i__1 = abs(nole) + 48;
-#line 19682 ""
+#line 19673 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 19682 ""
+#line 19673 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
-#line 19683 ""
+#line 19674 ""
lnoten = 1;
-#line 19684 ""
+#line 19675 ""
} else {
-#line 19685 ""
+#line 19676 ""
s_wsfi(&io___1202);
-#line 19685 ""
+#line 19676 ""
i__1 = abs(nole);
-#line 19685 ""
+#line 19676 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 19685 ""
+#line 19676 ""
e_wsfi();
-#line 19686 ""
+#line 19677 ""
lnoten = 2;
-#line 19687 ""
+#line 19678 ""
}
-#line 19688 ""
+#line 19679 ""
if (nole > 0) {
/* Writing concatenation */
-#line 19689 ""
+#line 19680 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19689 ""
+#line 19680 ""
i__5[1] = 5, a__3[1] = "raise";
-#line 19689 ""
+#line 19680 ""
i__5[2] = lnoten, a__3[2] = noteq;
-#line 19689 ""
+#line 19680 ""
i__5[3] = 1, a__3[3] = all_1.sq;
-#line 19689 ""
+#line 19680 ""
i__5[4] = 9, a__3[4] = "internote";
-#line 19689 ""
+#line 19680 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19690 ""
+#line 19681 ""
} else {
/* Writing concatenation */
-#line 19691 ""
+#line 19682 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 19691 ""
+#line 19682 ""
i__5[1] = 5, a__3[1] = "lower";
-#line 19691 ""
+#line 19682 ""
i__5[2] = lnoten, a__3[2] = noteq;
-#line 19691 ""
+#line 19682 ""
i__5[3] = 1, a__3[3] = all_1.sq;
-#line 19691 ""
+#line 19682 ""
i__5[4] = 9, a__3[4] = "internote";
-#line 19691 ""
+#line 19682 ""
s_cat(notexq, a__3, i__5, &c__5, (ftnlen)79);
-#line 19692 ""
+#line 19683 ""
}
-#line 19693 ""
+#line 19684 ""
*lnote = lnoten + 16;
/* Writing concatenation */
-#line 19694 ""
+#line 19685 ""
i__6[0] = *lnote, a__4[0] = notexq;
-#line 19694 ""
+#line 19685 ""
i__6[1] = lrest, a__4[1] = restq;
-#line 19694 ""
+#line 19685 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19695 ""
+#line 19686 ""
*lnote += lrest;
-#line 19696 ""
+#line 19687 ""
}
-#line 19697 ""
+#line 19688 ""
i__1 = log2_(&nodu);
-#line 19697 ""
+#line 19688 ""
if (pow_ii(&c__2, &i__1) != nodu) {
/* Deal with dots (on rests shorter than half rest) */
/* Writing concatenation */
-#line 19701 ""
+#line 19692 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19701 ""
+#line 19692 ""
i__6[1] = 2, a__4[1] = "pt";
-#line 19701 ""
+#line 19692 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19702 ""
+#line 19693 ""
lrest = 3;
-#line 19703 ""
+#line 19694 ""
i__1 = log2_(&nodu);
-#line 19703 ""
+#line 19694 ""
if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
/* Writing concatenation */
-#line 19704 ""
+#line 19695 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19704 ""
+#line 19695 ""
i__6[1] = 3, a__4[1] = "ppt";
-#line 19704 ""
+#line 19695 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19705 ""
+#line 19696 ""
lrest = 4;
-#line 19706 ""
+#line 19697 ""
}
-#line 19707 ""
+#line 19698 ""
nole += 4;
-#line 19708 ""
+#line 19699 ""
raisedot = 0.f;
/* Tweak dot positions for special cases */
-#line 19712 ""
+#line 19703 ""
even = (nole + 100) % 2 == 0;
/* if (.not.even.and.nodu.gt.8.and. */
/* * (nole.lt.0.or.nole.gt.8)) then */
-#line 19715 ""
+#line 19706 ""
if (! even && (nole < 0 || nole > 8)) {
-#line 19716 ""
+#line 19707 ""
raisedot = 1.f;
-#line 19717 ""
+#line 19708 ""
}
-#line 19718 ""
+#line 19709 ""
if (nole >= 10 || nole <= -1) {
-#line 19719 ""
+#line 19710 ""
s_wsfi(&io___1206);
-#line 19719 ""
+#line 19710 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
-#line 19719 ""
+#line 19710 ""
e_wsfi();
/* Writing concatenation */
-#line 19720 ""
+#line 19711 ""
i__3[0] = lrest, a__1[0] = restq;
-#line 19720 ""
+#line 19711 ""
i__3[1] = 1, a__1[1] = "{";
-#line 19720 ""
+#line 19711 ""
i__3[2] = 2, a__1[2] = numq;
-#line 19720 ""
+#line 19711 ""
i__3[3] = 1, a__1[3] = "}";
-#line 19720 ""
+#line 19711 ""
s_cat(restq, a__1, i__3, &c__4, (ftnlen)40);
-#line 19721 ""
+#line 19712 ""
lrest += 4;
-#line 19722 ""
+#line 19713 ""
} else {
/* Writing concatenation */
-#line 19723 ""
+#line 19714 ""
i__6[0] = lrest, a__4[0] = restq;
-#line 19723 ""
+#line 19714 ""
i__1 = nole + 48;
-#line 19723 ""
+#line 19714 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 19723 ""
+#line 19714 ""
i__6[1] = 1, a__4[1] = ch__1;
-#line 19723 ""
+#line 19714 ""
s_cat(restq, a__4, i__6, &c__2, (ftnlen)40);
-#line 19724 ""
+#line 19715 ""
++lrest;
-#line 19725 ""
+#line 19716 ""
}
-#line 19726 ""
+#line 19717 ""
if (raisedot > 0.f) {
/* Writing concatenation */
-#line 19727 ""
+#line 19718 ""
i__7[0] = 1, a__5[0] = all_1.sq;
-#line 19727 ""
+#line 19718 ""
i__7[1] = 5, a__5[1] = "raise";
-#line 19727 ""
+#line 19718 ""
i__7[2] = 1, a__5[2] = all_1.sq;
-#line 19727 ""
+#line 19718 ""
i__7[3] = 9, a__5[3] = "internote";
-#line 19727 ""
+#line 19718 ""
i__7[4] = 1, a__5[4] = all_1.sq;
-#line 19727 ""
+#line 19718 ""
i__7[5] = 5, a__5[5] = "hbox{";
-#line 19727 ""
+#line 19718 ""
i__7[6] = lrest, a__5[6] = restq;
-#line 19727 ""
+#line 19718 ""
i__7[7] = 1, a__5[7] = "}";
-#line 19727 ""
+#line 19718 ""
s_cat(restq, a__5, i__7, &c__8, (ftnlen)40);
-#line 19729 ""
+#line 19720 ""
lrest += 23;
-#line 19730 ""
+#line 19721 ""
}
/* Writing concatenation */
-#line 19731 ""
+#line 19722 ""
i__6[0] = lrest, a__4[0] = restq;
-#line 19731 ""
+#line 19722 ""
i__6[1] = *lnote, a__4[1] = notexq;
-#line 19731 ""
+#line 19722 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19732 ""
+#line 19723 ""
*lnote += lrest;
-#line 19733 ""
+#line 19724 ""
}
-#line 19734 ""
+#line 19725 ""
} else {
/* Half rest or longer */
-#line 19738 ""
+#line 19729 ""
if (nole == 0) {
/* Half or longer rest is not raised or lowered */
-#line 19742 ""
+#line 19733 ""
if (nodu <= 56) {
/* Writing concatenation */
-#line 19743 ""
+#line 19734 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19743 ""
+#line 19734 ""
i__6[1] = 6, a__4[1] = "hpause";
-#line 19743 ""
+#line 19734 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19744 ""
+#line 19735 ""
*lnote = 7;
-#line 19745 ""
+#line 19736 ""
} else if (nodu <= 112) {
-#line 19746 ""
+#line 19737 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ip * 24 - 25],
19) || bit_test(all_1.irest[commvl_1.ivx + ip *
24 - 25],25)) {
/* Writing concatenation */
-#line 19748 ""
+#line 19739 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19748 ""
+#line 19739 ""
i__6[1] = 5, a__4[1] = "pause";
-#line 19748 ""
+#line 19739 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19749 ""
+#line 19740 ""
} else {
/* Writing concatenation */
-#line 19750 ""
+#line 19741 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19750 ""
+#line 19741 ""
i__6[1] = 5, a__4[1] = "pausc";
-#line 19750 ""
+#line 19741 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19751 ""
+#line 19742 ""
}
-#line 19752 ""
+#line 19743 ""
*lnote = 6;
-#line 19753 ""
+#line 19744 ""
} else {
/* Writing concatenation */
-#line 19754 ""
+#line 19745 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19754 ""
+#line 19745 ""
i__6[1] = 5, a__4[1] = "PAuse";
-#line 19754 ""
+#line 19745 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19755 ""
+#line 19746 ""
*lnote = 6;
-#line 19756 ""
+#line 19747 ""
}
-#line 19757 ""
+#line 19748 ""
i__1 = log2_(&nodu);
-#line 19757 ""
+#line 19748 ""
if (pow_ii(&c__2, &i__1) != nodu) {
/* Dotted rest, hpause or longer */
/* Writing concatenation */
-#line 19761 ""
+#line 19752 ""
i__6[0] = *lnote, a__4[0] = notexq;
-#line 19761 ""
+#line 19752 ""
i__6[1] = 1, a__4[1] = "p";
-#line 19761 ""
+#line 19752 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19762 ""
+#line 19753 ""
++(*lnote);
-#line 19763 ""
+#line 19754 ""
i__1 = log2_(&nodu);
-#line 19763 ""
+#line 19754 ""
if (nodu << 1 > pow_ii(&c__2, &i__1) * 3) {
/* Double dotted long rest */
/* Writing concatenation */
-#line 19767 ""
+#line 19758 ""
i__6[0] = *lnote, a__4[0] = notexq;
-#line 19767 ""
+#line 19758 ""
i__6[1] = 1, a__4[1] = "p";
-#line 19767 ""
+#line 19758 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19768 ""
+#line 19759 ""
++(*lnote);
-#line 19769 ""
+#line 19760 ""
}
-#line 19770 ""
+#line 19761 ""
}
-#line 19771 ""
+#line 19762 ""
} else {
/* Raised or lowered half or whole rest */
-#line 19775 ""
+#line 19766 ""
if (nodu == 32) {
/* Writing concatenation */
-#line 19776 ""
+#line 19767 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19776 ""
+#line 19767 ""
i__6[1] = 10, a__4[1] = "lifthpause";
-#line 19776 ""
+#line 19767 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19777 ""
+#line 19768 ""
*lnote = 11;
-#line 19778 ""
+#line 19769 ""
} else if (nodu == 48) {
/* Writing concatenation */
-#line 19779 ""
+#line 19770 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19779 ""
+#line 19770 ""
i__6[1] = 11, a__4[1] = "lifthpausep";
-#line 19779 ""
+#line 19770 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19780 ""
+#line 19771 ""
*lnote = 12;
-#line 19781 ""
+#line 19772 ""
} else if (nodu == 56) {
/* Writing concatenation */
-#line 19782 ""
+#line 19773 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19782 ""
+#line 19773 ""
i__6[1] = 12, a__4[1] = "lifthpausepp";
-#line 19782 ""
+#line 19773 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19783 ""
+#line 19774 ""
*lnote = 13;
-#line 19784 ""
+#line 19775 ""
} else if (nodu == 64) {
/* Writing concatenation */
-#line 19785 ""
+#line 19776 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19785 ""
+#line 19776 ""
i__6[1] = 9, a__4[1] = "liftpause";
-#line 19785 ""
+#line 19776 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19786 ""
+#line 19777 ""
*lnote = 10;
-#line 19787 ""
+#line 19778 ""
} else if (nodu == 96) {
/* Writing concatenation */
-#line 19788 ""
+#line 19779 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19788 ""
+#line 19779 ""
i__6[1] = 10, a__4[1] = "liftpausep";
-#line 19788 ""
+#line 19779 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19789 ""
+#line 19780 ""
*lnote = 11;
-#line 19790 ""
+#line 19781 ""
} else if (nodu == 112) {
/* Writing concatenation */
-#line 19791 ""
+#line 19782 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19791 ""
+#line 19782 ""
i__6[1] = 11, a__4[1] = "liftpausepp";
-#line 19791 ""
+#line 19782 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19792 ""
+#line 19783 ""
*lnote = 12;
-#line 19793 ""
+#line 19784 ""
} else if (nodu == 128) {
/* Writing concatenation */
-#line 19794 ""
+#line 19785 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19794 ""
+#line 19785 ""
i__6[1] = 9, a__4[1] = "liftPAuse";
-#line 19794 ""
+#line 19785 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19795 ""
+#line 19786 ""
*lnote = 10;
-#line 19796 ""
+#line 19787 ""
} else {
/* Assume dotted double whole rest */
/* Writing concatenation */
-#line 19800 ""
+#line 19791 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 19800 ""
+#line 19791 ""
i__6[1] = 10, a__4[1] = "liftPAusep";
-#line 19800 ""
+#line 19791 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19801 ""
+#line 19792 ""
*lnote = 11;
-#line 19802 ""
+#line 19793 ""
}
/* Set up height spec */
-#line 19806 ""
+#line 19797 ""
i__1 = abs(nole) / 2;
-#line 19806 ""
+#line 19797 ""
nole = i_sign(&i__1, &nole);
-#line 19807 ""
+#line 19798 ""
if (nole <= 9 && nole >= 0) {
-#line 19808 ""
+#line 19799 ""
i__1 = nole + 48;
-#line 19808 ""
+#line 19799 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 19808 ""
+#line 19799 ""
s_copy(noteq, ch__1, (ftnlen)8, (ftnlen)1);
-#line 19809 ""
+#line 19800 ""
lnoten = 1;
-#line 19810 ""
+#line 19801 ""
} else {
-#line 19811 ""
+#line 19802 ""
s_copy(noteq, "{", (ftnlen)8, (ftnlen)1);
-#line 19812 ""
+#line 19803 ""
if (nole >= -9) {
-#line 19813 ""
+#line 19804 ""
s_wsfi(&io___1207);
-#line 19813 ""
+#line 19804 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
-#line 19813 ""
+#line 19804 ""
e_wsfi();
-#line 19814 ""
+#line 19805 ""
lnoten = 3;
-#line 19815 ""
+#line 19806 ""
} else {
-#line 19816 ""
+#line 19807 ""
s_wsfi(&io___1208);
-#line 19816 ""
+#line 19807 ""
do_fio(&c__1, (char *)&nole, (ftnlen)sizeof(integer));
-#line 19816 ""
+#line 19807 ""
e_wsfi();
-#line 19817 ""
+#line 19808 ""
lnoten = 4;
-#line 19818 ""
+#line 19809 ""
}
/* Writing concatenation */
-#line 19819 ""
+#line 19810 ""
i__6[0] = lnoten, a__4[0] = noteq;
-#line 19819 ""
+#line 19810 ""
i__6[1] = 1, a__4[1] = "}";
-#line 19819 ""
+#line 19810 ""
s_cat(noteq, a__4, i__6, &c__2, (ftnlen)8);
-#line 19820 ""
+#line 19811 ""
++lnoten;
-#line 19821 ""
+#line 19812 ""
}
/* Writing concatenation */
-#line 19822 ""
+#line 19813 ""
i__6[0] = *lnote, a__4[0] = notexq;
-#line 19822 ""
+#line 19813 ""
i__6[1] = lnoten, a__4[1] = noteq;
-#line 19822 ""
+#line 19813 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 19823 ""
+#line 19814 ""
*lnote += lnoten;
-#line 19824 ""
+#line 19815 ""
}
-#line 19825 ""
+#line 19816 ""
}
-#line 19826 ""
+#line 19817 ""
}
-#line 19827 ""
+#line 19818 ""
return 0;
} /* notex_ */
@@ -47384,98 +47654,98 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
/* Returns index(line,s2q) if NOT in TeX string, 0 otherwise */
-#line 19836 ""
+#line 19827 ""
ndxs2 = i_indx(line, s2q, line_len, s2q_len);
-#line 19837 ""
+#line 19828 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 19837 ""
+#line 19828 ""
ndxbs = i_indx(line, ch__1, line_len, (ftnlen)1);
-#line 19838 ""
+#line 19829 ""
if (ndxbs == 0 || ndxs2 < ndxbs) {
-#line 19839 ""
+#line 19830 ""
ret_val = ndxs2;
-#line 19840 ""
+#line 19831 ""
} else {
/* There are both bs and s2q, and bs is to the left of sq2. So check bs's to */
/* right of first: End is '\ ', start is ' \' */
-#line 19845 ""
+#line 19836 ""
len = lenstr_(line, lenline, line_len);
-#line 19846 ""
+#line 19837 ""
intex = TRUE_;
-#line 19847 ""
+#line 19838 ""
i__1 = len;
-#line 19847 ""
+#line 19838 ""
for (ic = ndxbs + 1; ic <= i__1; ++ic) {
-#line 19848 ""
+#line 19839 ""
if (ic == ndxs2) {
-#line 19849 ""
+#line 19840 ""
if (intex) {
-#line 19850 ""
+#line 19841 ""
ret_val = 0;
-#line 19851 ""
+#line 19842 ""
i__2 = ic;
-#line 19851 ""
+#line 19842 ""
ndxs2 = i_indx(line + i__2, s2q, len - i__2, s2q_len) +
ic;
-#line 19852 ""
+#line 19843 ""
} else {
-#line 19853 ""
+#line 19844 ""
ret_val = ndxs2;
-#line 19854 ""
+#line 19845 ""
return ret_val;
-#line 19855 ""
+#line 19846 ""
}
-#line 19856 ""
+#line 19847 ""
} else /* if(complicated condition) */ {
-#line 19856 ""
+#line 19847 ""
i__2 = ic;
/* Writing concatenation */
-#line 19856 ""
+#line 19847 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 19856 ""
+#line 19847 ""
i__3[0] = 1, a__1[0] = ch__1;
-#line 19856 ""
+#line 19847 ""
i__3[1] = 1, a__1[1] = " ";
-#line 19856 ""
+#line 19847 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
-#line 19856 ""
+#line 19847 ""
if (intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (ftnlen)
2) == 0) {
-#line 19857 ""
+#line 19848 ""
intex = FALSE_;
-#line 19858 ""
+#line 19849 ""
} else /* if(complicated condition) */ {
-#line 19858 ""
+#line 19849 ""
i__2 = ic;
/* Writing concatenation */
-#line 19858 ""
+#line 19849 ""
i__3[0] = 1, a__1[0] = " ";
-#line 19858 ""
+#line 19849 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 19858 ""
+#line 19849 ""
i__3[1] = 1, a__1[1] = ch__1;
-#line 19858 ""
+#line 19849 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)2);
-#line 19858 ""
+#line 19849 ""
if (! intex && s_cmp(line + i__2, ch__2, ic + 2 - i__2, (
ftnlen)2) == 0) {
-#line 19860 ""
+#line 19851 ""
intex = TRUE_;
-#line 19861 ""
+#line 19852 ""
}
-#line 19861 ""
+#line 19852 ""
}
-#line 19861 ""
+#line 19852 ""
}
-#line 19862 ""
+#line 19853 ""
/* L1: */
-#line 19862 ""
+#line 19853 ""
}
-#line 19863 ""
+#line 19854 ""
}
-#line 19864 ""
+#line 19855 ""
return ret_val;
} /* ntindex_ */
@@ -47502,56 +47772,56 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
/* This appends to notexq e.g. '\ibbbu1' */
-#line 19875 ""
+#line 19866 ""
if (*n >= 5) {
-#line 19875 ""
+#line 19866 ""
combbm_1.isbbm = TRUE_;
-#line 19875 ""
+#line 19866 ""
}
-#line 19876 ""
+#line 19867 ""
if (*lnote > 0) {
/* Writing concatenation */
-#line 19877 ""
+#line 19868 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 19877 ""
+#line 19868 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 19877 ""
+#line 19868 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 19877 ""
+#line 19868 ""
i__1[2] = 1, a__1[2] = char1q;
-#line 19877 ""
+#line 19868 ""
s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
-#line 19878 ""
+#line 19869 ""
} else {
/* Writing concatenation */
-#line 19879 ""
+#line 19870 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 19879 ""
+#line 19870 ""
i__2[0] = 1, a__2[0] = ch__1;
-#line 19879 ""
+#line 19870 ""
i__2[1] = 1, a__2[1] = char1q;
-#line 19879 ""
+#line 19870 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 19880 ""
+#line 19871 ""
}
-#line 19881 ""
+#line 19872 ""
*lnote += 2;
-#line 19882 ""
+#line 19873 ""
i__3 = *n;
-#line 19882 ""
+#line 19873 ""
for (im = 1; im <= i__3; ++im) {
/* Writing concatenation */
-#line 19883 ""
+#line 19874 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 19883 ""
+#line 19874 ""
i__2[1] = 1, a__2[1] = "b";
-#line 19883 ""
+#line 19874 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)79);
-#line 19884 ""
+#line 19875 ""
++(*lnote);
-#line 19885 ""
+#line 19876 ""
/* L3: */
-#line 19885 ""
+#line 19876 ""
}
/* add the number, 0 if 12 */
@@ -47559,36 +47829,36 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len,
/* 5/25/08 Allow >12 */
/* call istring(mod(iv,12),tempq,len) */
-#line 19892 ""
+#line 19883 ""
if (*iv < 24) {
-#line 19893 ""
+#line 19884 ""
istring_(iv, tempq, &len, (ftnlen)4);
-#line 19894 ""
+#line 19885 ""
} else if (*iv == 24) {
-#line 19895 ""
+#line 19886 ""
*(unsigned char *)tempq = '0';
-#line 19896 ""
+#line 19887 ""
len = 1;
-#line 19897 ""
+#line 19888 ""
} else {
-#line 19898 ""
+#line 19889 ""
printl_("Sorry, too man open beams", (ftnlen)25);
-#line 19899 ""
+#line 19890 ""
stop1_();
-#line 19900 ""
+#line 19891 ""
}
/* Writing concatenation */
-#line 19901 ""
+#line 19892 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 19901 ""
+#line 19892 ""
i__1[1] = 1, a__1[1] = ulqq;
-#line 19901 ""
+#line 19892 ""
i__1[2] = len, a__1[2] = tempq;
-#line 19901 ""
+#line 19892 ""
s_cat(notexq, a__1, i__1, &c__3, (ftnlen)79);
-#line 19902 ""
+#line 19893 ""
*lnote = *lnote + 1 + len;
-#line 19903 ""
+#line 19894 ""
return 0;
} /* ntrbbb_ */
@@ -47606,27 +47876,27 @@ integer numclef_(char *clefq, ftnlen clefq_len)
/* 7 f 9 */
/* 8 0 */
-#line 19913 ""
+#line 19904 ""
if (*(unsigned char *)clefq < 55) {
/* if (ichar(clefq) .le. 55) then */
-#line 19915 ""
+#line 19906 ""
ret_val = *(unsigned char *)clefq - 48;
/* if (numclef .eq. 7) numclef = 9 */
-#line 19917 ""
+#line 19908 ""
} else if (*(unsigned char *)clefq == '7') {
-#line 19918 ""
+#line 19909 ""
ret_val = 9;
-#line 19919 ""
+#line 19910 ""
} else if (*(unsigned char *)clefq == '8') {
-#line 19920 ""
+#line 19911 ""
ret_val = 0;
-#line 19921 ""
+#line 19912 ""
} else {
-#line 19922 ""
+#line 19913 ""
ret_val = i_indx("tsmanrbxxf", clefq, (ftnlen)10, (ftnlen)1) - 1;
-#line 19923 ""
+#line 19914 ""
}
-#line 19924 ""
+#line 19915 ""
return ret_val;
} /* numclef_ */
@@ -47648,121 +47918,121 @@ integer numclef_(char *clefq, ftnlen clefq_len)
extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static integer nfmt;
-#line 19928 ""
+#line 19919 ""
r__1 = *i__ + .5f;
-#line 19928 ""
+#line 19919 ""
nfmt = r_lg10(&r__1) + 2;
-#line 19929 ""
+#line 19920 ""
if (*jlast + 5 + nfmt < 80) {
-#line 19930 ""
+#line 19921 ""
ci__1.cierr = 0;
-#line 19930 ""
+#line 19921 ""
ci__1.ciunit = 6;
/* Writing concatenation */
-#line 19930 ""
+#line 19921 ""
i__1[0] = 5, a__1[0] = "(a5,i";
-#line 19930 ""
+#line 19921 ""
i__2 = nfmt + 48;
-#line 19930 ""
+#line 19921 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 19930 ""
+#line 19921 ""
i__1[1] = 1, a__1[1] = ch__2;
-#line 19930 ""
+#line 19921 ""
i__1[2] = 3, a__1[2] = ",$)";
-#line 19930 ""
+#line 19921 ""
ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
-#line 19930 ""
+#line 19921 ""
s_wsfe(&ci__1);
-#line 19930 ""
+#line 19921 ""
do_fio(&c__1, " Bar", (ftnlen)5);
-#line 19930 ""
+#line 19921 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
-#line 19930 ""
+#line 19921 ""
e_wsfe();
-#line 19931 ""
+#line 19922 ""
ci__1.cierr = 0;
-#line 19931 ""
+#line 19922 ""
ci__1.ciunit = 15;
/* Writing concatenation */
-#line 19931 ""
+#line 19922 ""
i__1[0] = 5, a__1[0] = "(a5,i";
-#line 19931 ""
+#line 19922 ""
i__2 = nfmt + 48;
-#line 19931 ""
+#line 19922 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 19931 ""
+#line 19922 ""
i__1[1] = 1, a__1[1] = ch__2;
-#line 19931 ""
+#line 19922 ""
i__1[2] = 3, a__1[2] = ",$)";
-#line 19931 ""
+#line 19922 ""
ci__1.cifmt = (s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)9), ch__1);
-#line 19931 ""
+#line 19922 ""
s_wsfe(&ci__1);
-#line 19931 ""
+#line 19922 ""
do_fio(&c__1, " Bar", (ftnlen)5);
-#line 19931 ""
+#line 19922 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
-#line 19931 ""
+#line 19922 ""
e_wsfe();
-#line 19932 ""
+#line 19923 ""
*jlast = *jlast + 5 + nfmt;
-#line 19933 ""
+#line 19924 ""
} else {
-#line 19934 ""
+#line 19925 ""
ci__1.cierr = 0;
-#line 19934 ""
+#line 19925 ""
ci__1.ciunit = 6;
/* Writing concatenation */
-#line 19934 ""
+#line 19925 ""
i__1[0] = 7, a__1[0] = "(/,a5,i";
-#line 19934 ""
+#line 19925 ""
i__2 = nfmt + 48;
-#line 19934 ""
+#line 19925 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 19934 ""
+#line 19925 ""
i__1[1] = 1, a__1[1] = ch__2;
-#line 19934 ""
+#line 19925 ""
i__1[2] = 3, a__1[2] = ",$)";
-#line 19934 ""
+#line 19925 ""
ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
-#line 19934 ""
+#line 19925 ""
s_wsfe(&ci__1);
-#line 19934 ""
+#line 19925 ""
do_fio(&c__1, " Bar", (ftnlen)5);
-#line 19934 ""
+#line 19925 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
-#line 19934 ""
+#line 19925 ""
e_wsfe();
-#line 19935 ""
+#line 19926 ""
ci__1.cierr = 0;
-#line 19935 ""
+#line 19926 ""
ci__1.ciunit = 15;
/* Writing concatenation */
-#line 19935 ""
+#line 19926 ""
i__1[0] = 7, a__1[0] = "(/,a5,i";
-#line 19935 ""
+#line 19926 ""
i__2 = nfmt + 48;
-#line 19935 ""
+#line 19926 ""
chax_(ch__2, (ftnlen)1, &i__2);
-#line 19935 ""
+#line 19926 ""
i__1[1] = 1, a__1[1] = ch__2;
-#line 19935 ""
+#line 19926 ""
i__1[2] = 3, a__1[2] = ",$)";
-#line 19935 ""
+#line 19926 ""
ci__1.cifmt = (s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)11), ch__3);
-#line 19935 ""
+#line 19926 ""
s_wsfe(&ci__1);
-#line 19935 ""
+#line 19926 ""
do_fio(&c__1, " Bar", (ftnlen)5);
-#line 19935 ""
+#line 19926 ""
do_fio(&c__1, (char *)&(*i__), (ftnlen)sizeof(integer));
-#line 19935 ""
+#line 19926 ""
e_wsfe();
-#line 19936 ""
+#line 19927 ""
*jlast = nfmt + 5;
-#line 19937 ""
+#line 19928 ""
}
-#line 19938 ""
+#line 19929 ""
return 0;
} /* outbar_ */
@@ -47909,374 +48179,371 @@ integer numclef_(char *clefq, ftnlen clefq_len)
/* c Check for nbars > nsyst */
/* c */
/* cccccccccccccccccccccccccccccccccc */
-/* * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) */
-/* logical mrecord,mplay,endmac,gotclef,cstuplet */
-#line 20027 ""
+#line 20016 ""
/* Parameter adjustments */
-#line 20027 ""
+#line 20016 ""
--nbarss;
-#line 20027 ""
+#line 20016 ""
-#line 20027 ""
+#line 20016 ""
/* Function Body */
/* data poefa /125*1./ */
/* This corrected a problem in Bob Tennent's compilation of pmx2.94 */
-#line 20032 ""
+#line 20021 ""
for (i__ = 1; i__ <= 125; ++i__) {
-#line 20033 ""
+#line 20022 ""
comshort_1.poefa[i__ - 1] = 1.f;
-#line 20034 ""
+#line 20023 ""
/* L97: */
-#line 20034 ""
+#line 20023 ""
}
-#line 20035 ""
+#line 20024 ""
comis4bignv_1.is4bignv = FALSE_;
-#line 20036 ""
+#line 20025 ""
comis4bignv_1.aiset = FALSE_;
-#line 20037 ""
+#line 20026 ""
commus_1.whead20 = .3f;
-#line 20038 ""
+#line 20027 ""
comshort_1.ishort = 0;
-#line 20039 ""
+#line 20028 ""
if (! (*optimize)) {
-#line 20040 ""
+#line 20029 ""
s_wsle(&io___1222);
-#line 20040 ""
+#line 20029 ""
e_wsle();
-#line 20041 ""
+#line 20030 ""
s_wsle(&io___1223);
-#line 20041 ""
+#line 20030 ""
do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23);
-#line 20041 ""
+#line 20030 ""
e_wsle();
-#line 20042 ""
+#line 20031 ""
s_wsfe(&io___1224);
-#line 20042 ""
+#line 20031 ""
do_fio(&c__1, " Starting first PMX pass", (ftnlen)24);
-#line 20042 ""
+#line 20031 ""
e_wsfe();
-#line 20043 ""
+#line 20032 ""
}
-#line 20044 ""
+#line 20033 ""
if (*isfirst) {
-#line 20045 ""
+#line 20034 ""
o__1.oerr = 0;
-#line 20045 ""
+#line 20034 ""
o__1.ounit = 19;
-#line 20045 ""
+#line 20034 ""
o__1.ofnmlen = 11;
-#line 20045 ""
+#line 20034 ""
o__1.ofnm = "pmxaerr.dat";
-#line 20045 ""
+#line 20034 ""
o__1.orl = 0;
-#line 20045 ""
+#line 20034 ""
o__1.osta = 0;
-#line 20045 ""
+#line 20034 ""
o__1.oacc = 0;
-#line 20045 ""
+#line 20034 ""
o__1.ofm = 0;
-#line 20045 ""
+#line 20034 ""
o__1.oblnk = 0;
-#line 20045 ""
+#line 20034 ""
f_open(&o__1);
-#line 20046 ""
+#line 20035 ""
s_wsfe(&io___1225);
-#line 20046 ""
+#line 20035 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 20046 ""
+#line 20035 ""
e_wsfe();
-#line 20047 ""
+#line 20036 ""
cl__1.cerr = 0;
-#line 20047 ""
+#line 20036 ""
cl__1.cunit = 19;
-#line 20047 ""
+#line 20036 ""
cl__1.csta = 0;
-#line 20047 ""
+#line 20036 ""
f_clos(&cl__1);
-#line 20048 ""
+#line 20037 ""
}
-#line 20049 ""
+#line 20038 ""
if (! (*optimize)) {
-#line 20049 ""
+#line 20038 ""
jprntb = 81;
-#line 20049 ""
+#line 20038 ""
}
-#line 20050 ""
+#line 20039 ""
commac_1.macuse = 0;
-#line 20051 ""
+#line 20040 ""
comkeys_1.ornrpt = FALSE_;
-#line 20052 ""
+#line 20041 ""
comkeys_1.stickys = FALSE_;
-#line 20053 ""
+#line 20042 ""
commac_1.mrecord = FALSE_;
-#line 20054 ""
+#line 20043 ""
commac_1.mplay = FALSE_;
-#line 20055 ""
+#line 20044 ""
c1omget_1.lastchar = FALSE_;
-#line 20056 ""
+#line 20045 ""
comnvst_2.novshrinktop = FALSE_;
-#line 20057 ""
+#line 20046 ""
cstuplet = FALSE_;
-#line 20058 ""
+#line 20047 ""
comslur_1.fontslur = TRUE_;
-#line 20059 ""
+#line 20048 ""
comligfont_1.isligfont = FALSE_;
-#line 20060 ""
+#line 20049 ""
fulltrans = FALSE_;
-#line 20061 ""
+#line 20050 ""
for (c1omnotes_1.ibarcnt = 1; c1omnotes_1.ibarcnt <= 3999;
++c1omnotes_1.ibarcnt) {
-#line 20062 ""
+#line 20051 ""
c1omnotes_1.udsp[c1omnotes_1.ibarcnt - 1] = 0.f;
-#line 20063 ""
+#line 20052 ""
c1omnotes_1.wminnh[c1omnotes_1.ibarcnt - 1] = -1.f;
-#line 20064 ""
+#line 20053 ""
/* L42: */
-#line 20064 ""
+#line 20053 ""
}
/* Initialize input buffer */
-#line 20068 ""
+#line 20057 ""
c1omget_1.lenbuf0 = inbuff_1.ipbuf;
-#line 20069 ""
+#line 20058 ""
inbuff_1.ipbuf = 0;
-#line 20070 ""
+#line 20059 ""
inbuff_1.ilbuf = 1;
-#line 20071 ""
+#line 20060 ""
g1etset_(&a1ll_2.nv, &comkeys_1.noinst, &a1ll_2.mtrnuml, &mtrdenl, &
mtrnmp, &mtrdnp, &xmtrnum0, comkeys_1.newkey, &compage_1.npages, &
compage_1.nsyst, &commus_1.musize, &bottreb);
/* Set up list of instrument numbers (iv) */
-#line 20076 ""
+#line 20065 ""
ivnow = 0;
-#line 20077 ""
+#line 20066 ""
i__1 = comkeys_1.noinst;
-#line 20077 ""
+#line 20066 ""
for (instnow = 1; instnow <= i__1; ++instnow) {
-#line 20078 ""
+#line 20067 ""
i__2 = c1omget_1.nsperi[instnow - 1];
-#line 20078 ""
+#line 20067 ""
for (iscount = 1; iscount <= i__2; ++iscount) {
-#line 20079 ""
+#line 20068 ""
++ivnow;
-#line 20080 ""
+#line 20069 ""
cominsttrans_1.instno[ivnow - 1] = instnow;
-#line 20081 ""
+#line 20070 ""
/* L14: */
-#line 20081 ""
+#line 20070 ""
}
-#line 20082 ""
+#line 20071 ""
/* L13: */
-#line 20082 ""
+#line 20071 ""
}
/* Save initial meter for midi */
-#line 20086 ""
+#line 20075 ""
if (! (*isfirst) && compage_1.npages == 0) {
-#line 20087 ""
+#line 20076 ""
s_wsle(&io___1237);
-#line 20087 ""
+#line 20076 ""
do_lio(&c__9, &c__1, "Sorry, must have npages>0 for optimization.", (
ftnlen)43);
-#line 20087 ""
+#line 20076 ""
e_wsle();
-#line 20088 ""
+#line 20077 ""
stop1_();
-#line 20089 ""
+#line 20078 ""
}
-#line 20090 ""
+#line 20079 ""
*nsyout = compage_1.nsyst;
/* isig1 will be changed in getnote if there is a transposition */
-#line 20094 ""
+#line 20083 ""
comkeys_1.isig1 = comkeys_1.newkey[0];
-#line 20095 ""
+#line 20084 ""
if (compage_1.npages > compage_1.nsyst) {
-#line 20096 ""
+#line 20085 ""
printl_("npages > nsyst in input. Please fix the input.", (ftnlen)47)
;
-#line 20097 ""
+#line 20086 ""
stop1_();
-#line 20098 ""
+#line 20087 ""
}
/* fbar = afterruleskip/elemskip */
/* apt = width of small accidental + space in points (= 6 at 20pt) =wheadpt */
-#line 20103 ""
+#line 20092 ""
c1ommvl_1.fbar = 1.f;
-#line 20104 ""
+#line 20093 ""
c1omnotes_1.wheadpt = commus_1.whead20 * commus_1.musize;
-#line 20105 ""
+#line 20094 ""
ifig = 0;
-#line 20106 ""
+#line 20095 ""
compage_1.usefig = TRUE_;
-#line 20107 ""
+#line 20096 ""
lenbeat = i1fnodur_(&mtrdenl, "x", (ftnlen)1);
-#line 20108 ""
+#line 20097 ""
lenmult = 1;
-#line 20109 ""
+#line 20098 ""
if (mtrdenl == 2) {
-#line 20110 ""
+#line 20099 ""
lenbeat = 16;
-#line 20111 ""
+#line 20100 ""
lenmult = 2;
-#line 20112 ""
+#line 20101 ""
}
-#line 20113 ""
+#line 20102 ""
a1ll_2.lenbr1 = lenmult * a1ll_2.mtrnuml * lenbeat;
-#line 20114 ""
+#line 20103 ""
r__1 = lenmult * xmtrnum0 * lenbeat;
-#line 20114 ""
+#line 20103 ""
a1ll_2.lenbr0 = i_nint(&r__1);
-#line 20115 ""
+#line 20104 ""
a1ll_2.mtrnuml = 0;
-#line 20116 ""
+#line 20105 ""
if (a1ll_2.lenbr0 != 0) {
-#line 20117 ""
+#line 20106 ""
c1omnotes_1.ibaroff = 1;
-#line 20118 ""
+#line 20107 ""
a1ll_2.lenbar = a1ll_2.lenbr0;
-#line 20119 ""
+#line 20108 ""
} else {
-#line 20120 ""
+#line 20109 ""
c1omnotes_1.ibaroff = 0;
-#line 20121 ""
+#line 20110 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
-#line 20122 ""
+#line 20111 ""
}
-#line 20123 ""
+#line 20112 ""
c1omnotes_1.ibarcnt = 0;
-#line 20124 ""
+#line 20113 ""
c1omnotes_1.nptr[0] = 1;
-#line 20125 ""
+#line 20114 ""
a1ll_2.iccount = 128;
-#line 20126 ""
+#line 20115 ""
compage_1.nmovbrk = 0;
-#line 20127 ""
+#line 20116 ""
compage_1.nflb = 0;
-#line 20128 ""
+#line 20117 ""
compage_1.nfpb = 0;
-#line 20129 ""
+#line 20118 ""
compage_1.ipagfpb[0] = 1;
-#line 20130 ""
+#line 20119 ""
compage_1.isysfpb[0] = 1;
-#line 20131 ""
+#line 20120 ""
compage_1.ibarflb[0] = 1;
-#line 20132 ""
+#line 20121 ""
compage_1.isysflb[0] = 1;
-#line 20133 ""
+#line 20122 ""
compage_1.nistaff[0] = a1ll_2.nv - 1;
/* Check for pmx.mod */
-#line 20137 ""
+#line 20126 ""
c1omget_1.linesinpmxmod = 0;
/* line1pmxmod = ilbuf */
-#line 20139 ""
+#line 20128 ""
getpmxmod_(&c_true, " ", (ftnlen)1);
-#line 20140 ""
+#line 20129 ""
if (! (*isfirst) && c1omget_1.linesinpmxmod > 0) {
-#line 20141 ""
+#line 20130 ""
s_wsle(&io___1241);
-#line 20141 ""
+#line 20130 ""
do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f"\
"ile", (ftnlen)49);
-#line 20141 ""
+#line 20130 ""
e_wsle();
-#line 20142 ""
+#line 20131 ""
stop1_();
-#line 20143 ""
+#line 20132 ""
}
/* Initialize for loop over lines */
-#line 20147 ""
+#line 20136 ""
comkeys_1.nkeys = 1;
-#line 20148 ""
+#line 20137 ""
comkeys_1.ibrkch[0] = 1;
-#line 20149 ""
+#line 20138 ""
comkeys_1.mbrestsav = 0;
-#line 20150 ""
+#line 20139 ""
comkeys_1.shifton = FALSE_;
-#line 20151 ""
+#line 20140 ""
a1ll_2.firstline = TRUE_;
-#line 20152 ""
+#line 20141 ""
a1ll_2.newmeter = FALSE_;
-#line 20153 ""
+#line 20142 ""
c1omget_1.ihead = 0;
-#line 20154 ""
+#line 20143 ""
c1omget_1.isheadr = FALSE_;
-/* gotclef = .false. */
-#line 20156 ""
+#line 20144 ""
comkeys_1.idsig = 0;
-#line 20157 ""
+#line 20145 ""
c1omnotes_1.iddot = 0;
-#line 20158 ""
+#line 20146 ""
compage_1.fintstf = -1.f;
-#line 20159 ""
+#line 20147 ""
compage_1.gintstf = 1.f;
-#line 20160 ""
+#line 20148 ""
listcresc = 0;
-#line 20161 ""
+#line 20149 ""
listdecresc = 0;
-#line 20162 ""
+#line 20150 ""
L30:
-#line 20162 ""
+#line 20150 ""
loop = TRUE_;
-#line 20163 ""
+#line 20151 ""
comkeys_1.iskchb = FALSE_;
-#line 20164 ""
+#line 20152 ""
c1omget_1.issegno = FALSE_;
-#line 20165 ""
+#line 20153 ""
a1ll_2.nbars = 0;
-#line 20166 ""
+#line 20154 ""
c1omnotes_1.ibarmbr = 0;
-#line 20167 ""
+#line 20155 ""
i__1 = a1ll_2.nv;
-#line 20167 ""
+#line 20155 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__1; ++a1ll_2.iv) {
-#line 20168 ""
+#line 20156 ""
c1ommvl_1.nvmx[a1ll_2.iv - 1] = 1;
-#line 20169 ""
+#line 20157 ""
c1ommvl_1.ivmx[a1ll_2.iv - 1] = a1ll_2.iv;
-#line 20170 ""
+#line 20158 ""
a1ll_2.itsofar[a1ll_2.iv - 1] = 0;
-#line 20171 ""
+#line 20159 ""
a1ll_2.nnl[a1ll_2.iv - 1] = 0;
-#line 20172 ""
+#line 20160 ""
for (j = 1; j <= 200; ++j) {
-#line 20173 ""
+#line 20161 ""
a1ll_2.rest[a1ll_2.iv + j * 24 - 25] = FALSE_;
-#line 20174 ""
+#line 20162 ""
c1ommvl_1.nacc[a1ll_2.iv + j * 24 - 25] = 0.f;
-#line 20175 ""
+#line 20163 ""
/* L5: */
-#line 20175 ""
+#line 20163 ""
}
-#line 20176 ""
+#line 20164 ""
/* L4: */
-#line 20176 ""
+#line 20164 ""
}
-#line 20177 ""
+#line 20165 ""
a1ll_2.iv = 1;
-#line 20178 ""
+#line 20166 ""
c1ommvl_1.ivx = 1;
-#line 20179 ""
+#line 20167 ""
c1omget_1.fbon = FALSE_;
-#line 20180 ""
+#line 20168 ""
comkeys_1.barend = FALSE_;
-#line 20181 ""
+#line 20169 ""
c1omget_1.isvolt = FALSE_;
-#line 20182 ""
+#line 20170 ""
L2:
-#line 20182 ""
+#line 20170 ""
if (loop) {
/* Within this short loop, nv voices are filled up for the duration of a block. */
@@ -48284,525 +48551,529 @@ L2:
/* nodur(..),rest(..). nnl will later be */
/* increased and things slid around as accidental skips are added. */
-#line 20189 ""
+#line 20177 ""
g1etnote_(&loop, &ifig, optimize, &fulltrans);
-#line 20190 ""
+#line 20178 ""
if (c1omget_1.lastchar) {
-#line 20190 ""
+#line 20178 ""
goto L20;
-#line 20190 ""
+#line 20178 ""
}
-#line 20191 ""
+#line 20179 ""
goto L2;
-#line 20192 ""
+#line 20180 ""
}
-#line 20193 ""
+#line 20181 ""
if (comkeys_1.mbrestsav > 0) {
-#line 20194 ""
+#line 20182 ""
printl_(" ", (ftnlen)1);
-#line 20195 ""
+#line 20183 ""
printl_("You must enter the same multibar rest in ALL parts", (ftnlen)
50);
-#line 20197 ""
+#line 20185 ""
stop1_();
-#line 20198 ""
+#line 20186 ""
}
-#line 20199 ""
+#line 20187 ""
i__1 = a1ll_2.nbars;
-#line 20199 ""
+#line 20187 ""
for (a1ll_2.ibar = 1; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
-#line 20200 ""
+#line 20188 ""
++c1omnotes_1.ibarcnt;
/* The following is just a signal to start a new bar when cataloging spaces */
/* for catspace(...) */
-#line 20205 ""
+#line 20193 ""
c1omnotes_1.nptr[c1omnotes_1.ibarcnt] = c1omnotes_1.nptr[
c1omnotes_1.ibarcnt - 1];
-#line 20206 ""
+#line 20194 ""
newmb[c1omnotes_1.ibarcnt - 1] = FALSE_;
-#line 20207 ""
+#line 20195 ""
if (a1ll_2.newmeter && a1ll_2.ibar == 1) {
-#line 20207 ""
+#line 20195 ""
newmb[c1omnotes_1.ibarcnt - 1] = TRUE_;
-#line 20207 ""
+#line 20195 ""
}
/* Above is only for spacing calcs later on. Remember new meter can only occur */
/* at START of a new input line (ibar = 1) */
-#line 20212 ""
+#line 20200 ""
if (a1ll_2.ibar != c1omnotes_1.ibarmbr) {
-#line 20213 ""
+#line 20201 ""
if (! (*optimize)) {
-#line 20213 ""
+#line 20201 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
-#line 20213 ""
+#line 20201 ""
outbar_(&i__2, &jprntb);
-#line 20213 ""
+#line 20201 ""
}
-#line 20214 ""
+#line 20202 ""
} else {
-#line 20215 ""
+#line 20203 ""
if (! (*optimize)) {
-#line 20216 ""
+#line 20204 ""
s_wsfe(&io___1247);
-#line 20216 ""
+#line 20204 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
-#line 20216 ""
+#line 20204 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
-#line 20216 ""
+#line 20204 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 20216 ""
+#line 20204 ""
do_fio(&c__1, "-", (ftnlen)1);
-#line 20216 ""
+#line 20204 ""
i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
c1omnotes_1.mbrest - 1;
-#line 20216 ""
+#line 20204 ""
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
-#line 20216 ""
+#line 20204 ""
e_wsfe();
-#line 20218 ""
+#line 20206 ""
s_wsfe(&io___1248);
-#line 20218 ""
+#line 20206 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
-#line 20218 ""
+#line 20206 ""
i__2 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff;
-#line 20218 ""
+#line 20206 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 20218 ""
+#line 20206 ""
do_fio(&c__1, "-", (ftnlen)1);
-#line 20218 ""
+#line 20206 ""
i__3 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff +
c1omnotes_1.mbrest - 1;
-#line 20218 ""
+#line 20206 ""
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
-#line 20218 ""
+#line 20206 ""
e_wsfe();
-#line 20220 ""
+#line 20208 ""
jprntb = 0;
-#line 20221 ""
+#line 20209 ""
}
-#line 20222 ""
+#line 20210 ""
c1omnotes_1.ibaroff = c1omnotes_1.ibaroff - c1omnotes_1.mbrest +
1;
-#line 20223 ""
+#line 20211 ""
}
-#line 20224 ""
+#line 20212 ""
if (a1ll_2.firstline && a1ll_2.lenbr0 != 0) {
-#line 20225 ""
+#line 20213 ""
if (a1ll_2.ibar == 1) {
-#line 20226 ""
+#line 20214 ""
a1ll_2.lenbar = a1ll_2.lenbr0;
-#line 20227 ""
+#line 20215 ""
} else {
-#line 20228 ""
+#line 20216 ""
a1ll_2.lenbar = a1ll_2.lenbr1;
-#line 20229 ""
+#line 20217 ""
}
-#line 20230 ""
+#line 20218 ""
}
-#line 20231 ""
+#line 20219 ""
if (a1ll_2.ibar > 1) {
/* For bars after first, slide all stuff down to beginning of arrays */
-#line 20235 ""
+#line 20223 ""
i__2 = a1ll_2.nv;
-#line 20235 ""
+#line 20223 ""
for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
-#line 20236 ""
+#line 20224 ""
i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
-#line 20236 ""
+#line 20224 ""
for (kv = 1; kv <= i__3; ++kv) {
-#line 20237 ""
+#line 20225 ""
c1ommvl_1.ivx = c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25];
-#line 20238 ""
+#line 20226 ""
ioff = a1ll_2.nib[c1ommvl_1.ivx + (a1ll_2.ibar - 1) * 24
- 25];
-#line 20239 ""
+#line 20227 ""
i__4 = a1ll_2.nib[c1ommvl_1.ivx + a1ll_2.ibar * 24 - 25]
- ioff;
-#line 20239 ""
+#line 20227 ""
for (ip = 1; ip <= i__4; ++ip) {
-#line 20240 ""
+#line 20228 ""
a1ll_2.nodur[c1ommvl_1.ivx + ip * 24 - 25] =
a1ll_2.nodur[c1ommvl_1.ivx + (ip + ioff) * 24
- 25];
-#line 20241 ""
+#line 20229 ""
a1ll_2.rest[c1ommvl_1.ivx + ip * 24 - 25] =
a1ll_2.rest[c1ommvl_1.ivx + (ip + ioff) * 24
- 25];
-#line 20242 ""
+#line 20230 ""
c1ommvl_1.nacc[c1ommvl_1.ivx + ip * 24 - 25] =
c1ommvl_1.nacc[c1ommvl_1.ivx + (ip + ioff) *
24 - 25];
-#line 20243 ""
+#line 20231 ""
/* L12: */
-#line 20243 ""
+#line 20231 ""
}
-#line 20244 ""
-/* L11: */
-#line 20244 ""
+#line 20232 ""
+/* L1199: */
+#line 20232 ""
}
-#line 20244 ""
+#line 20233 ""
+/* L11: */
+#line 20233 ""
}
-#line 20245 ""
+#line 20234 ""
}
-#line 20246 ""
- i__3 = a1ll_2.nv;
-#line 20246 ""
- for (a1ll_2.iv = 1; a1ll_2.iv <= i__3; ++a1ll_2.iv) {
-#line 20247 ""
- i__2 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
-#line 20247 ""
- for (kv = 1; kv <= i__2; ++kv) {
-#line 20248 ""
+#line 20235 ""
+ i__2 = a1ll_2.nv;
+#line 20235 ""
+ for (a1ll_2.iv = 1; a1ll_2.iv <= i__2; ++a1ll_2.iv) {
+#line 20236 ""
+ i__3 = c1ommvl_1.nvmx[a1ll_2.iv - 1];
+#line 20236 ""
+ for (kv = 1; kv <= i__3; ++kv) {
+#line 20237 ""
ioff = 0;
-#line 20249 ""
+#line 20238 ""
if (a1ll_2.ibar > 1) {
-#line 20249 ""
+#line 20238 ""
ioff = a1ll_2.nib[c1ommvl_1.ivmx[a1ll_2.iv + kv * 24 - 25]
+ (a1ll_2.ibar - 1) * 24 - 25];
-#line 20249 ""
+#line 20238 ""
}
-#line 20250 ""
-/* L67: */
-#line 20250 ""
+#line 20239 ""
+/* L6799: */
+#line 20239 ""
}
-#line 20250 ""
+#line 20240 ""
+/* L67: */
+#line 20240 ""
}
-#line 20251 ""
+#line 20241 ""
makeabar_();
-#line 20252 ""
+#line 20242 ""
elsk[c1omnotes_1.ibarcnt - 1] = linecom_1.elskb + c1ommvl_1.fbar;
-#line 20253 ""
+#line 20243 ""
/* L10: */
-#line 20253 ""
+#line 20243 ""
}
-#line 20254 ""
+#line 20244 ""
a1ll_2.newmeter = FALSE_;
-#line 20255 ""
+#line 20245 ""
a1ll_2.firstline = FALSE_;
-#line 20256 ""
+#line 20246 ""
goto L30;
-#line 20257 ""
+#line 20247 ""
L20:
/* Vertical analysis. */
-#line 20261 ""
+#line 20251 ""
if (compage_1.npages == 0) {
-#line 20262 ""
+#line 20252 ""
if (compage_1.nsyst == 0) {
-#line 20263 ""
+#line 20253 ""
s_wsle(&io___1253);
-#line 20263 ""
+#line 20253 ""
do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n"\
"ot 0", (ftnlen)46);
-#line 20263 ""
+#line 20253 ""
e_wsle();
-#line 20264 ""
+#line 20254 ""
stop1_();
-#line 20265 ""
+#line 20255 ""
}
-#line 20266 ""
+#line 20256 ""
compage_1.nsyst = (c1omnotes_1.ibarcnt - 1) / compage_1.nsyst + 1;
-#line 20267 ""
+#line 20257 ""
if (a1ll_2.nv == 1) {
-#line 20268 ""
+#line 20258 ""
nsystpp = 12;
-#line 20269 ""
+#line 20259 ""
} else if (a1ll_2.nv == 2) {
-#line 20270 ""
+#line 20260 ""
nsystpp = 7;
-#line 20271 ""
+#line 20261 ""
} else if (a1ll_2.nv == 3) {
-#line 20272 ""
+#line 20262 ""
nsystpp = 5;
-#line 20273 ""
+#line 20263 ""
} else if (a1ll_2.nv == 4) {
-#line 20274 ""
+#line 20264 ""
nsystpp = 3;
-#line 20275 ""
+#line 20265 ""
} else if (a1ll_2.nv <= 7) {
-#line 20276 ""
+#line 20266 ""
nsystpp = 2;
-#line 20277 ""
+#line 20267 ""
} else {
-#line 20278 ""
+#line 20268 ""
nsystpp = 1;
-#line 20279 ""
+#line 20269 ""
}
-#line 20280 ""
+#line 20270 ""
compage_1.npages = (compage_1.nsyst - 1) / nsystpp + 1;
-#line 20281 ""
+#line 20271 ""
}
/* Check nsyst vs ibarcnt */
-#line 20285 ""
+#line 20275 ""
if (compage_1.nsyst > c1omnotes_1.ibarcnt) {
-#line 20286 ""
+#line 20276 ""
s_wsle(&io___1255);
-#line 20286 ""
+#line 20276 ""
e_wsle();
-#line 20287 ""
+#line 20277 ""
s_wsle(&io___1256);
-#line 20287 ""
+#line 20277 ""
do_lio(&c__9, &c__1, "nsyst,ibarcnt:", (ftnlen)14);
-#line 20287 ""
+#line 20277 ""
do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer)
);
-#line 20287 ""
+#line 20277 ""
do_lio(&c__3, &c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(
integer));
-#line 20287 ""
+#line 20277 ""
e_wsle();
-#line 20288 ""
+#line 20278 ""
s_wsle(&io___1257);
-#line 20288 ""
+#line 20278 ""
do_lio(&c__9, &c__1, "There are more systems than bars.", (ftnlen)33);
-#line 20288 ""
+#line 20278 ""
e_wsle();
-#line 20289 ""
+#line 20279 ""
s_wsfe(&io___1258);
-#line 20289 ""
+#line 20279 ""
do_fio(&c__1, " nsyst,ibarcnt:", (ftnlen)15);
-#line 20289 ""
+#line 20279 ""
do_fio(&c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
-#line 20289 ""
+#line 20279 ""
do_fio(&c__1, (char *)&c1omnotes_1.ibarcnt, (ftnlen)sizeof(integer));
-#line 20289 ""
+#line 20279 ""
e_wsfe();
-#line 20290 ""
+#line 20280 ""
s_wsfe(&io___1259);
-#line 20290 ""
+#line 20280 ""
do_fio(&c__1, " There are more systems than bars.", (ftnlen)34);
-#line 20290 ""
+#line 20280 ""
e_wsfe();
-#line 20291 ""
+#line 20281 ""
stop1_();
-#line 20292 ""
+#line 20282 ""
}
/* Set up dummy forced line & page breaks after last real one */
-#line 20296 ""
+#line 20286 ""
++compage_1.nflb;
-#line 20297 ""
+#line 20287 ""
compage_1.ibarflb[compage_1.nflb] = c1omnotes_1.ibarcnt + 1;
-#line 20298 ""
+#line 20288 ""
compage_1.isysflb[compage_1.nflb] = compage_1.nsyst + 1;
-#line 20299 ""
+#line 20289 ""
++compage_1.nfpb;
-#line 20300 ""
+#line 20290 ""
compage_1.ipagfpb[compage_1.nfpb] = compage_1.npages + 1;
-#line 20301 ""
+#line 20291 ""
compage_1.isysfpb[compage_1.nfpb] = compage_1.nsyst + 1;
-#line 20302 ""
+#line 20292 ""
heightil = compage_1.ptheight * 4.f / commus_1.musize;
-#line 20303 ""
+#line 20293 ""
o__1.oerr = 0;
-#line 20303 ""
+#line 20293 ""
o__1.ounit = 12;
-#line 20303 ""
+#line 20293 ""
o__1.ofnm = 0;
-#line 20303 ""
+#line 20293 ""
o__1.orl = 0;
-#line 20303 ""
+#line 20293 ""
o__1.osta = "SCRATCH";
-#line 20303 ""
+#line 20293 ""
o__1.oacc = 0;
-#line 20303 ""
+#line 20293 ""
o__1.ofm = 0;
-#line 20303 ""
+#line 20293 ""
o__1.oblnk = 0;
-#line 20303 ""
+#line 20293 ""
f_open(&o__1);
-#line 20304 ""
+#line 20294 ""
s_wsfe(&io___1261);
-#line 20304 ""
+#line 20294 ""
do_fio(&c__1, basenameq, (*lbase));
-#line 20304 ""
+#line 20294 ""
e_wsfe();
-#line 20305 ""
+#line 20295 ""
s_wsle(&io___1262);
-#line 20305 ""
+#line 20295 ""
do_lio(&c__3, &c__1, (char *)&(*lbase), (ftnlen)sizeof(integer));
-#line 20305 ""
+#line 20295 ""
e_wsle();
/* Pass to pmxb the initial signature, including effect of transposition. */
-#line 20309 ""
+#line 20299 ""
s_wsfe(&io___1263);
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&c1ommvl_1.fbar, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&c1omnotes_1.wheadpt, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.etait, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.etatc, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.etacs1, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.etatop, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.etabot, (ftnlen)sizeof(real));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&cblock_1.inhnoh, (ftnlen)sizeof(integer));
-#line 20309 ""
+#line 20299 ""
do_fio(&c__1, (char *)&comkeys_1.isig1, (ftnlen)sizeof(integer));
-#line 20309 ""
+#line 20299 ""
e_wsfe();
-#line 20311 ""
+#line 20301 ""
s_wsle(&io___1264);
-#line 20311 ""
+#line 20301 ""
do_lio(&c__3, &c__1, (char *)&compage_1.npages, (ftnlen)sizeof(integer));
-#line 20311 ""
+#line 20301 ""
do_lio(&c__4, &c__1, (char *)&compage_1.widthpt, (ftnlen)sizeof(real));
-#line 20311 ""
+#line 20301 ""
do_lio(&c__4, &c__1, (char *)&compage_1.ptheight, (ftnlen)sizeof(real));
-#line 20311 ""
+#line 20301 ""
do_lio(&c__4, &c__1, (char *)&compage_1.hoffpt, (ftnlen)sizeof(real));
-#line 20311 ""
+#line 20301 ""
do_lio(&c__4, &c__1, (char *)&compage_1.voffpt, (ftnlen)sizeof(real));
-#line 20311 ""
+#line 20301 ""
do_lio(&c__3, &c__1, (char *)&compage_1.nsyst, (ftnlen)sizeof(integer));
-#line 20311 ""
+#line 20301 ""
e_wsle();
-#line 20312 ""
+#line 20302 ""
iflbnow = -1;
-#line 20313 ""
+#line 20303 ""
isysb4 = 0;
-#line 20314 ""
+#line 20304 ""
i__1 = compage_1.nfpb;
-#line 20314 ""
+#line 20304 ""
for (ifpb = 1; ifpb <= i__1; ++ifpb) {
/* Each time thru this loop is like a single score with several pages */
-#line 20318 ""
+#line 20308 ""
compage_1.npages = compage_1.ipagfpb[ifpb] - compage_1.ipagfpb[ifpb -
1];
-#line 20319 ""
+#line 20309 ""
compage_1.nsyst = compage_1.isysfpb[ifpb] - compage_1.isysfpb[ifpb -
1];
-#line 20320 ""
+#line 20310 ""
nomnsystp = (compage_1.nsyst - 1) / compage_1.npages + 1;
-#line 20321 ""
+#line 20311 ""
nshort = nomnsystp * compage_1.npages - compage_1.nsyst;
-#line 20322 ""
+#line 20312 ""
i__2 = compage_1.npages;
-#line 20322 ""
+#line 20312 ""
for (ipage = 1; ipage <= i__2; ++ipage) {
-#line 20323 ""
+#line 20313 ""
nsystp = nomnsystp;
-#line 20324 ""
+#line 20314 ""
if (ipage <= nshort) {
-#line 20324 ""
+#line 20314 ""
--nsystp;
-#line 20324 ""
+#line 20314 ""
}
/* Last system number on this page: */
-#line 20327 ""
+#line 20317 ""
isysendpg = isysb4 + nsystp;
-#line 20328 ""
+#line 20318 ""
nintpg = 0;
-#line 20329 ""
+#line 20319 ""
i__3 = isysendpg;
-#line 20329 ""
+#line 20319 ""
for (isy = isysb4 + 1; isy <= i__3; ++isy) {
-#line 20330 ""
+#line 20320 ""
if (compage_1.isysflb[iflbnow + 1] == isy) {
-#line 20330 ""
+#line 20320 ""
++iflbnow;
-#line 20330 ""
+#line 20320 ""
}
-#line 20331 ""
+#line 20321 ""
nintpg += compage_1.nistaff[iflbnow];
-#line 20332 ""
+#line 20322 ""
/* L15: */
-#line 20332 ""
+#line 20322 ""
}
-#line 20333 ""
+#line 20323 ""
xilfrac = 0.f;
-#line 20334 ""
+#line 20324 ""
xiltxt = 0.f;
-#line 20335 ""
+#line 20325 ""
if (ipage == 1 && c1omget_1.ihead > 0) {
/* Needn't zero out ihead after printing titles if we only allow titles at top? */
-#line 20339 ""
+#line 20329 ""
if ((c1omget_1.ihead & 1) == 1) {
-#line 20340 ""
+#line 20330 ""
xiltxt += cblock_1.hgtin * 4 / commus_1.musize;
-#line 20341 ""
+#line 20331 ""
xilfrac += cblock_1.etait;
-#line 20342 ""
+#line 20332 ""
}
-#line 20343 ""
+#line 20333 ""
if ((c1omget_1.ihead & 2) == 2) {
-#line 20344 ""
+#line 20334 ""
xiltxt += cblock_1.hgtti * 4 / commus_1.musize;
-#line 20345 ""
+#line 20335 ""
xilfrac += cblock_1.etatc;
-#line 20346 ""
+#line 20336 ""
}
-#line 20347 ""
+#line 20337 ""
if ((c1omget_1.ihead & 4) == 4) {
-#line 20348 ""
+#line 20338 ""
xiltxt += cblock_1.hgtco * 4 / commus_1.musize;
-#line 20349 ""
+#line 20339 ""
xilfrac += cblock_1.etacs1;
-#line 20350 ""
+#line 20340 ""
} else {
/* Use double the title-composer space if there is no composer */
-#line 20354 ""
+#line 20344 ""
xilfrac += cblock_1.etatc;
-#line 20355 ""
+#line 20345 ""
}
-#line 20356 ""
+#line 20346 ""
}
-#line 20357 ""
+#line 20347 ""
d__ = xilfrac + nsystp - 1 + cblock_1.etatop + cblock_1.etabot;
/* C = nsystp*(nv-1) */
-#line 20359 ""
+#line 20349 ""
c__ = (real) nintpg;
/* xN = heightil - xiltxt - 4*nsystp*nv - (nsystp-1)*xilbn */
-#line 20361 ""
+#line 20351 ""
xn = heightil - xiltxt - (nintpg + nsystp << 2) - (nsystp - 1) *
cblock_1.xilbn;
-#line 20362 ""
+#line 20352 ""
if (bottreb) {
-#line 20362 ""
+#line 20352 ""
xn -= (nsystp - 1) * cblock_1.xilbtc;
-#line 20362 ""
+#line 20352 ""
}
-#line 20363 ""
+#line 20353 ""
if (c1omget_1.ihead == 0 && c1omget_1.isheadr) {
-#line 20363 ""
+#line 20353 ""
xn -= cblock_1.xilhdr;
-#line 20363 ""
+#line 20353 ""
}
-#line 20364 ""
+#line 20354 ""
if (ifig == 1) {
-#line 20365 ""
+#line 20355 ""
xn -= nsystp * cblock_1.xilfig;
-#line 20366 ""
+#line 20356 ""
}
-#line 20367 ""
+#line 20357 ""
glueil = (xn - cblock_1.b * c__) / (d__ + cblock_1.a * c__);
-#line 20368 ""
+#line 20358 ""
omegag = (cblock_1.b * d__ + cblock_1.a * xn) / (d__ + cblock_1.a
* c__);
@@ -48831,573 +49102,573 @@ L20:
/* Only the first page will get local adjustment now if needed, others in pmxb */
-#line 20395 ""
+#line 20385 ""
if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) {
-#line 20396 ""
+#line 20386 ""
facins = compage_1.fintstf;
-#line 20397 ""
+#line 20387 ""
compage_1.fintstf = -1.f;
-#line 20398 ""
+#line 20388 ""
} else {
/* gintstf = 1.0 by default, but may be changed with AI<x> */
-#line 20402 ""
+#line 20392 ""
facins = compage_1.gintstf;
-#line 20403 ""
+#line 20393 ""
}
-#line 20404 ""
+#line 20394 ""
s_wsle(&io___1283);
-#line 20404 ""
+#line 20394 ""
do_lio(&c__3, &c__1, (char *)&nsystp, (ftnlen)sizeof(integer));
/* Computing MAX */
-#line 20404 ""
+#line 20394 ""
r__2 = 0.f, r__3 = cblock_1.etatop * glueil;
-#line 20404 ""
+#line 20394 ""
r__1 = dmax(r__2,r__3);
-#line 20404 ""
+#line 20394 ""
do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 20404 ""
+#line 20394 ""
r__4 = facins * (omegag + 4);
-#line 20404 ""
+#line 20394 ""
do_lio(&c__4, &c__1, (char *)&r__4, (ftnlen)sizeof(real));
-#line 20404 ""
+#line 20394 ""
e_wsle();
-#line 20405 ""
+#line 20395 ""
c1omget_1.ihead = 0;
-#line 20406 ""
+#line 20396 ""
c1omget_1.isheadr = FALSE_;
-#line 20407 ""
+#line 20397 ""
isysb4 = isysendpg;
-#line 20408 ""
+#line 20398 ""
/* L7: */
-#line 20408 ""
+#line 20398 ""
}
-#line 20409 ""
+#line 20399 ""
/* L8: */
-#line 20409 ""
+#line 20399 ""
}
/* Done with vertical, now do horizontals */
-#line 20413 ""
+#line 20403 ""
celsk[1] = elsk[0];
-#line 20414 ""
+#line 20404 ""
i__1 = c1omnotes_1.ibarcnt;
-#line 20414 ""
+#line 20404 ""
for (a1ll_2.ibar = 2; a1ll_2.ibar <= i__1; ++a1ll_2.ibar) {
-#line 20415 ""
+#line 20405 ""
celsk[a1ll_2.ibar] = celsk[a1ll_2.ibar - 1] + elsk[a1ll_2.ibar - 1];
-#line 20416 ""
+#line 20406 ""
/* L21: */
-#line 20416 ""
+#line 20406 ""
}
-#line 20417 ""
+#line 20407 ""
lastbar[0] = 0;
-#line 20418 ""
+#line 20408 ""
ibar1 = 1;
-#line 20419 ""
+#line 20409 ""
wmins = -1.f;
-#line 20420 ""
+#line 20410 ""
iflb = 1;
-#line 20421 ""
+#line 20411 ""
imovbrk = 0;
-#line 20422 ""
+#line 20412 ""
ikey = 1;
/* Return nsyst to its *total* value */
-#line 20426 ""
+#line 20416 ""
compage_1.nsyst = compage_1.isysfpb[compage_1.nfpb] - 1;
-#line 20427 ""
+#line 20417 ""
i__1 = compage_1.nsyst;
-#line 20427 ""
+#line 20417 ""
for (isyst = 1; isyst <= i__1; ++isyst) {
-#line 20428 ""
+#line 20418 ""
if (isyst == compage_1.isysflb[iflb]) {
-#line 20428 ""
+#line 20418 ""
++iflb;
-#line 20428 ""
+#line 20418 ""
}
-#line 20429 ""
+#line 20419 ""
if (compage_1.nmovbrk > 0 && imovbrk < compage_1.nmovbrk) {
-#line 20430 ""
+#line 20420 ""
if (isyst == compage_1.isysmb[imovbrk + 1]) {
-#line 20430 ""
+#line 20420 ""
++imovbrk;
-#line 20430 ""
+#line 20420 ""
}
-#line 20431 ""
+#line 20421 ""
}
-#line 20432 ""
+#line 20422 ""
ibarb4 = lastbar[isyst - 1];
-#line 20433 ""
+#line 20423 ""
if (isyst == 1) {
-#line 20434 ""
+#line 20424 ""
if (*isfirst) {
-#line 20434 ""
+#line 20424 ""
elsstarg = celsk[compage_1.ibarflb[1] - 1] / (
compage_1.isysflb[1] - 1 - c1omget_1.fracindent) * (1
- c1omget_1.fracindent);
-#line 20434 ""
+#line 20424 ""
}
-#line 20436 ""
+#line 20426 ""
celskb4 = 0.f;
-#line 20437 ""
+#line 20427 ""
} else {
-#line 20438 ""
+#line 20428 ""
celskb4 = celsk[ibarb4];
/* Must dimension isysmb(0:*) just so I can execute this test! */
-#line 20442 ""
+#line 20432 ""
if (*isfirst) {
-#line 20443 ""
+#line 20433 ""
if (compage_1.nmovbrk > 0 && isyst == compage_1.isysmb[
imovbrk]) {
/* First syst after forced line break. There may be indentation. */
-#line 20447 ""
+#line 20437 ""
elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4)
/ (compage_1.isysflb[iflb] - isyst -
compage_1.fracsys[imovbrk - 1]) * (1 -
compage_1.fracsys[imovbrk - 1]);
-#line 20450 ""
+#line 20440 ""
} else {
/* There is no indentation to deal with */
-#line 20454 ""
+#line 20444 ""
elsstarg = (celsk[compage_1.ibarflb[iflb] - 1] - celskb4)
/ (compage_1.isysflb[iflb] - isyst);
-#line 20456 ""
+#line 20446 ""
}
-#line 20457 ""
+#line 20447 ""
}
-#line 20458 ""
+#line 20448 ""
}
-#line 20459 ""
+#line 20449 ""
if (*isfirst) {
-#line 20460 ""
+#line 20450 ""
diff1 = (r__1 = elsstarg - elsk[ibarb4], dabs(r__1));
-#line 20461 ""
+#line 20451 ""
i__2 = c1omnotes_1.ibarcnt;
-#line 20461 ""
+#line 20451 ""
for (a1ll_2.ibar = ibarb4 + 2; a1ll_2.ibar <= i__2; ++a1ll_2.ibar)
{
-#line 20462 ""
+#line 20452 ""
diff = elsstarg - (celsk[a1ll_2.ibar] - celskb4);
-#line 20463 ""
+#line 20453 ""
if (dabs(diff) >= diff1) {
-#line 20463 ""
+#line 20453 ""
goto L24;
-#line 20463 ""
+#line 20453 ""
}
-#line 20464 ""
+#line 20454 ""
diff1 = dabs(diff);
-#line 20465 ""
+#line 20455 ""
/* L23: */
-#line 20465 ""
+#line 20455 ""
}
-#line 20466 ""
+#line 20456 ""
L24:
-#line 20466 ""
+#line 20456 ""
--a1ll_2.ibar;
-#line 20467 ""
+#line 20457 ""
lastbar[isyst] = a1ll_2.ibar;
-#line 20468 ""
+#line 20458 ""
nbarss[isyst] = a1ll_2.ibar - ibarb4;
-#line 20469 ""
+#line 20459 ""
} else {
/* nbarss is given as an input, must compute lastbar and ibar */
-#line 20473 ""
+#line 20463 ""
lastbar[isyst] = nbarss[isyst] + ibarb4;
-#line 20474 ""
+#line 20464 ""
a1ll_2.ibar = lastbar[isyst];
-#line 20475 ""
+#line 20465 ""
}
/* elss is # of elemskip in the syst. from notes & ars's, not ruleskips, ask's. */
-#line 20479 ""
+#line 20469 ""
elss[isyst - 1] = celsk[a1ll_2.ibar] - celskb4;
-#line 20480 ""
+#line 20470 ""
s_wsfe(&io___1298);
-#line 20480 ""
+#line 20470 ""
i__2 = lastbar[isyst - 1] + 1;
-#line 20480 ""
+#line 20470 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 20480 ""
+#line 20470 ""
e_wsfe();
/* Transposed sigs are isig1, newkey(2,3,...). */
-#line 20484 ""
+#line 20474 ""
if (ikey == 1) {
-#line 20485 ""
+#line 20475 ""
key1 = comkeys_1.isig1;
-#line 20486 ""
+#line 20476 ""
} else {
-#line 20487 ""
+#line 20477 ""
key1 = comkeys_1.newkey[ikey - 1];
-#line 20488 ""
+#line 20478 ""
}
-#line 20489 ""
+#line 20479 ""
fsyst = wclef + abs(key1) * wkeysig + 2.f / commus_1.musize;
-#line 20490 ""
+#line 20480 ""
xelsk = 0.f;
-#line 20491 ""
+#line 20481 ""
L1:
-#line 20491 ""
+#line 20481 ""
if (ikey < comkeys_1.nkeys) {
-#line 20492 ""
+#line 20482 ""
if (comkeys_1.ibrkch[ikey] <= lastbar[isyst]) {
/* Add space for all key changes */
-#line 20496 ""
+#line 20486 ""
++ikey;
-#line 20497 ""
+#line 20487 ""
key2 = comkeys_1.newkey[ikey - 1];
/* Computing MAX */
/* Computing MAX */
-#line 20498 ""
+#line 20488 ""
i__5 = abs(key1), i__6 = abs(key2);
-#line 20498 ""
+#line 20488 ""
i__3 = (i__2 = key2 - key1, abs(i__2)), i__4 = max(i__5,i__6);
-#line 20498 ""
+#line 20488 ""
naccs = max(i__3,i__4);
-#line 20499 ""
+#line 20489 ""
fsyst += naccs * wkeysig;
/* Account for afterruleskips (fbar) */
-#line 20503 ""
+#line 20493 ""
xelsk += c1ommvl_1.fbar / 2;
-#line 20504 ""
+#line 20494 ""
if (comkeys_1.ibrkch[ikey - 1] < lastbar[isyst] && !
comkeys_1.kchmid[ikey - 1]) {
-#line 20504 ""
+#line 20494 ""
xelsk += -1.f;
-#line 20504 ""
+#line 20494 ""
}
-#line 20506 ""
+#line 20496 ""
key1 = key2;
-#line 20507 ""
+#line 20497 ""
goto L1;
-#line 20508 ""
+#line 20498 ""
}
-#line 20509 ""
+#line 20499 ""
}
/* Add extra fixed space for double bar */
-#line 20513 ""
+#line 20503 ""
if (isyst == compage_1.nsyst) {
-#line 20514 ""
+#line 20504 ""
fsyst += 4.5f / commus_1.musize;
-#line 20515 ""
+#line 20505 ""
}
/* Add extra fixed space for initial time signature */
-#line 20519 ""
+#line 20509 ""
if (isyst == 1) {
-#line 20520 ""
+#line 20510 ""
fsyst += wtimesig;
-#line 20521 ""
+#line 20511 ""
}
/* Add extra fixed space for time signature changes & user-defined spaces */
-#line 20525 ""
+#line 20515 ""
i__2 = lastbar[isyst];
-#line 20525 ""
+#line 20515 ""
for (ibars = ibarb4 + 1; ibars <= i__2; ++ibars) {
-#line 20526 ""
+#line 20516 ""
if (newmb[ibars - 1]) {
-#line 20526 ""
+#line 20516 ""
fsyst += wtimesig;
-#line 20526 ""
+#line 20516 ""
}
-#line 20527 ""
+#line 20517 ""
fsyst += c1omnotes_1.udsp[ibars - 1] / commus_1.musize;
-#line 20528 ""
+#line 20518 ""
/* L26: */
-#line 20528 ""
+#line 20518 ""
}
-#line 20529 ""
+#line 20519 ""
if (isyst == 1) {
-#line 20530 ""
+#line 20520 ""
wdpt = compage_1.widthpt * (1 - c1omget_1.fracindent);
-#line 20531 ""
+#line 20521 ""
} else {
-#line 20532 ""
+#line 20522 ""
if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
compage_1.isysmb[imovbrk]) {
-#line 20534 ""
+#line 20524 ""
wdpt = compage_1.widthpt * (1 - compage_1.fracsys[imovbrk - 1]
);
-#line 20535 ""
+#line 20525 ""
} else {
-#line 20536 ""
+#line 20526 ""
wdpt = compage_1.widthpt;
-#line 20537 ""
+#line 20527 ""
}
-#line 20538 ""
+#line 20528 ""
}
-#line 20539 ""
+#line 20529 ""
wsyspt = wdpt - fsyst * commus_1.musize - nbarss[isyst] * .4f;
/* Checks for min spacing */
/* Get min allowable space */
-#line 20544 ""
+#line 20534 ""
dtmin = 1e3f;
-#line 20545 ""
+#line 20535 ""
i__2 = ibar1 + nbarss[isyst] - 1;
-#line 20545 ""
+#line 20535 ""
for (a1ll_2.ibar = ibar1; a1ll_2.ibar <= i__2; ++a1ll_2.ibar) {
/* Computing MIN */
-#line 20546 ""
+#line 20536 ""
r__1 = dtmin, r__2 = linecom_1.tnminb[a1ll_2.ibar - 1];
-#line 20546 ""
+#line 20536 ""
dtmin = dmin(r__1,r__2);
-#line 20547 ""
+#line 20537 ""
if (c1omnotes_1.wminnh[a1ll_2.ibar - 1] >= 0.f) {
-#line 20547 ""
+#line 20537 ""
wmins = c1omnotes_1.wminnh[a1ll_2.ibar - 1];
-#line 20547 ""
+#line 20537 ""
}
-#line 20548 ""
+#line 20538 ""
/* L45: */
-#line 20548 ""
+#line 20538 ""
}
-#line 20549 ""
+#line 20539 ""
if (wmins < 0.f) {
-#line 20549 ""
+#line 20539 ""
wmins = .3f;
-#line 20549 ""
+#line 20539 ""
}
-#line 20550 ""
+#line 20540 ""
wminpt = (wmins + 1) * .3f * commus_1.musize;
/* Find max duration & # of notes for this system */
-#line 20554 ""
+#line 20544 ""
dtmax = 0.f;
-#line 20555 ""
+#line 20545 ""
nns = 0;
-#line 20556 ""
+#line 20546 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
-#line 20556 ""
+#line 20546 ""
for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
/* Computing MAX */
-#line 20557 ""
+#line 20547 ""
r__1 = dtmax, r__2 = c1omnotes_1.durb[iptr - 1];
-#line 20557 ""
+#line 20547 ""
dtmax = dmax(r__1,r__2);
-#line 20558 ""
+#line 20548 ""
nns += c1omnotes_1.nnpd[iptr - 1];
-#line 20559 ""
+#line 20549 ""
/* L43: */
-#line 20559 ""
+#line 20549 ""
}
-#line 20560 ""
+#line 20550 ""
elmin0 = wsyspt * f1eon_(&dtmin) / (elss[isyst - 1] + xelsk);
-#line 20561 ""
+#line 20551 ""
if (elmin0 >= wminpt) {
/* Subtract out fbar stuff to keep old way of passing sumelsk to pmxb; */
/* there is no need to "flatten" */
-#line 20566 ""
+#line 20556 ""
sumelsk = elss[isyst - 1] - c1ommvl_1.fbar * nbarss[isyst];
-#line 20567 ""
+#line 20557 ""
comeon_1.eonk = 0.f;
-#line 20568 ""
+#line 20558 ""
comeon_1.ewmxk = 1.f;
-#line 20569 ""
+#line 20559 ""
} else {
-#line 20570 ""
+#line 20560 ""
elmin1 = wsyspt / ((c1ommvl_1.fbar * nbarss[isyst] + xelsk) /
f1eon_(&dtmax) + nns);
-#line 20571 ""
+#line 20561 ""
if (elmin1 <= wminpt) {
/* print* */
/* print*,'In system #',isyst,' cannot meet min. space rqmt' */
/* write(15,'(/a,i5,a)') */
/* * 'In system #',isyst,' cannot meet min. space rqmt' */
-#line 20576 ""
+#line 20566 ""
comeon_1.eonk = .9f;
-#line 20577 ""
+#line 20567 ""
} else {
/* Find eonk by Newton method */
-#line 20581 ""
+#line 20571 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
-#line 20581 ""
+#line 20571 ""
r__1 = wsyspt / wminpt;
-#line 20581 ""
+#line 20571 ""
r__2 = c1ommvl_1.fbar * nbarss[isyst] + xelsk;
-#line 20581 ""
+#line 20571 ""
r__3 = (wminpt - elmin0) / (elmin1 - elmin0);
-#line 20581 ""
+#line 20571 ""
findeonk_(&c1omnotes_1.nptr[ibar1 - 1], &i__2, &r__1, &r__2, &
dtmin, &dtmax, &r__3);
-#line 20584 ""
+#line 20574 ""
comeon_1.eonk = dmin(.9f,comeon_1.eonk);
-#line 20585 ""
+#line 20575 ""
}
-#line 20586 ""
+#line 20576 ""
d__1 = (doublereal) f1eon_(&dtmax);
-#line 20586 ""
+#line 20576 ""
d__2 = (doublereal) comeon_1.eonk;
-#line 20586 ""
+#line 20576 ""
comeon_1.ewmxk = pow_dd(&d__1, &d__2);
/* Recompute poenom! */
-#line 20590 ""
+#line 20580 ""
sumelsk = 0.f;
-#line 20591 ""
+#line 20581 ""
i__2 = c1omnotes_1.nptr[ibar1 + nbarss[isyst] - 1] - 1;
-#line 20591 ""
+#line 20581 ""
for (iptr = c1omnotes_1.nptr[ibar1 - 1]; iptr <= i__2; ++iptr) {
-#line 20592 ""
+#line 20582 ""
r__1 = c1omnotes_1.durb[iptr - 1] / c1omnotes_1.sqzb[iptr - 1]
;
-#line 20592 ""
+#line 20582 ""
sumelsk += c1omnotes_1.nnpd[iptr - 1] * c1omnotes_1.sqzb[iptr
- 1] * feon_(&r__1);
-#line 20594 ""
+#line 20584 ""
/* L44: */
-#line 20594 ""
+#line 20584 ""
}
-#line 20595 ""
+#line 20585 ""
}
-#line 20596 ""
+#line 20586 ""
poenom = wsyspt / (sumelsk + c1ommvl_1.fbar * nbarss[isyst] + xelsk);
/* Set fracindent for output: orig if isyst=1, fracsys(imovbrk) if movbrk, else 0 */
-#line 20600 ""
+#line 20590 ""
if (isyst > 0) {
-#line 20601 ""
+#line 20591 ""
if (compage_1.nmovbrk > 0 && imovbrk > 0 && isyst ==
compage_1.isysmb[imovbrk]) {
-#line 20603 ""
+#line 20593 ""
c1omget_1.fracindent = compage_1.fracsys[imovbrk - 1];
-#line 20604 ""
+#line 20594 ""
} else {
-#line 20605 ""
+#line 20595 ""
c1omget_1.fracindent = 0.f;
-#line 20606 ""
+#line 20596 ""
}
-#line 20607 ""
+#line 20597 ""
}
-#line 20608 ""
+#line 20598 ""
s_wsfe(&io___1316);
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&poenom, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&nbarss[isyst], (ftnlen)sizeof(integer));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&sumelsk, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&fsyst, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&c1omget_1.fracindent, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
do_fio(&c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real));
-#line 20608 ""
+#line 20598 ""
e_wsfe();
-#line 20610 ""
+#line 20600 ""
ibar1 += nbarss[isyst];
-#line 20611 ""
+#line 20601 ""
/* L22: */
-#line 20611 ""
+#line 20601 ""
}
-#line 20612 ""
+#line 20602 ""
al__1.aerr = 0;
-#line 20612 ""
+#line 20602 ""
al__1.aunit = 12;
-#line 20612 ""
+#line 20602 ""
f_rew(&al__1);
-#line 20613 ""
+#line 20603 ""
o__1.oerr = 0;
-#line 20613 ""
+#line 20603 ""
o__1.ounit = 13;
-#line 20613 ""
+#line 20603 ""
o__1.ofnm = 0;
-#line 20613 ""
+#line 20603 ""
o__1.orl = 0;
-#line 20613 ""
+#line 20603 ""
o__1.osta = "SCRATCH";
-#line 20613 ""
+#line 20603 ""
o__1.oacc = 0;
-#line 20613 ""
+#line 20603 ""
o__1.ofm = 0;
-#line 20613 ""
+#line 20603 ""
o__1.oblnk = 0;
-#line 20613 ""
+#line 20603 ""
f_open(&o__1);
-#line 20614 ""
+#line 20604 ""
s_wsfe(&io___1317);
-#line 20614 ""
+#line 20604 ""
do_fio(&c__1, (char *)&ifig, (ftnlen)sizeof(integer));
-#line 20614 ""
+#line 20604 ""
e_wsfe();
-#line 20615 ""
+#line 20605 ""
al__1.aerr = 0;
-#line 20615 ""
+#line 20605 ""
al__1.aunit = 13;
-#line 20615 ""
+#line 20605 ""
f_rew(&al__1);
-#line 20616 ""
+#line 20606 ""
inbuff_1.ilbuf = 1;
-#line 20617 ""
+#line 20607 ""
inbuff_1.ipbuf = 0;
-#line 20618 ""
+#line 20608 ""
if (! (*optimize)) {
-#line 20619 ""
+#line 20609 ""
s_wsfe(&io___1318);
-#line 20619 ""
+#line 20609 ""
do_fio(&c__1, " Done with first pass", (ftnlen)21);
-#line 20619 ""
+#line 20609 ""
e_wsfe();
-#line 20620 ""
+#line 20610 ""
s_wsle(&io___1319);
-#line 20620 ""
+#line 20610 ""
e_wsle();
-#line 20621 ""
+#line 20611 ""
s_wsfe(&io___1320);
-#line 20621 ""
+#line 20611 ""
do_fio(&c__1, " Done with first pass", (ftnlen)21);
-#line 20621 ""
+#line 20611 ""
e_wsfe();
-#line 20622 ""
+#line 20612 ""
s_wsfe(&io___1321);
-#line 20622 ""
+#line 20612 ""
e_wsfe();
-#line 20623 ""
+#line 20613 ""
}
/* Following syntax is needed since pmxa is called with literal argument .false. */
-#line 20627 ""
+#line 20617 ""
if (*isfirst) {
-#line 20627 ""
+#line 20617 ""
*isfirst = FALSE_;
-#line 20627 ""
+#line 20617 ""
}
-#line 20628 ""
+#line 20618 ""
return 0;
} /* pmxa_ */
@@ -50033,124 +50304,124 @@ L1:
/* Bits in icrdorn are same as in iornq, even tho most orns won't go in crds. */
/* ccccccccccccccccccccccccccccccc */
-#line 21094 ""
+#line 21084 ""
/* Parameter adjustments */
-#line 21094 ""
+#line 21084 ""
--poevec;
-#line 21094 ""
+#line 21084 ""
-#line 21094 ""
+#line 21084 ""
/* Function Body */
-#line 21094 ""
+#line 21084 ""
combottop_1.bottopgap = FALSE_;
-#line 21095 ""
+#line 21085 ""
comlyr_1.inputmlyr = FALSE_;
-#line 21096 ""
+#line 21086 ""
comhair_2.idhairuse = 0;
-#line 21097 ""
+#line 21087 ""
if (! (*optimize)) {
-#line 21098 ""
+#line 21088 ""
s_wsle(&io___1322);
-#line 21098 ""
+#line 21088 ""
e_wsle();
-#line 21099 ""
+#line 21089 ""
s_wsle(&io___1323);
-#line 21099 ""
+#line 21089 ""
do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24);
-#line 21099 ""
+#line 21089 ""
e_wsle();
-#line 21100 ""
+#line 21090 ""
s_wsle(&io___1324);
-#line 21100 ""
+#line 21090 ""
e_wsle();
-#line 21101 ""
+#line 21091 ""
s_wsfe(&io___1325);
-#line 21101 ""
+#line 21091 ""
do_fio(&c__1, "Starting second PMX pass", (ftnlen)24);
-#line 21101 ""
+#line 21091 ""
e_wsfe();
-#line 21102 ""
+#line 21092 ""
}
-#line 21103 ""
+#line 21093 ""
newclef = FALSE_;
-#line 21104 ""
+#line 21094 ""
comclefrests_1.centrests = FALSE_;
-#line 21105 ""
+#line 21095 ""
++(*ncalls);
-#line 21106 ""
+#line 21096 ""
comlast_1.islast = *inlast;
-#line 21107 ""
+#line 21097 ""
commac_1.macuse = 0;
-#line 21108 ""
+#line 21098 ""
isyscnt = 0;
-#line 21109 ""
+#line 21099 ""
all_1.stemmax = 8.2f;
-#line 21110 ""
+#line 21100 ""
all_1.stemmin = 3.9f;
-#line 21111 ""
+#line 21101 ""
all_1.stemlen = 6.f;
-#line 21112 ""
+#line 21102 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 21112 ""
+#line 21102 ""
*(unsigned char *)all_1.sq = *(unsigned char *)&ch__1[0];
-#line 21113 ""
+#line 21103 ""
comignorenats_1.ignorenats = FALSE_;
-#line 21114 ""
+#line 21104 ""
comignorenats_1.newmbrhgt = FALSE_;
-#line 21115 ""
+#line 21105 ""
combc_1.bcspec = TRUE_;
-#line 21116 ""
+#line 21106 ""
comas3_1.topmods = FALSE_;
-#line 21117 ""
+#line 21107 ""
ismbr = FALSE_;
-#line 21118 ""
+#line 21108 ""
s_rsfe(&io___1329);
-#line 21118 ""
+#line 21108 ""
do_fio(&c__1, basenameq, (ftnlen)44);
-#line 21118 ""
+#line 21108 ""
e_rsfe();
-#line 21119 ""
+#line 21109 ""
s_rsle(&io___1331);
-#line 21119 ""
+#line 21109 ""
do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer));
-#line 21119 ""
+#line 21109 ""
e_rsle();
-#line 21120 ""
+#line 21110 ""
s_rsle(&io___1333);
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&comask_1.fbar, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&comask_1.wheadpt, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&etait, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&etatc, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&etacs1, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&etatop, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__4, &c__1, (char *)&etabot, (ftnlen)sizeof(real));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__3, &c__1, (char *)&cominbot_1.inbothd, (ftnlen)sizeof(integer))
;
-#line 21120 ""
+#line 21110 ""
do_lio(&c__3, &c__1, (char *)&inhnoh, (ftnlen)sizeof(integer));
-#line 21120 ""
+#line 21110 ""
do_lio(&c__3, &c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
-#line 21120 ""
+#line 21110 ""
e_rsle();
-#line 21122 ""
+#line 21112 ""
inbuff_1.ilbuf = 1;
-#line 21123 ""
+#line 21113 ""
inbuff_1.ipbuf = 0;
-#line 21124 ""
+#line 21114 ""
getset_(&all_1.nv, &noinst, &all_1.mtrnuml, &all_1.mtrdenl, &all_1.mtrnmp,
&all_1.mtrdnp, &xmtrnum0, &npages, &nsyst, &all_1.musicsize, &
comtop_1.fracindent, &istype0, comtop_1.inameq, comclefq_1.clefq,
all_1.sepsymq, pathnameq, &lpath, &comtop_1.isig0, (ftnlen)79, (
ftnlen)1, (ftnlen)1, (ftnlen)40);
-#line 21127 ""
+#line 21117 ""
if (commidi_1.ismidi) {
/* Initial key signature and meter for pickup bar */
@@ -50163,199 +50434,199 @@ L1:
/* Above is probably cosmetic */
/* call midievent('k',midisig,0) */
-#line 21139 ""
+#line 21129 ""
if (xmtrnum0 > comtol_1.tol) {
/* We have a pickup. Some tricky stuff to get a meter: */
-#line 21143 ""
+#line 21133 ""
xntrial = xmtrnum0;
-#line 21144 ""
+#line 21134 ""
for (ip2 = 0; ip2 <= 5; ++ip2) {
-#line 21145 ""
+#line 21135 ""
if ((r__1 = r_mod(&xntrial, &c_b1053), dabs(r__1)) <
comtol_1.tol) {
-#line 21145 ""
+#line 21135 ""
goto L6;
-#line 21145 ""
+#line 21135 ""
}
-#line 21146 ""
+#line 21136 ""
xntrial *= 2;
-#line 21147 ""
+#line 21137 ""
/* L5: */
-#line 21147 ""
+#line 21137 ""
}
-#line 21148 ""
+#line 21138 ""
s_wsle(&io___1349);
-#line 21148 ""
+#line 21138 ""
do_lio(&c__9, &c__1, "Problem finding meter for pickup bar", (
ftnlen)36);
-#line 21148 ""
+#line 21138 ""
e_wsle();
-#line 21149 ""
+#line 21139 ""
xntrial = 1.f;
-#line 21150 ""
+#line 21140 ""
ip2 = 0;
-#line 21151 ""
+#line 21141 ""
L6:
-#line 21152 ""
+#line 21142 ""
i__1 = i_nint(&xntrial);
-#line 21152 ""
+#line 21142 ""
i__2 = pow_ii(&c__2, &ip2) * all_1.mtrdenl;
-#line 21152 ""
+#line 21142 ""
midievent_("m", &i__1, &i__2, (ftnlen)1);
-#line 21153 ""
+#line 21143 ""
} else {
/* No pickup, enter the starting meter */
-#line 21157 ""
+#line 21147 ""
midievent_("m", &all_1.mtrnuml, &all_1.mtrdenl, (ftnlen)1);
-#line 21158 ""
+#line 21148 ""
}
-#line 21159 ""
+#line 21149 ""
}
/* Set musicsize from value passed in common, due to possible reset by S[n]m16 */
-#line 21163 ""
+#line 21153 ""
all_1.musicsize = commus_1.musize;
-#line 21164 ""
+#line 21154 ""
s_rsle(&io___1350);
-#line 21164 ""
+#line 21154 ""
do_lio(&c__3, &c__1, (char *)&npages, (ftnlen)sizeof(integer));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.widthpt, (ftnlen)sizeof(real));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.height, (ftnlen)sizeof(real));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.hoffpt, (ftnlen)sizeof(real));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&comtop_1.voffpt, (ftnlen)sizeof(real));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__3, &c__1, (char *)&nsyst, (ftnlen)sizeof(integer));
-#line 21164 ""
+#line 21154 ""
i__1 = npages;
-#line 21164 ""
+#line 21154 ""
for (ipa = 1; ipa <= i__1; ++ipa) {
-#line 21164 ""
+#line 21154 ""
do_lio(&c__3, &c__1, (char *)&comnotes_1.nsystp[ipa - 1], (ftnlen)
sizeof(integer));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&xnsttop[ipa - 1], (ftnlen)sizeof(real));
-#line 21164 ""
+#line 21154 ""
do_lio(&c__4, &c__1, (char *)&xintstaff[ipa - 1], (ftnlen)sizeof(real)
);
-#line 21164 ""
+#line 21154 ""
}
-#line 21164 ""
+#line 21154 ""
do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(integer));
-#line 21164 ""
+#line 21154 ""
e_rsle();
/* If default width ever changes, must adjust this stmt. */
-#line 21169 ""
+#line 21159 ""
slfac1 = 2.98156f / comtop_1.widthpt;
-#line 21170 ""
+#line 21160 ""
all_1.figbass = FALSE_;
-#line 21171 ""
+#line 21161 ""
s_rsle(&io___1356);
-#line 21171 ""
+#line 21161 ""
do_lio(&c__3, &c__1, (char *)&ifig, (ftnlen)sizeof(integer));
-#line 21171 ""
+#line 21161 ""
e_rsle();
-#line 21172 ""
+#line 21162 ""
if (ifig == 1) {
-#line 21173 ""
+#line 21163 ""
all_1.figbass = TRUE_;
-#line 21174 ""
+#line 21164 ""
o__1.oerr = 0;
-#line 21174 ""
+#line 21164 ""
o__1.ounit = 14;
-#line 21174 ""
+#line 21164 ""
o__1.ofnm = 0;
-#line 21174 ""
+#line 21164 ""
o__1.orl = 0;
-#line 21174 ""
+#line 21164 ""
o__1.osta = "SCRATCH";
-#line 21174 ""
+#line 21164 ""
o__1.oacc = 0;
-#line 21174 ""
+#line 21164 ""
o__1.ofm = 0;
-#line 21174 ""
+#line 21164 ""
o__1.oblnk = 0;
-#line 21174 ""
+#line 21164 ""
f_open(&o__1);
-#line 21175 ""
+#line 21165 ""
s_wsfe(&io___1358);
/* Writing concatenation */
-#line 21175 ""
+#line 21165 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[1] = 3, a__1[1] = "def";
-#line 21175 ""
+#line 21165 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[3] = 8, a__1[3] = "fixdrop{";
-#line 21175 ""
+#line 21165 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[5] = 7, a__1[5] = "advance";
-#line 21175 ""
+#line 21165 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[7] = 10, a__1[7] = "sysno by 1";
-#line 21175 ""
+#line 21165 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[9] = 6, a__1[9] = "ifcase";
-#line 21175 ""
+#line 21165 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 21175 ""
+#line 21165 ""
i__3[11] = 6, a__1[11] = "sysno%";
-#line 21175 ""
+#line 21165 ""
s_cat(ch__2, a__1, i__3, &c__12, (ftnlen)46);
-#line 21175 ""
+#line 21165 ""
do_fio(&c__1, ch__2, (ftnlen)46);
-#line 21175 ""
+#line 21165 ""
e_wsfe();
-#line 21177 ""
+#line 21167 ""
}
-#line 21178 ""
+#line 21168 ""
comget_1.lastchar = FALSE_;
-#line 21179 ""
+#line 21169 ""
ibcoff = 0;
-#line 21180 ""
+#line 21170 ""
if (xmtrnum0 > 0.f) {
-#line 21180 ""
+#line 21170 ""
ibcoff = -1;
-#line 21180 ""
+#line 21170 ""
}
-#line 21181 ""
+#line 21171 ""
o__1.oerr = 0;
-#line 21181 ""
+#line 21171 ""
o__1.ounit = 11;
-#line 21181 ""
+#line 21171 ""
o__1.ofnm = 0;
-#line 21181 ""
+#line 21171 ""
o__1.orl = 0;
-#line 21181 ""
+#line 21171 ""
o__1.osta = "SCRATCH";
-#line 21181 ""
+#line 21171 ""
o__1.oacc = 0;
-#line 21181 ""
+#line 21171 ""
o__1.ofm = 0;
-#line 21181 ""
+#line 21171 ""
o__1.oblnk = 0;
-#line 21181 ""
+#line 21171 ""
f_open(&o__1);
/* vshrink for the first page is calculated in topfile, */
/* and if true set interstaff=10. vshrink affects Titles. */
/* Must also save vshrink for page ending. */
-#line 21187 ""
+#line 21177 ""
topfile_(basenameq, &lbase, &all_1.nv, comclefq_1.clefq, &noinst, &
all_1.musicsize, xintstaff, &all_1.mtrnmp, &all_1.mtrdnp, &
vshrink, &comask_1.fbar, &comslur_1.fontslur, (ftnlen)44, (ftnlen)
@@ -50363,404 +50634,404 @@ L6:
/* ninow is working value of # of instruments. noinst is max #, and # at start. */
-#line 21192 ""
+#line 21182 ""
comnotes_1.ninow = noinst;
/* Save original printed meter in case movement breaks */
-#line 21196 ""
+#line 21186 ""
comget_1.movnmp = all_1.mtrnmp;
-#line 21197 ""
+#line 21187 ""
comget_1.movdnp = all_1.mtrdnp;
-#line 21199 ""
+#line 21189 ""
if (comlast_1.islast && all_1.figbass && all_1.musicsize == 16) {
-#line 21199 ""
+#line 21189 ""
s_wsfe(&io___1361);
/* Writing concatenation */
-#line 21199 ""
+#line 21189 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 21199 ""
+#line 21189 ""
i__4[1] = 3, a__2[1] = "def";
-#line 21199 ""
+#line 21189 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 21199 ""
+#line 21189 ""
i__4[3] = 8, a__2[3] = "figfont{";
-#line 21199 ""
+#line 21189 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 21199 ""
+#line 21189 ""
i__4[5] = 9, a__2[5] = "eightrm}%";
-#line 21199 ""
+#line 21189 ""
s_cat(ch__3, a__2, i__4, &c__6, (ftnlen)23);
-#line 21199 ""
+#line 21189 ""
do_fio(&c__1, ch__3, (ftnlen)23);
-#line 21199 ""
+#line 21189 ""
e_wsfe();
-#line 21199 ""
+#line 21189 ""
}
-#line 21202 ""
+#line 21192 ""
if (comlast_1.islast && comligfont_1.isligfont) {
-#line 21203 ""
+#line 21193 ""
if (all_1.musicsize == 16) {
-#line 21204 ""
+#line 21194 ""
s_wsfe(&io___1362);
/* Writing concatenation */
-#line 21204 ""
+#line 21194 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21204 ""
+#line 21194 ""
i__5[1] = 4, a__3[1] = "font";
-#line 21204 ""
+#line 21194 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21204 ""
+#line 21194 ""
i__5[3] = 20, a__3[3] = "ligfont=cmrj at 8pt%";
-#line 21204 ""
+#line 21194 ""
s_cat(ch__4, a__3, i__5, &c__4, (ftnlen)26);
-#line 21204 ""
+#line 21194 ""
do_fio(&c__1, ch__4, (ftnlen)26);
-#line 21204 ""
+#line 21194 ""
e_wsfe();
-#line 21205 ""
+#line 21195 ""
} else {
-#line 21206 ""
+#line 21196 ""
s_wsfe(&io___1363);
/* Writing concatenation */
-#line 21206 ""
+#line 21196 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21206 ""
+#line 21196 ""
i__5[1] = 4, a__3[1] = "font";
-#line 21206 ""
+#line 21196 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21206 ""
+#line 21196 ""
i__5[3] = 21, a__3[3] = "ligfont=cmrj at 10pt%";
-#line 21206 ""
+#line 21196 ""
s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
-#line 21206 ""
+#line 21196 ""
do_fio(&c__1, ch__5, (ftnlen)27);
-#line 21206 ""
+#line 21196 ""
e_wsfe();
-#line 21207 ""
+#line 21197 ""
}
-#line 21208 ""
+#line 21198 ""
}
-#line 21209 ""
+#line 21199 ""
lenbeat = ifnodur_(&all_1.mtrdenl, "x", (ftnlen)1);
-#line 21210 ""
+#line 21200 ""
if (all_1.mtrdenl == 2) {
-#line 21210 ""
+#line 21200 ""
lenbeat = 16;
-#line 21210 ""
+#line 21200 ""
}
-#line 21211 ""
+#line 21201 ""
all_1.lenb1 = all_1.mtrnuml * lenbeat;
-#line 21212 ""
+#line 21202 ""
if (all_1.mtrdenl == 2) {
-#line 21212 ""
+#line 21202 ""
all_1.lenb1 <<= 1;
-#line 21212 ""
+#line 21202 ""
}
-#line 21213 ""
+#line 21203 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &ibmrep);
-#line 21214 ""
+#line 21204 ""
r__1 = xmtrnum0 * lenbeat;
-#line 21214 ""
+#line 21204 ""
all_1.lenb0 = i_nint(&r__1);
-#line 21215 ""
+#line 21205 ""
if (all_1.mtrdenl == 2) {
-#line 21215 ""
+#line 21205 ""
all_1.lenb0 <<= 1;
-#line 21215 ""
+#line 21205 ""
}
-#line 21216 ""
+#line 21206 ""
if (all_1.lenb0 != 0) {
-#line 21217 ""
+#line 21207 ""
if (comlast_1.islast) {
-#line 21217 ""
+#line 21207 ""
s_wsfe(&io___1366);
/* Writing concatenation */
-#line 21217 ""
+#line 21207 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21217 ""
+#line 21207 ""
i__5[1] = 7, a__3[1] = "advance";
-#line 21217 ""
+#line 21207 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21217 ""
+#line 21207 ""
i__5[3] = 11, a__3[3] = "barno by -1";
-#line 21217 ""
+#line 21207 ""
s_cat(ch__6, a__3, i__5, &c__4, (ftnlen)20);
-#line 21217 ""
+#line 21207 ""
do_fio(&c__1, ch__6, (ftnlen)20);
-#line 21217 ""
+#line 21207 ""
e_wsfe();
-#line 21217 ""
+#line 21207 ""
}
-#line 21218 ""
+#line 21208 ""
all_1.lenbar = all_1.lenb0;
-#line 21219 ""
+#line 21209 ""
} else {
-#line 21220 ""
+#line 21210 ""
all_1.lenbar = all_1.lenb1;
-#line 21221 ""
+#line 21211 ""
}
/* Initialize full-program variables */
-#line 21225 ""
+#line 21215 ""
comask_1.fixednew = 0.f;
-#line 21226 ""
+#line 21216 ""
comask_1.scaldold = 0.f;
-#line 21227 ""
+#line 21217 ""
comget_1.fintstf = -1.f;
-#line 21228 ""
+#line 21218 ""
comget_1.gintstf = 1.f;
-#line 21229 ""
+#line 21219 ""
comas2_1.nasksys = 0;
-#line 21230 ""
+#line 21220 ""
combibarcnt_1.ibarcnt = 0;
-#line 21231 ""
+#line 21221 ""
all_1.iline = 0;
-#line 21232 ""
+#line 21222 ""
comget_1.movbrk = 0;
-#line 21233 ""
+#line 21223 ""
isystpg = 0;
-#line 21234 ""
+#line 21224 ""
comnotes_1.ipage = 1;
-#line 21235 ""
+#line 21225 ""
all_1.iccount = 128;
-#line 21236 ""
+#line 21226 ""
comas3_1.iask = 0;
-#line 21237 ""
+#line 21227 ""
nhstot = 0;
-#line 21238 ""
+#line 21228 ""
comnsp_2.nb = 1;
-#line 21239 ""
+#line 21229 ""
if (! (*optimize)) {
-#line 21239 ""
+#line 21229 ""
jprntb = 81;
-#line 21239 ""
+#line 21229 ""
}
-#line 21240 ""
+#line 21230 ""
comtop_1.idsig = 0;
-#line 21241 ""
+#line 21231 ""
iflagbot = 0;
/* Next 5 are raise-barno parameters. irzbnd is integer part of default level. */
-#line 21245 ""
+#line 21235 ""
comsln_1.irzbnd = 3;
-#line 21246 ""
+#line 21236 ""
if (comtop_1.isig == 3 && *(unsigned char *)&comclefq_1.clefq[all_1.nv -
1] == 't') {
-#line 21246 ""
+#line 21236 ""
comsln_1.irzbnd = 4;
-#line 21246 ""
+#line 21236 ""
}
-#line 21247 ""
+#line 21237 ""
comsln_1.is1n1 = 0;
-#line 21248 ""
+#line 21238 ""
comsln_1.isnx = 0;
-#line 21249 ""
+#line 21239 ""
comslur_1.slurcurve = 0.f;
-#line 21250 ""
+#line 21240 ""
comshort_1.ishort = 0;
-#line 21251 ""
+#line 21241 ""
comshort_1.nocodabn = FALSE_;
-#line 21252 ""
+#line 21242 ""
comshort_1.mbrsum = 0;
-#line 21253 ""
+#line 21243 ""
comshort_1.nmbr = 0;
/* 111109 Made global rather than per gulp */
-#line 21257 ""
+#line 21247 ""
comdyn_1.ndyn = 0;
-#line 21258 ""
+#line 21248 ""
compoi_1.ispoi = FALSE_;
-#line 21259 ""
+#line 21249 ""
slint = FALSE_;
-#line 21260 ""
+#line 21250 ""
lrptpend = FALSE_;
-#line 21261 ""
+#line 21251 ""
comget_1.rptnd1 = FALSE_;
-#line 21262 ""
+#line 21252 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
-#line 21263 ""
+#line 21253 ""
comget_1.rptprev = FALSE_;
-#line 21264 ""
+#line 21254 ""
onvolt = FALSE_;
-#line 21265 ""
+#line 21255 ""
comnsp_2.flgndb = FALSE_;
-#line 21266 ""
+#line 21256 ""
comget_1.fbon = FALSE_;
-#line 21267 ""
+#line 21257 ""
comnotes_1.shifton = FALSE_;
-#line 21268 ""
+#line 21258 ""
comget_1.ornrpt = FALSE_;
-#line 21269 ""
+#line 21259 ""
comnotes_1.setis = FALSE_;
-#line 21270 ""
+#line 21260 ""
comarp_1.lowdot = FALSE_;
-#line 21271 ""
+#line 21261 ""
comnvi_1.rename = FALSE_;
-#line 21272 ""
+#line 21262 ""
comnotes_1.nobar1 = FALSE_;
-#line 21273 ""
+#line 21263 ""
comget_1.equalize = FALSE_;
-#line 21274 ""
+#line 21264 ""
comlast_1.usevshrink = TRUE_;
-#line 21275 ""
+#line 21265 ""
comslur_1.wrotepsslurdefaults = FALSE_;
-#line 21276 ""
+#line 21266 ""
comnotes_1.optlinebreakties = FALSE_;
-#line 21277 ""
+#line 21267 ""
comnotes_1.headerspecial = FALSE_;
/* vshrink is initialized in topfile */
-#line 21281 ""
+#line 21271 ""
comget_1.stickys = FALSE_;
/* ixrest = 1 or 2 if xtup has started with a rest */
-#line 21285 ""
+#line 21275 ""
for (commvl_1.ivx = 1; commvl_1.ivx <= 24; ++commvl_1.ivx) {
-#line 21286 ""
+#line 21276 ""
strtmid_1.ixrest[commvl_1.ivx - 1] = 0;
-#line 21287 ""
+#line 21277 ""
comfig_1.fullsize[commvl_1.ivx - 1] = 1.f;
/* Set legacy note level to middle c as default */
-#line 21291 ""
+#line 21281 ""
comnotes_1.ndlev[commvl_1.ivx - 1] = 29;
-#line 21292 ""
+#line 21282 ""
comnotes_1.ndlev[commvl_1.ivx + 23] = 29;
-#line 21293 ""
+#line 21283 ""
/* L1: */
-#line 21293 ""
+#line 21283 ""
}
-#line 21294 ""
+#line 21284 ""
comnotes_1.npreslur = 0;
-#line 21295 ""
+#line 21285 ""
nhssys = 0;
-#line 21296 ""
+#line 21286 ""
comslur_1.listslur = 0;
-#line 21297 ""
+#line 21287 ""
for (i__ = 1; i__ <= 202; ++i__) {
-#line 21298 ""
+#line 21288 ""
all_1.isdat1[i__ - 1] = 0;
-#line 21299 ""
+#line 21289 ""
all_1.isdat2[i__ - 1] = 0;
-#line 21300 ""
+#line 21290 ""
/* L31: */
-#line 21300 ""
+#line 21290 ""
}
-#line 21301 ""
+#line 21291 ""
all_1.nsdat = 0;
/* Initialize flag for figures in any other voice than 1 */
-#line 21305 ""
+#line 21295 ""
comfig_1.ivxfig2 = 0;
/* Initialize for loop over gulps */
-#line 21309 ""
+#line 21299 ""
all_1.firstgulp = TRUE_;
/* Start a gulp */
-#line 21313 ""
+#line 21303 ""
L30:
-#line 21313 ""
+#line 21303 ""
loop = TRUE_;
-#line 21314 ""
+#line 21304 ""
comnotes_1.notcrd = TRUE_;
-#line 21315 ""
+#line 21305 ""
combjmp_1.isbjmp = FALSE_;
-#line 21316 ""
+#line 21306 ""
combjmp_1.isbj2 = FALSE_;
-#line 21317 ""
+#line 21307 ""
comfb_1.autofbon = FALSE_;
-#line 21318 ""
+#line 21308 ""
comfb_1.tautofb = 0.f;
-#line 21319 ""
+#line 21309 ""
all_1.nbars = 0;
-#line 21320 ""
+#line 21310 ""
comfig_1.nfigs[0] = 0;
-#line 21321 ""
+#line 21311 ""
comfig_1.nfigs[1] = 0;
-#line 21322 ""
+#line 21312 ""
comgrace_1.ngrace = 0;
-#line 21323 ""
+#line 21313 ""
comtrill_1.ntrill = 0;
-#line 21324 ""
+#line 21314 ""
comtrill_1.ncrd = 0;
-#line 21325 ""
+#line 21315 ""
comtrill_1.nudorn = 0;
-#line 21326 ""
+#line 21316 ""
comgrace_1.nlit = 0;
-#line 21327 ""
+#line 21317 ""
comgrace_1.nvolt = 0;
-#line 21328 ""
+#line 21318 ""
comgrace_1.ibarmbr = 0;
-#line 21329 ""
+#line 21319 ""
comudsp_1.nudsp = 0;
/* ndyn = 0 ! 111109 */
-#line 21331 ""
+#line 21321 ""
comdyn_1.ntxtdyn = 0;
-#line 21332 ""
+#line 21322 ""
comcb_1.nbc = 0;
-#line 21333 ""
+#line 21323 ""
comarpshift_1.numarpshift = 0;
-#line 21334 ""
+#line 21324 ""
for (i__ = 1; i__ <= 37; ++i__) {
-#line 21335 ""
+#line 21325 ""
comgrace_1.graspace[i__ - 1] = 0.f;
-#line 21336 ""
+#line 21326 ""
/* L3: */
-#line 21336 ""
+#line 21326 ""
}
/* Now initialize up to nv. Do it in getnote as r'qd for 2nd voices per syst. */
/* and also if nv increases in an 'M' directive. */
-#line 21341 ""
+#line 21331 ""
i__1 = all_1.nv;
-#line 21341 ""
+#line 21331 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 21342 ""
+#line 21332 ""
newvoice_(&all_1.iv, comclefq_1.clefq + (all_1.iv - 1), &c_false, (
ftnlen)1);
-#line 21343 ""
+#line 21333 ""
/* L4: */
-#line 21343 ""
+#line 21333 ""
}
/* Check if endsymbol was set earlier */
-#line 21347 ""
+#line 21337 ""
if (comget_1.rptnd1) {
-#line 21348 ""
+#line 21338 ""
comget_1.rptnd1 = FALSE_;
-#line 21349 ""
+#line 21339 ""
*(unsigned char *)comget_1.rptfq2 = *(unsigned char *)comget_1.rptfq1;
-#line 21350 ""
+#line 21340 ""
} else {
/* Only use if movbrk>0, to signal default ('RD') */
-#line 21354 ""
+#line 21344 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
-#line 21355 ""
+#line 21345 ""
}
-#line 21356 ""
+#line 21346 ""
all_1.iv = 1;
-#line 21357 ""
+#line 21347 ""
commvl_1.ivx = 1;
-#line 21358 ""
+#line 21348 ""
L2:
-#line 21358 ""
+#line 21348 ""
if (loop) {
/* Within this loop, nv voices are filled up for the duration of the block. */
@@ -50770,212 +51041,212 @@ L2:
/* Only at the beginning of an input block will there be a possible mtr change, */
/* signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) */
-#line 21367 ""
+#line 21357 ""
getnote_(&loop);
-#line 21368 ""
+#line 21358 ""
if (comget_1.lastchar) {
-#line 21368 ""
+#line 21358 ""
goto L40;
-#line 21368 ""
+#line 21358 ""
}
-#line 21369 ""
+#line 21359 ""
goto L2;
-#line 21370 ""
+#line 21360 ""
}
/* Finished an input block (gulp). */
-#line 21374 ""
+#line 21364 ""
if (commidi_1.ismidi) {
/* Put rests into midi array for 2nd lines that were not used in this gulp. */
-#line 21378 ""
+#line 21368 ""
i__1 = all_1.nv;
-#line 21378 ""
+#line 21368 ""
for (all_1.iv = 1; all_1.iv <= i__1; ++all_1.iv) {
-#line 21379 ""
+#line 21369 ""
if (commidi_1.twoline[all_1.iv - 1] && commvl_1.nvmx[all_1.iv - 1]
== 1) {
-#line 21380 ""
+#line 21370 ""
if (all_1.firstgulp && all_1.lenb0 != 0) {
-#line 21381 ""
+#line 21371 ""
r__1 = (all_1.nbars - 1.f) * all_1.lenbar + all_1.lenb0;
-#line 21381 ""
+#line 21371 ""
addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
&c__0, &r__1, &c_true, &c_false);
-#line 21383 ""
+#line 21373 ""
} else {
-#line 21384 ""
+#line 21374 ""
r__1 = all_1.nbars * 1.f * all_1.lenbar;
-#line 21384 ""
+#line 21374 ""
addmidi_(&commidi_1.midchan[all_1.iv + 23], &c__0, &c__0,
&c__0, &r__1, &c_true, &c_false);
-#line 21386 ""
+#line 21376 ""
}
-#line 21387 ""
+#line 21377 ""
}
-#line 21388 ""
+#line 21378 ""
/* L60: */
-#line 21388 ""
+#line 21378 ""
}
-#line 21389 ""
+#line 21379 ""
}
-#line 21390 ""
+#line 21380 ""
comgrace_1.nvolt = 0;
-#line 21391 ""
+#line 21381 ""
for (all_1.iv = 1; all_1.iv <= 24; ++all_1.iv) {
-#line 21392 ""
+#line 21382 ""
comudsp_1.nudoff[all_1.iv - 1] = 0;
-#line 21393 ""
+#line 21383 ""
comcc_1.maxdotmv[all_1.iv - 1] = comcc_1.ndotmv[all_1.iv - 1];
-#line 21394 ""
+#line 21384 ""
comcc_1.ndotmv[all_1.iv - 1] = 0;
-#line 21395 ""
+#line 21385 ""
/* L28: */
-#line 21395 ""
+#line 21385 ""
}
/* Put stuff at top of p.1. Must wait until now to have read title info. */
-#line 21399 ""
+#line 21389 ""
if (combibarcnt_1.ibarcnt == 0) {
-#line 21400 ""
+#line 21390 ""
puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &etatop, all_1.sq,
&etait, &etatc, &etacs1, &all_1.nv, &vshrink, all_1.sepsymq, (
ftnlen)1, (ftnlen)1);
-#line 21402 ""
+#line 21392 ""
if (comnotes_1.headerspecial) {
-#line 21402 ""
+#line 21392 ""
s_wsfe(&io___1377);
/* Writing concatenation */
-#line 21402 ""
+#line 21392 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 21402 ""
+#line 21392 ""
i__6[0] = 1, a__4[0] = ch__1;
-#line 21402 ""
+#line 21392 ""
i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%";
-#line 21402 ""
+#line 21392 ""
s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
-#line 21402 ""
+#line 21392 ""
do_fio(&c__1, ch__7, (ftnlen)29);
-#line 21402 ""
+#line 21392 ""
e_wsfe();
-#line 21402 ""
+#line 21392 ""
}
/* Write special header for first page */
-#line 21407 ""
+#line 21397 ""
}
-#line 21408 ""
+#line 21398 ""
i__1 = all_1.nbars;
-#line 21408 ""
+#line 21398 ""
for (all_1.ibar = 1; all_1.ibar <= i__1; ++all_1.ibar) {
-#line 21409 ""
+#line 21399 ""
++combibarcnt_1.ibarcnt;
-#line 21410 ""
+#line 21400 ""
comask_1.bar1syst = combibarcnt_1.ibarcnt == iauto;
/* Computing MAX */
-#line 21411 ""
+#line 21401 ""
r__1 = combibarcnt_1.ibarcnt + .001f + ibcoff;
-#line 21411 ""
+#line 21401 ""
i__2 = 0, i__7 = (integer) r_lg10(&r__1);
-#line 21411 ""
+#line 21401 ""
ndig = max(i__2,i__7);
-#line 21412 ""
+#line 21402 ""
if (comlast_1.islast) {
-#line 21412 ""
+#line 21402 ""
ci__1.cierr = 0;
-#line 21412 ""
+#line 21402 ""
ci__1.ciunit = 11;
/* Writing concatenation */
-#line 21412 ""
+#line 21402 ""
i__8[0] = 6, a__5[0] = "(a11,i";
-#line 21412 ""
+#line 21402 ""
i__2 = ndig + 50;
-#line 21412 ""
+#line 21402 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 21412 ""
+#line 21402 ""
i__8[1] = 1, a__5[1] = ch__1;
-#line 21412 ""
+#line 21402 ""
i__8[2] = 1, a__5[2] = ")";
-#line 21412 ""
+#line 21402 ""
ci__1.cifmt = (s_cat(ch__8, a__5, i__8, &c__3, (ftnlen)8), ch__8);
-#line 21412 ""
+#line 21402 ""
s_wsfe(&ci__1);
-#line 21412 ""
+#line 21402 ""
do_fio(&c__1, "% Bar count", (ftnlen)11);
-#line 21412 ""
+#line 21402 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff;
-#line 21412 ""
+#line 21402 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
-#line 21412 ""
+#line 21402 ""
e_wsfe();
-#line 21412 ""
+#line 21402 ""
}
-#line 21415 ""
+#line 21405 ""
if (all_1.ibar != comgrace_1.ibarmbr) {
-#line 21416 ""
+#line 21406 ""
if (! (*optimize)) {
-#line 21416 ""
+#line 21406 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
-#line 21416 ""
+#line 21406 ""
outbar_(&i__2, &jprntb);
-#line 21416 ""
+#line 21406 ""
}
-#line 21417 ""
+#line 21407 ""
} else {
-#line 21418 ""
+#line 21408 ""
if (! (*optimize)) {
-#line 21419 ""
+#line 21409 ""
s_wsfe(&io___1379);
-#line 21419 ""
+#line 21409 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
-#line 21419 ""
+#line 21409 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
-#line 21419 ""
+#line 21409 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 21419 ""
+#line 21409 ""
do_fio(&c__1, "-", (ftnlen)1);
-#line 21419 ""
+#line 21409 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
-#line 21419 ""
+#line 21409 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
-#line 21419 ""
+#line 21409 ""
e_wsfe();
-#line 21421 ""
+#line 21411 ""
s_wsfe(&io___1380);
-#line 21421 ""
+#line 21411 ""
do_fio(&c__1, " Multibar rest, bars", (ftnlen)20);
-#line 21421 ""
+#line 21411 ""
i__2 = combibarcnt_1.ibarcnt + ibcoff;
-#line 21421 ""
+#line 21411 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 21421 ""
+#line 21411 ""
do_fio(&c__1, "-", (ftnlen)1);
-#line 21421 ""
+#line 21411 ""
i__7 = combibarcnt_1.ibarcnt + ibcoff + comgrace_1.mbrest - 1;
-#line 21421 ""
+#line 21411 ""
do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(integer));
-#line 21421 ""
+#line 21411 ""
e_wsfe();
-#line 21423 ""
+#line 21413 ""
jprntb = 0;
-#line 21424 ""
+#line 21414 ""
}
-#line 21425 ""
+#line 21415 ""
ibcoff = ibcoff + comgrace_1.mbrest - 1;
/* if (ibar.eq.1 .and. firstgulp .and. */
/* * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize */
-#line 21428 ""
+#line 21418 ""
if (all_1.ibar == 1 && all_1.firstgulp && ! bit_test(all_1.islur[
0],5)) {
-#line 21428 ""
+#line 21418 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
-#line 21428 ""
+#line 21418 ""
}
-#line 21430 ""
+#line 21420 ""
}
/* Move the read to after end-of-bar hardspace checks, so we get right poenom */
@@ -50992,137 +51263,137 @@ L2:
/* compute additional pts and store them in hpttot(1...nhstot). Finally in */
/* subroutine askfig, write true pts where placeholders are. */
-#line 21446 ""
+#line 21436 ""
ioff = 0;
-#line 21447 ""
+#line 21437 ""
if (all_1.ibar > 1) {
-#line 21447 ""
+#line 21437 ""
ioff = all_1.nib[(all_1.ibar - 1) * 24 - 24];
-#line 21447 ""
+#line 21437 ""
}
-#line 21448 ""
+#line 21438 ""
clchb = bit_test(all_1.islur[(ioff + 1) * 24 - 24],15);
-#line 21449 ""
+#line 21439 ""
putmbr = FALSE_;
-#line 21450 ""
+#line 21440 ""
if (ismbr) {
-#line 21451 ""
+#line 21441 ""
if (clchb) {
/* cc */
/* cc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */
/* cc */
-#line 21455 ""
+#line 21445 ""
s_wsfe(&io___1384);
/* Writing concatenation */
-#line 21455 ""
+#line 21445 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 21455 ""
+#line 21445 ""
i__9[1] = 3, a__6[1] = "let";
-#line 21455 ""
+#line 21445 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 21455 ""
+#line 21445 ""
i__9[3] = 4, a__6[3] = "mbrt";
-#line 21455 ""
+#line 21445 ""
i__9[4] = 1, a__6[4] = all_1.sq;
-#line 21455 ""
+#line 21445 ""
i__9[5] = 6, a__6[5] = "mbrest";
-#line 21455 ""
+#line 21445 ""
i__9[6] = 1, a__6[6] = all_1.sq;
-#line 21455 ""
+#line 21445 ""
i__9[7] = 3, a__6[7] = "def";
-#line 21455 ""
+#line 21445 ""
i__9[8] = 1, a__6[8] = all_1.sq;
-#line 21455 ""
+#line 21445 ""
i__9[9] = 14, a__6[9] = "mbrest#1#2#3{%";
-#line 21455 ""
+#line 21445 ""
s_cat(ch__9, a__6, i__9, &c__10, (ftnlen)35);
-#line 21455 ""
+#line 21445 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 21455 ""
+#line 21445 ""
e_wsfe();
-#line 21457 ""
+#line 21447 ""
s_wsfe(&io___1385);
/* Writing concatenation */
-#line 21457 ""
+#line 21447 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21457 ""
+#line 21447 ""
i__6[1] = 13, a__4[1] = "mbrt{#1}{#2}{";
-#line 21457 ""
+#line 21447 ""
s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
-#line 21457 ""
+#line 21447 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 21457 ""
+#line 21447 ""
r__1 = all_1.musicsize * .55f;
-#line 21457 ""
+#line 21447 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
/* Writing concatenation */
-#line 21457 ""
+#line 21447 ""
i__10[0] = 1, a__7[0] = "}";
-#line 21457 ""
+#line 21447 ""
i__10[1] = 1, a__7[1] = all_1.sq;
-#line 21457 ""
+#line 21447 ""
i__10[2] = 6, a__7[2] = "global";
-#line 21457 ""
+#line 21447 ""
i__10[3] = 1, a__7[3] = all_1.sq;
-#line 21457 ""
+#line 21447 ""
i__10[4] = 3, a__7[4] = "let";
-#line 21457 ""
+#line 21447 ""
i__10[5] = 1, a__7[5] = all_1.sq;
-#line 21457 ""
+#line 21447 ""
i__10[6] = 6, a__7[6] = "mbrest";
-#line 21457 ""
+#line 21447 ""
i__10[7] = 1, a__7[7] = all_1.sq;
-#line 21457 ""
+#line 21447 ""
i__10[8] = 6, a__7[8] = "mbrt}%";
-#line 21457 ""
+#line 21447 ""
s_cat(ch__4, a__7, i__10, &c__9, (ftnlen)26);
-#line 21457 ""
+#line 21447 ""
do_fio(&c__1, ch__4, (ftnlen)26);
-#line 21457 ""
+#line 21447 ""
e_wsfe();
/* c */
/* c RDT suggestion is inset blank barline - 160103 Abandoned */
/* c */
/* write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' */
/* * //sq//'advance'//sq//'barno-1' */
-#line 21464 ""
+#line 21454 ""
}
-#line 21465 ""
+#line 21455 ""
ismbr = FALSE_;
-#line 21466 ""
+#line 21456 ""
putmbr = TRUE_;
-#line 21467 ""
+#line 21457 ""
}
-#line 21468 ""
+#line 21458 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
-#line 21468 ""
+#line 21458 ""
ismbr = TRUE_;
-#line 21468 ""
+#line 21458 ""
}
/* Set flag here so at start of next bar, if there's a clef change, can add space */
/* after the mbr with the above kluge */
-#line 21473 ""
+#line 21463 ""
if (! (clchb || comnsp_2.flgndb)) {
-#line 21473 ""
+#line 21463 ""
goto L23;
-#line 21473 ""
+#line 21463 ""
}
/* Must check available space */
-#line 21477 ""
+#line 21467 ""
ptsndb = 0.f;
/* Zero out block signal */
-#line 21481 ""
+#line 21471 ""
if (clchb) {
-#line 21481 ""
+#line 21471 ""
all_1.islur[(ioff + 1) * 24 - 24] = bit_clear(all_1.islur[(ioff +
1) * 24 - 24],15);
-#line 21481 ""
+#line 21471 ""
}
/* In this loop, we determine how much hardspace is needed (if any) */
@@ -51132,239 +51403,241 @@ L2:
/* one. */
/* 4/18/98 Apparently nmxsav was a solution to the above problem */
-#line 21490 ""
+#line 21480 ""
i__2 = all_1.nv;
-#line 21490 ""
+#line 21480 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
-#line 21491 ""
+#line 21481 ""
i__7 = comnsp_2.nvmxsav[all_1.iv - 1];
-#line 21491 ""
+#line 21481 ""
for (kv = 1; kv <= i__7; ++kv) {
-#line 21492 ""
+#line 21482 ""
commvl_1.ivx = comnsp_2.ivmxsav[all_1.iv + kv * 24 - 25];
-#line 21493 ""
+#line 21483 ""
ptsndv = comnsp_2.flgndv[commvl_1.ivx - 1] * comask_1.wheadpt;
-#line 21494 ""
+#line 21484 ""
ioff = 0;
-#line 21495 ""
+#line 21485 ""
if (all_1.ibar > 1) {
-#line 21496 ""
+#line 21486 ""
ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
25];
-#line 21497 ""
+#line 21487 ""
ip = ioff;
-#line 21498 ""
+#line 21488 ""
if (all_1.ibar > 2) {
-#line 21498 ""
+#line 21488 ""
ip = ioff - all_1.nib[commvl_1.ivx + (all_1.ibar - 2)
* 24 - 25];
-#line 21498 ""
+#line 21488 ""
}
/* prevtn(ivx) = tnote(iand(ipl(ivx,ip),255)) */
-#line 21500 ""
+#line 21490 ""
comnsp_2.prevtn[commvl_1.ivx - 1] = all_1.tnote[
comipl2_1.ipl2[commvl_1.ivx + ip * 24 - 25] - 1];
/* If ibar=1 (1st bar in input block), prevtn(ivx) was set at end of makeabar. */
-#line 21504 ""
+#line 21494 ""
}
/* Only allow clef changes when ivx <= nv */
-#line 21508 ""
+#line 21498 ""
if (commvl_1.ivx <= all_1.nv) {
-#line 21509 ""
+#line 21499 ""
clchv[all_1.iv - 1] = clchb && bit_test(all_1.islur[
all_1.iv + (ioff + 1) * 24 - 25],11);
-#line 21510 ""
+#line 21500 ""
if (clchv[all_1.iv - 1]) {
/* Clef change in this voice. Turn off signal. Get space avail. */
-#line 21514 ""
+#line 21504 ""
all_1.islur[all_1.iv + (ioff + 1) * 24 - 25] =
bit_clear(all_1.islur[all_1.iv + (ioff + 1) *
24 - 25],11);
-#line 21515 ""
+#line 21505 ""
if ((r__1 = comnsp_2.prevtn[all_1.iv - 1] -
comnsp_2.space[comnsp_2.nb - 1], dabs(r__1)) <
comtol_1.tol) {
-#line 21515 ""
+#line 21505 ""
ptsndv += combmh_1.clefend * comask_1.wheadpt;
-#line 21515 ""
+#line 21505 ""
}
-#line 21517 ""
+#line 21507 ""
}
-#line 21518 ""
+#line 21508 ""
}
/* Computing MAX */
-#line 21519 ""
+#line 21509 ""
r__1 = ptsndb, r__2 = ptsndv + comask_1.wheadpt *
spfacs_1.xspfac;
-#line 21519 ""
+#line 21509 ""
ptsndb = dmax(r__1,r__2);
-#line 21520 ""
-/* L16: */
-#line 21520 ""
+#line 21510 ""
+/* L1699: */
+#line 21510 ""
}
-#line 21520 ""
+#line 21511 ""
+/* L16: */
+#line 21511 ""
}
/* ???? where is nb set??? nb probably in left over from makeabar */
-#line 21524 ""
+#line 21515 ""
r__1 = comnsp_2.space[comnsp_2.nb - 1] * squez[comnsp_2.nb - 1];
-#line 21524 ""
+#line 21515 ""
esk = feon_(&r__1);
-#line 21525 ""
+#line 21516 ""
ptsdflt = esk * comask_1.poenom - comask_1.wheadpt;
/* if ((ptsndb.gt.ptsdflt.or.ptsgnd.gt.0.) .and. movbrk.eq.0) then */
-#line 21527 ""
+#line 21518 ""
if ((ptsndb > ptsdflt || comnsp_2.ptsgnd > 0.f) && comget_1.movbrk ==
0 && ! putmbr) {
/* Must ADD hardspace! So put in a placeholder, and store params for later. */
-#line 21532 ""
+#line 21523 ""
if (comlast_1.islast) {
-#line 21532 ""
+#line 21523 ""
s_wsfe(&io___1394);
/* Writing concatenation */
-#line 21532 ""
+#line 21523 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21532 ""
+#line 21523 ""
i__6[1] = 18, a__4[1] = "xardspace{ pt}%";
-#line 21532 ""
+#line 21523 ""
s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
-#line 21532 ""
+#line 21523 ""
do_fio(&c__1, ch__11, (ftnlen)19);
-#line 21532 ""
+#line 21523 ""
e_wsfe();
-#line 21532 ""
+#line 21523 ""
}
-#line 21533 ""
+#line 21524 ""
++nhssys;
-#line 21534 ""
+#line 21525 ""
if (ptsndb - ptsdflt > comnsp_2.ptsgnd - comask_1.poenom *
comnsp_2.eskgnd) {
-#line 21535 ""
+#line 21526 ""
hesk[nhssys - 1] = esk;
-#line 21536 ""
+#line 21527 ""
hpts[nhssys - 1] = ptsndb + comask_1.wheadpt;
-#line 21537 ""
+#line 21528 ""
} else {
-#line 21538 ""
+#line 21529 ""
hesk[nhssys - 1] = comnsp_2.eskgnd;
-#line 21539 ""
+#line 21530 ""
hpts[nhssys - 1] = comnsp_2.ptsgnd + comask_1.wheadpt;
-#line 21540 ""
+#line 21531 ""
}
-#line 21541 ""
+#line 21532 ""
comask_1.fixednew += hpts[nhssys - 1];
-#line 21542 ""
+#line 21533 ""
comask_1.scaldold += hesk[nhssys - 1];
-#line 21543 ""
+#line 21534 ""
}
-#line 21544 ""
+#line 21535 ""
if (clchb) {
-#line 21545 ""
- i__7 = all_1.nv;
-#line 21545 ""
- for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
-#line 21546 ""
+#line 21536 ""
+ i__2 = all_1.nv;
+#line 21536 ""
+ for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 21537 ""
if (clchv[all_1.iv - 1]) {
/* Writing concatenation */
-#line 21547 ""
+#line 21538 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21547 ""
+#line 21538 ""
i__6[1] = 6, a__4[1] = "znotes";
-#line 21547 ""
+#line 21538 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 21548 ""
+#line 21539 ""
lnote = 7;
-#line 21549 ""
- i__2 = all_1.iv;
-#line 21549 ""
- for (iiv = 2; iiv <= i__2; ++iiv) {
+#line 21540 ""
+ i__7 = all_1.iv;
+#line 21540 ""
+ for (iiv = 2; iiv <= i__7; ++iiv) {
/* Writing concatenation */
-#line 21550 ""
+#line 21541 ""
i__6[0] = lnote, a__4[0] = notexq;
-#line 21550 ""
+#line 21541 ""
i__6[1] = 1, a__4[1] = all_1.sepsymq + (iiv - 2);
-#line 21550 ""
+#line 21541 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 21551 ""
+#line 21542 ""
++lnote;
-#line 21552 ""
+#line 21543 ""
/* L24: */
-#line 21552 ""
+#line 21543 ""
}
/* Recompute ioff since it will vary from voice to voice */
-#line 21556 ""
+#line 21547 ""
if (all_1.ibar == 1) {
-#line 21557 ""
+#line 21548 ""
ioff = 0;
-#line 21558 ""
+#line 21549 ""
} else {
-#line 21559 ""
+#line 21550 ""
ioff = all_1.nib[all_1.iv + (all_1.ibar - 1) * 24 -
25];
-#line 21560 ""
+#line 21551 ""
}
/* Must call clefsym to get nclef, even if there is a movement break */
-#line 21564 ""
+#line 21555 ""
clefsym_(&all_1.islur[all_1.iv + (ioff + 1) * 24 - 25],
fmtq, &lclef, &nclef, (ftnlen)24);
/* If clefq = '8', must change '0' in pos'n 9 to '8' */
-#line 21568 ""
+#line 21559 ""
if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2)
) {
/* Writing concatenation */
-#line 21568 ""
+#line 21559 ""
i__8[0] = 8, a__5[0] = fmtq;
-#line 21568 ""
+#line 21559 ""
i__8[1] = 1, a__5[1] = "8";
-#line 21568 ""
+#line 21559 ""
i__8[2] = 1, a__5[2] = fmtq + 9;
-#line 21568 ""
+#line 21559 ""
s_cat(fmtq, a__5, i__8, &c__3, (ftnlen)24);
-#line 21568 ""
+#line 21559 ""
}
-#line 21570 ""
+#line 21561 ""
if (comget_1.movbrk == 0 && comlast_1.islast) {
-#line 21570 ""
+#line 21561 ""
s_wsfe(&io___1403);
/* Writing concatenation */
-#line 21570 ""
+#line 21561 ""
i__5[0] = lnote, a__3[0] = notexq;
-#line 21570 ""
+#line 21561 ""
i__5[1] = lclef, a__3[1] = fmtq;
-#line 21570 ""
+#line 21561 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21570 ""
+#line 21561 ""
i__5[3] = 3, a__3[3] = "en%";
-#line 21570 ""
+#line 21561 ""
s_cat(ch__12, a__3, i__5, &c__4, (ftnlen)107);
-#line 21570 ""
+#line 21561 ""
do_fio(&c__1, ch__12, lnote + lclef + 4);
-#line 21570 ""
+#line 21561 ""
e_wsfe();
-#line 21570 ""
+#line 21561 ""
}
-#line 21573 ""
+#line 21564 ""
wsclef_(&all_1.iv, &comnotes_1.ninow, &nclef);
/* Set new flag to be used just outside this loop, to kluge */
/* any calls to \CenterBar for full-bar rests, to make room for clef. */
-#line 21578 ""
+#line 21569 ""
newclef = TRUE_;
/* 151220 */
@@ -51374,614 +51647,614 @@ L2:
/* and if we change from TLO to normal clef, need to resetclefsymbols */
/* if (clefq(iv) .eq. '8') then */
-#line 21587 ""
+#line 21578 ""
if (bit_test(all_1.ipl[all_1.iv + (ioff + 1) * 24 - 25],2)
) {
/* Find instrument number for voice iv */
-#line 21591 ""
+#line 21582 ""
iv1 = 1;
-#line 21592 ""
- i__2 = comnotes_1.ninow;
-#line 21592 ""
- for (iinst = 1; iinst <= i__2; ++iinst) {
-#line 21593 ""
+#line 21583 ""
+ i__7 = comnotes_1.ninow;
+#line 21583 ""
+ for (iinst = 1; iinst <= i__7; ++iinst) {
+#line 21584 ""
if (all_1.iv < iv1 + comnvi_1.nspern[iinst - 1]) {
-#line 21593 ""
+#line 21584 ""
goto L2222;
-#line 21593 ""
+#line 21584 ""
}
-#line 21594 ""
+#line 21585 ""
iv1 += comnvi_1.nspern[iinst - 1];
-#line 21595 ""
+#line 21586 ""
/* L1111: */
-#line 21595 ""
+#line 21586 ""
}
-#line 21596 ""
+#line 21587 ""
s_wsle(&io___1406);
-#line 21596 ""
+#line 21587 ""
e_wsle();
-#line 21597 ""
+#line 21588 ""
s_wsle(&io___1407);
-#line 21597 ""
+#line 21588 ""
do_lio(&c__9, &c__1, "Should not be here in pmxb!", (
ftnlen)27);
-#line 21597 ""
+#line 21588 ""
e_wsle();
-#line 21598 ""
+#line 21589 ""
stop1_();
-#line 21599 ""
+#line 21590 ""
L2222:
-#line 21600 ""
+#line 21591 ""
if (iinst <= 9) {
-#line 21601 ""
+#line 21592 ""
s_wsfe(&io___1408);
/* Writing concatenation */
-#line 21601 ""
+#line 21592 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21601 ""
+#line 21592 ""
i__6[1] = 19, a__4[1] = "settrebleclefsymbol";
-#line 21601 ""
+#line 21592 ""
s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20);
-#line 21601 ""
+#line 21592 ""
do_fio(&c__1, ch__6, (ftnlen)20);
-#line 21601 ""
+#line 21592 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
-#line 21601 ""
+#line 21592 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 21601 ""
+#line 21592 ""
i__11[1] = 13, a__8[1] = "treblelowoct%";
-#line 21601 ""
+#line 21592 ""
s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14);
-#line 21601 ""
+#line 21592 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 21601 ""
+#line 21592 ""
e_wsfe();
-#line 21603 ""
+#line 21594 ""
} else {
-#line 21604 ""
+#line 21595 ""
s_wsfe(&io___1409);
/* Writing concatenation */
-#line 21604 ""
+#line 21595 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21604 ""
+#line 21595 ""
i__6[1] = 19, a__4[1] = "settrebleclefsymbol";
-#line 21604 ""
+#line 21595 ""
s_cat(ch__6, a__4, i__6, &c__2, (ftnlen)20);
-#line 21604 ""
+#line 21595 ""
do_fio(&c__1, ch__6, (ftnlen)20);
-#line 21604 ""
+#line 21595 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(
integer));
/* Writing concatenation */
-#line 21604 ""
+#line 21595 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 21604 ""
+#line 21595 ""
i__11[1] = 13, a__8[1] = "treblelowoct%";
-#line 21604 ""
+#line 21595 ""
s_cat(ch__10, a__8, i__11, &c__2, (ftnlen)14);
-#line 21604 ""
+#line 21595 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 21604 ""
+#line 21595 ""
e_wsfe();
-#line 21606 ""
+#line 21597 ""
}
-#line 21607 ""
+#line 21598 ""
comc8flag_1.c8flag[all_1.iv - 1] = TRUE_;
-#line 21608 ""
+#line 21599 ""
} else {
-#line 21609 ""
+#line 21600 ""
if (*(unsigned char *)&comclefq_1.clefq[all_1.iv - 1]
== '8') {
-#line 21610 ""
+#line 21601 ""
s_wsfe(&io___1410);
/* Writing concatenation */
-#line 21610 ""
+#line 21601 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21610 ""
+#line 21601 ""
i__6[1] = 16, a__4[1] = "resetclefsymbols";
-#line 21610 ""
+#line 21601 ""
s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)17);
-#line 21610 ""
+#line 21601 ""
do_fio(&c__1, ch__13, (ftnlen)17);
-#line 21610 ""
+#line 21601 ""
e_wsfe();
-#line 21611 ""
+#line 21602 ""
}
-#line 21612 ""
+#line 21603 ""
}
-#line 21613 ""
+#line 21604 ""
}
-#line 21614 ""
+#line 21605 ""
/* L17: */
-#line 21614 ""
+#line 21605 ""
}
-#line 21615 ""
+#line 21606 ""
if (comlast_1.islast) {
-#line 21615 ""
+#line 21606 ""
s_wsfe(&io___1411);
/* Writing concatenation */
-#line 21615 ""
+#line 21606 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21615 ""
+#line 21606 ""
i__6[1] = 11, a__4[1] = "pmxnewclefs";
-#line 21615 ""
+#line 21606 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 21615 ""
+#line 21606 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 21615 ""
+#line 21606 ""
e_wsfe();
-#line 21615 ""
+#line 21606 ""
}
-#line 21616 ""
+#line 21607 ""
}
-#line 21617 ""
+#line 21608 ""
L23:
/* Kluge \CenterBar for whole bar rests if necessary */
-#line 21621 ""
+#line 21612 ""
if (newclef && comclefrests_1.centrests) {
/* write(11,'(a)')sq//'def'//sq//'value{11}%' */
-#line 21623 ""
+#line 21614 ""
r__1 = all_1.musicsize * .55f;
-#line 21623 ""
+#line 21614 ""
nvalue = i_nint(&r__1);
-#line 21624 ""
+#line 21615 ""
if (nvalue > 10) {
-#line 21625 ""
+#line 21616 ""
s_wsfe(&io___1413);
/* Writing concatenation */
-#line 21625 ""
+#line 21616 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21625 ""
+#line 21616 ""
i__5[1] = 3, a__3[1] = "def";
-#line 21625 ""
+#line 21616 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21625 ""
+#line 21616 ""
i__5[3] = 6, a__3[3] = "value{";
-#line 21625 ""
+#line 21616 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 21625 ""
+#line 21616 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 21625 ""
+#line 21616 ""
do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer));
-#line 21625 ""
+#line 21616 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 21625 ""
+#line 21616 ""
e_wsfe();
-#line 21627 ""
+#line 21618 ""
} else {
-#line 21628 ""
+#line 21619 ""
s_wsfe(&io___1414);
/* Writing concatenation */
-#line 21628 ""
+#line 21619 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21628 ""
+#line 21619 ""
i__5[1] = 3, a__3[1] = "def";
-#line 21628 ""
+#line 21619 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21628 ""
+#line 21619 ""
i__5[3] = 6, a__3[3] = "value{";
-#line 21628 ""
+#line 21619 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 21628 ""
+#line 21619 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 21628 ""
+#line 21619 ""
do_fio(&c__1, (char *)&nvalue, (ftnlen)sizeof(integer));
-#line 21628 ""
+#line 21619 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 21628 ""
+#line 21619 ""
e_wsfe();
-#line 21630 ""
+#line 21621 ""
}
-#line 21631 ""
+#line 21622 ""
}
-#line 21632 ""
+#line 21623 ""
newclef = FALSE_;
-#line 21633 ""
+#line 21624 ""
comclefrests_1.centrests = FALSE_;
/* End of loop for end-of-bar hardspaces and non-movbrk clef symbol. */
-#line 21637 ""
+#line 21628 ""
if (comask_1.bar1syst) {
-#line 21638 ""
+#line 21629 ""
s_rsle(&io___1415);
-#line 21638 ""
+#line 21629 ""
do_lio(&c__4, &c__1, (char *)&comask_1.poenom, (ftnlen)sizeof(
real));
-#line 21638 ""
+#line 21629 ""
e_rsle();
-#line 21639 ""
+#line 21630 ""
}
/* Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) */
-#line 21643 ""
+#line 21634 ""
if (all_1.ibar == 1) {
-#line 21644 ""
+#line 21635 ""
islnow = all_1.islur[0];
/* iornqnow = iornq(1,1) */
-#line 21646 ""
+#line 21637 ""
iplnow = all_1.ipl[0];
-#line 21647 ""
+#line 21638 ""
} else {
-#line 21648 ""
+#line 21639 ""
islnow = all_1.islur[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) *
24 - 24];
/* iornqnow = iornq(1,nib(1,ibar-1)+1) */
-#line 21650 ""
+#line 21641 ""
iplnow = all_1.ipl[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) *
24 - 24];
-#line 21651 ""
+#line 21642 ""
}
/* Check for R-symbols set at end of prior input block */
-#line 21655 ""
+#line 21646 ""
if (comget_1.movbrk == 0 && *(unsigned char *)comget_1.rptfq2 != 'E')
{
-#line 21656 ""
+#line 21647 ""
if (*(unsigned char *)comget_1.rptfq2 == 'D') {
-#line 21657 ""
+#line 21648 ""
islnow = bit_set(islnow,26);
-#line 21658 ""
+#line 21649 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'r') {
-#line 21659 ""
+#line 21650 ""
islnow = bit_set(islnow,6);
-#line 21660 ""
+#line 21651 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
-#line 21661 ""
+#line 21652 ""
islnow = bit_set(islnow,8);
-#line 21662 ""
+#line 21653 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
-#line 21663 ""
+#line 21654 ""
islnow = bit_set(islnow,25);
-#line 21664 ""
+#line 21655 ""
} else {
-#line 21665 ""
+#line 21656 ""
s_wsle(&io___1418);
-#line 21665 ""
+#line 21656 ""
e_wsle();
-#line 21666 ""
+#line 21657 ""
s_wsle(&io___1419);
-#line 21666 ""
+#line 21657 ""
do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in"\
"put block:", (ftnlen)46);
-#line 21666 ""
+#line 21657 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
-#line 21666 ""
+#line 21657 ""
e_wsle();
-#line 21668 ""
+#line 21659 ""
stop1_();
-#line 21669 ""
+#line 21660 ""
}
-#line 21670 ""
+#line 21661 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
-#line 21671 ""
+#line 21662 ""
}
-#line 21672 ""
+#line 21663 ""
if ((islnow & 352) != 0) {
/* Bit 5(lrpt), 6(rrpt), or 8(doublebar) has been set */
-#line 21676 ""
+#line 21667 ""
lrpt = bit_test(islnow,5);
-#line 21677 ""
+#line 21668 ""
rrpt = bit_test(islnow,6);
-#line 21678 ""
+#line 21669 ""
lrptpend = lrpt && comask_1.bar1syst;
-#line 21679 ""
+#line 21670 ""
if (lrpt && ! lrptpend) {
-#line 21680 ""
+#line 21671 ""
if (rrpt) {
-#line 21681 ""
+#line 21672 ""
if (comlast_1.islast) {
-#line 21681 ""
+#line 21672 ""
s_wsfe(&io___1422);
/* Writing concatenation */
-#line 21681 ""
+#line 21672 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21681 ""
+#line 21672 ""
i__6[1] = 18, a__4[1] = "setleftrightrepeat";
-#line 21681 ""
+#line 21672 ""
s_cat(ch__11, a__4, i__6, &c__2, (ftnlen)19);
-#line 21681 ""
+#line 21672 ""
do_fio(&c__1, ch__11, (ftnlen)19);
-#line 21681 ""
+#line 21672 ""
e_wsfe();
-#line 21681 ""
+#line 21672 ""
}
-#line 21682 ""
+#line 21673 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.lrrptfac - .4f;
-#line 21683 ""
+#line 21674 ""
} else {
-#line 21684 ""
+#line 21675 ""
if (comlast_1.islast) {
-#line 21684 ""
+#line 21675 ""
s_wsfe(&io___1423);
/* Writing concatenation */
-#line 21684 ""
+#line 21675 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21684 ""
+#line 21675 ""
i__6[1] = 13, a__4[1] = "setleftrepeat";
-#line 21684 ""
+#line 21675 ""
s_cat(ch__10, a__4, i__6, &c__2, (ftnlen)14);
-#line 21684 ""
+#line 21675 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 21684 ""
+#line 21675 ""
e_wsfe();
-#line 21684 ""
+#line 21675 ""
}
-#line 21685 ""
+#line 21676 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.rptfac - .4f;
-#line 21686 ""
+#line 21677 ""
}
-#line 21687 ""
+#line 21678 ""
} else if (rrpt) {
-#line 21688 ""
+#line 21679 ""
if (comlast_1.islast) {
-#line 21688 ""
+#line 21679 ""
s_wsfe(&io___1424);
/* Writing concatenation */
-#line 21688 ""
+#line 21679 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21688 ""
+#line 21679 ""
i__6[1] = 14, a__4[1] = "setrightrepeat";
-#line 21688 ""
+#line 21679 ""
s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15);
-#line 21688 ""
+#line 21679 ""
do_fio(&c__1, ch__16, (ftnlen)15);
-#line 21688 ""
+#line 21679 ""
e_wsfe();
-#line 21688 ""
+#line 21679 ""
}
-#line 21689 ""
+#line 21680 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.rptfac - .4f;
-#line 21690 ""
+#line 21681 ""
} else if (bit_test(islnow,8)) {
-#line 21691 ""
+#line 21682 ""
if (comlast_1.islast) {
-#line 21691 ""
+#line 21682 ""
s_wsfe(&io___1425);
/* Writing concatenation */
-#line 21691 ""
+#line 21682 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21691 ""
+#line 21682 ""
i__6[1] = 12, a__4[1] = "setdoublebar";
-#line 21691 ""
+#line 21682 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
-#line 21691 ""
+#line 21682 ""
do_fio(&c__1, ch__17, (ftnlen)13);
-#line 21691 ""
+#line 21682 ""
e_wsfe();
-#line 21691 ""
+#line 21682 ""
}
-#line 21692 ""
+#line 21683 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.dbarfac - .4f;
-#line 21693 ""
+#line 21684 ""
}
-#line 21694 ""
+#line 21685 ""
} else if (bit_test(islnow,26)) {
/* doubleBAR */
-#line 21698 ""
+#line 21689 ""
if (comlast_1.islast) {
-#line 21698 ""
+#line 21689 ""
s_wsfe(&io___1426);
/* Writing concatenation */
-#line 21698 ""
+#line 21689 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21698 ""
+#line 21689 ""
i__6[1] = 12, a__4[1] = "setdoubleBAR";
-#line 21698 ""
+#line 21689 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
-#line 21698 ""
+#line 21689 ""
do_fio(&c__1, ch__17, (ftnlen)13);
-#line 21698 ""
+#line 21689 ""
e_wsfe();
-#line 21698 ""
+#line 21689 ""
}
-#line 21699 ""
+#line 21690 ""
comask_1.fixednew = comask_1.fixednew + comask_1.wheadpt *
spfacs_1.ddbarfac - .4f;
/* else if (btest(iornqnow,29)) then */
-#line 21701 ""
+#line 21692 ""
} else if (bit_test(iplnow,0)) {
/* no bar line */
/* -- if (islast) write(11,'(a)')sq//'setzalaligne' */
/* ++ */
-#line 21707 ""
+#line 21698 ""
if (comlast_1.islast) {
-#line 21708 ""
+#line 21699 ""
if (comget_1.movbrk == 0) {
-#line 21709 ""
+#line 21700 ""
s_wsfe(&io___1427);
/* Writing concatenation */
-#line 21709 ""
+#line 21700 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21709 ""
+#line 21700 ""
i__6[1] = 12, a__4[1] = "setzalaligne";
-#line 21709 ""
+#line 21700 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
-#line 21709 ""
+#line 21700 ""
do_fio(&c__1, ch__17, (ftnlen)13);
-#line 21709 ""
+#line 21700 ""
e_wsfe();
-#line 21710 ""
+#line 21701 ""
} else {
/* Encountered "Rz" at start of input block at start of new movement, Must */
/* use newmovement macro with arg 4 rather than setzalaligne, since former */
/* already redefines stoppiece. */
-#line 21716 ""
+#line 21707 ""
*(unsigned char *)comget_1.rptfq2 = 'z';
-#line 21717 ""
+#line 21708 ""
}
-#line 21718 ""
+#line 21709 ""
}
/* ++ */
-#line 21720 ""
+#line 21711 ""
comask_1.fixednew += -.4f;
-#line 21721 ""
+#line 21712 ""
}
/* 1st and 2nd endings */
-#line 21725 ""
+#line 21716 ""
svolta = bit_test(islnow,7);
-#line 21726 ""
+#line 21717 ""
evolta = bit_test(islnow,9);
-#line 21727 ""
+#line 21718 ""
if (evolta) {
-#line 21728 ""
+#line 21719 ""
if (bit_test(islnow,10)) {
-#line 21729 ""
+#line 21720 ""
if (comlast_1.islast) {
-#line 21729 ""
+#line 21720 ""
s_wsfe(&io___1430);
/* Writing concatenation */
-#line 21729 ""
+#line 21720 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21729 ""
+#line 21720 ""
i__6[1] = 11, a__4[1] = "endvoltabox";
-#line 21729 ""
+#line 21720 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 21729 ""
+#line 21720 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 21729 ""
+#line 21720 ""
e_wsfe();
-#line 21729 ""
+#line 21720 ""
}
-#line 21730 ""
+#line 21721 ""
} else {
-#line 21731 ""
+#line 21722 ""
if (comlast_1.islast) {
-#line 21731 ""
+#line 21722 ""
s_wsfe(&io___1431);
/* Writing concatenation */
-#line 21731 ""
+#line 21722 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21731 ""
+#line 21722 ""
i__6[1] = 8, a__4[1] = "endvolta";
-#line 21731 ""
+#line 21722 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 21731 ""
+#line 21722 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 21731 ""
+#line 21722 ""
e_wsfe();
-#line 21731 ""
+#line 21722 ""
}
-#line 21732 ""
+#line 21723 ""
}
-#line 21733 ""
+#line 21724 ""
onvolt = FALSE_;
-#line 21734 ""
+#line 21725 ""
}
-#line 21735 ""
+#line 21726 ""
if (svolta) {
-#line 21736 ""
+#line 21727 ""
++comgrace_1.nvolt;
-#line 21737 ""
+#line 21728 ""
lvoltxt = i_indx(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20,
" ", (ftnlen)20, (ftnlen)1) - 1;
-#line 21738 ""
+#line 21729 ""
if (lvoltxt == 1) {
-#line 21739 ""
+#line 21730 ""
if (comlast_1.islast) {
-#line 21739 ""
+#line 21730 ""
s_wsfe(&io___1433);
/* Writing concatenation */
-#line 21739 ""
+#line 21730 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21739 ""
+#line 21730 ""
i__5[1] = 8, a__3[1] = "Setvolta";
-#line 21739 ""
+#line 21730 ""
i__5[2] = 1, a__3[2] = comgrace_1.voltxtq + (
comgrace_1.nvolt - 1) * 20;
-#line 21739 ""
+#line 21730 ""
i__5[3] = 1, a__3[3] = "%";
-#line 21739 ""
+#line 21730 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 21739 ""
+#line 21730 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 21739 ""
+#line 21730 ""
e_wsfe();
-#line 21739 ""
+#line 21730 ""
}
-#line 21741 ""
+#line 21732 ""
} else {
-#line 21742 ""
+#line 21733 ""
if (comlast_1.islast) {
-#line 21742 ""
+#line 21733 ""
s_wsfe(&io___1434);
/* Writing concatenation */
-#line 21742 ""
+#line 21733 ""
i__12[0] = 1, a__9[0] = all_1.sq;
-#line 21742 ""
+#line 21733 ""
i__12[1] = 8, a__9[1] = "Setvolta";
-#line 21742 ""
+#line 21733 ""
i__12[2] = 1, a__9[2] = "{";
-#line 21742 ""
+#line 21733 ""
i__12[3] = lvoltxt, a__9[3] = comgrace_1.voltxtq + (
comgrace_1.nvolt - 1) * 20;
-#line 21742 ""
+#line 21733 ""
i__12[4] = 2, a__9[4] = "}%";
-#line 21742 ""
+#line 21733 ""
s_cat(ch__19, a__9, i__12, &c__5, (ftnlen)32);
-#line 21742 ""
+#line 21733 ""
do_fio(&c__1, ch__19, lvoltxt + 12);
-#line 21742 ""
+#line 21733 ""
e_wsfe();
-#line 21742 ""
+#line 21733 ""
}
-#line 21744 ""
+#line 21735 ""
}
-#line 21745 ""
+#line 21736 ""
onvolt = TRUE_;
-#line 21746 ""
+#line 21737 ""
}
-#line 21747 ""
+#line 21738 ""
if (all_1.ibar > 1) {
-#line 21748 ""
+#line 21739 ""
ipnow = all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1;
-#line 21749 ""
+#line 21740 ""
} else {
-#line 21750 ""
+#line 21741 ""
ipnow = 1;
-#line 21751 ""
+#line 21742 ""
}
-#line 21752 ""
+#line 21743 ""
iplnow = all_1.ipl[ipnow * 24 - 24];
-#line 21753 ""
+#line 21744 ""
if (comask_1.bar1syst) {
/* If listslur>0, then there is at least one slur or tie carried over the break */
-#line 21757 ""
+#line 21748 ""
ispstie = FALSE_;
-#line 21758 ""
+#line 21749 ""
if (comnotes_1.optlinebreakties && ! comslur_1.fontslur &&
comslur_1.listslur != 0 && comlast_1.islast) {
-#line 21758 ""
+#line 21749 ""
linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
ftnlen)1);
-#line 21758 ""
+#line 21749 ""
}
-#line 21762 ""
+#line 21753 ""
++all_1.iline;
/* End an old system, Start a new system */
@@ -51989,225 +52262,225 @@ L23:
/* Reduce space before mbrest at start of system */
/* Need this even if no accidentals in key signature */
-#line 21769 ""
+#line 21760 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
-#line 21769 ""
+#line 21760 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
-#line 21769 ""
+#line 21760 ""
}
-#line 21771 ""
+#line 21762 ""
if (all_1.iline != 1) {
/* Not first line. */
/* Get corrected poe = points/elemskip for *previous* system */
-#line 21776 ""
+#line 21767 ""
wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
-#line 21777 ""
+#line 21768 ""
poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f -
comask_1.fixednew) / (elsktot + comask_1.fbar *
nbarss - comask_1.scaldold);
-#line 21779 ""
+#line 21770 ""
++isyscnt;
-#line 21780 ""
+#line 21771 ""
poevec[isyscnt] = poe;
/* Transfer data for system into global arrays to hold until very end */
-#line 21784 ""
- i__7 = comas2_1.nasksys;
-#line 21784 ""
- for (ia = 1; ia <= i__7; ++ia) {
-#line 21785 ""
+#line 21775 ""
+ i__2 = comas2_1.nasksys;
+#line 21775 ""
+ for (ia = 1; ia <= i__2; ++ia) {
+#line 21776 ""
++comas3_1.iask;
-#line 21786 ""
+#line 21777 ""
comas3_1.ask[comas3_1.iask - 1] = (comas2_1.wasksys[ia -
1] / poe - (r__1 = comas2_1.elasksys[ia - 1],
dabs(r__1))) / comshort_1.poefa[all_1.iline - 2];
/* Only admit negative ask if it was user-defined space, signalled by elask<=0. */
-#line 21791 ""
+#line 21782 ""
if (comas2_1.elasksys[ia - 1] > 0.f) {
-#line 21791 ""
+#line 21782 ""
comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
comas3_1.iask - 1], &c_b1008);
-#line 21791 ""
+#line 21782 ""
}
-#line 21792 ""
+#line 21783 ""
/* L9: */
-#line 21792 ""
+#line 21783 ""
}
-#line 21793 ""
- i__7 = nhssys;
-#line 21793 ""
- for (ia = 1; ia <= i__7; ++ia) {
-#line 21794 ""
+#line 21784 ""
+ i__2 = nhssys;
+#line 21784 ""
+ for (ia = 1; ia <= i__2; ++ia) {
+#line 21785 ""
++nhstot;
/* Computing MAX */
-#line 21795 ""
+#line 21786 ""
r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
-#line 21795 ""
+#line 21786 ""
comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
-#line 21796 ""
+#line 21787 ""
/* L25: */
-#line 21796 ""
+#line 21787 ""
}
/* Reset counters for new system */
-#line 21800 ""
+#line 21791 ""
comask_1.scaldold = 0.f;
-#line 21801 ""
+#line 21792 ""
comask_1.fixednew = 0.f;
-#line 21802 ""
+#line 21793 ""
comas2_1.nasksys = 0;
-#line 21803 ""
+#line 21794 ""
nhssys = 0;
-#line 21804 ""
+#line 21795 ""
}
/* End of if block for first bar of non-first system. Still 1st bar, any system */
-#line 21808 ""
+#line 21799 ""
if (comlast_1.islast && all_1.figbass) {
-#line 21808 ""
+#line 21799 ""
s_wsfe(&io___1443);
/* Writing concatenation */
-#line 21808 ""
+#line 21799 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21808 ""
+#line 21799 ""
i__6[1] = 8, a__4[1] = "fixdrop%";
-#line 21808 ""
+#line 21799 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 21808 ""
+#line 21799 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 21808 ""
+#line 21799 ""
e_wsfe();
-#line 21808 ""
+#line 21799 ""
}
-#line 21809 ""
+#line 21800 ""
++isystpg;
/* Try moving the next stmt way down, to fix a bug and get \eject printed at */
/* end of single-system page. */
/* if (isystpg .eq. nsystp(ipage)) isystpg = 0 */
-#line 21814 ""
+#line 21805 ""
s_rsle(&io___1444);
-#line 21814 ""
+#line 21805 ""
do_lio(&c__3, &c__1, (char *)&nbarss, (ftnlen)sizeof(integer));
-#line 21814 ""
+#line 21805 ""
do_lio(&c__4, &c__1, (char *)&elsktot, (ftnlen)sizeof(real));
-#line 21814 ""
+#line 21805 ""
do_lio(&c__4, &c__1, (char *)&fsyst, (ftnlen)sizeof(real));
-#line 21814 ""
+#line 21805 ""
do_lio(&c__4, &c__1, (char *)&frac, (ftnlen)sizeof(real));
-#line 21814 ""
+#line 21805 ""
do_lio(&c__4, &c__1, (char *)&comeon_1.eonk, (ftnlen)sizeof(real))
;
-#line 21814 ""
+#line 21805 ""
do_lio(&c__4, &c__1, (char *)&comeon_1.ewmxk, (ftnlen)sizeof(real)
);
-#line 21814 ""
+#line 21805 ""
e_rsle();
-#line 21815 ""
+#line 21806 ""
if (all_1.iline > 1) {
-#line 21815 ""
+#line 21806 ""
comtop_1.fracindent = frac;
-#line 21815 ""
+#line 21806 ""
}
-#line 21816 ""
+#line 21807 ""
if (all_1.figbass) {
-#line 21817 ""
+#line 21808 ""
all_1.ifigdr[(all_1.iline << 1) - 2] = 4;
-#line 21818 ""
+#line 21809 ""
all_1.ifigdr[(all_1.iline << 1) - 1] = 4;
-#line 21819 ""
+#line 21810 ""
}
-#line 21820 ""
+#line 21811 ""
all_1.slfac = slfac1 * all_1.musicsize * elsktot;
-#line 21821 ""
+#line 21812 ""
if (all_1.iline != 1) {
/* For the line just _finished_, put figdrop in separate file. */
-#line 21825 ""
+#line 21816 ""
if (all_1.figbass) {
-#line 21825 ""
+#line 21816 ""
s_wsfe(&io___1446);
/* Writing concatenation */
-#line 21825 ""
+#line 21816 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21825 ""
+#line 21816 ""
i__6[1] = 8, a__4[1] = "figdrop=";
-#line 21825 ""
+#line 21816 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 21825 ""
+#line 21816 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 21825 ""
+#line 21816 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
- 2], (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 21825 ""
+#line 21816 ""
i__8[0] = 1, a__5[0] = " ";
-#line 21825 ""
+#line 21816 ""
i__8[1] = 1, a__5[1] = all_1.sq;
-#line 21825 ""
+#line 21816 ""
i__8[2] = 8, a__5[2] = "figdtwo=";
-#line 21825 ""
+#line 21816 ""
s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10);
-#line 21825 ""
+#line 21816 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 21825 ""
+#line 21816 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline - 1 << 1)
- 1], (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 21825 ""
+#line 21816 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 21825 ""
+#line 21816 ""
i__11[1] = 3, a__8[1] = "or%";
-#line 21825 ""
+#line 21816 ""
s_cat(ch__21, a__8, i__11, &c__2, (ftnlen)4);
-#line 21825 ""
+#line 21816 ""
do_fio(&c__1, ch__21, (ftnlen)4);
-#line 21825 ""
+#line 21816 ""
e_wsfe();
-#line 21825 ""
+#line 21816 ""
}
/* Check slurs in top staff for interference w/ barno. Only check when */
/* # if digits in barno >= |isig| But to keep on/off phasing, must ALWAYS */
/* keep track of ons and offs when |isig|<=3. */
-#line 21833 ""
+#line 21824 ""
r__1 = combibarcnt_1.ibarcnt + ibcoff + .01f;
-#line 21833 ""
+#line 21824 ""
ndigbn = (integer) r_lg10(&r__1) + 1;
-#line 21834 ""
+#line 21825 ""
comsln_1.isnx = 0;
-#line 21835 ""
+#line 21826 ""
if (ndigbn >= abs(comtop_1.isig) && comsln_1.is1n1 > 0) {
/* There's a slur in top voice over the line break, hgt=is1n1, idcode=is2n1 */
/* Look for termination in remainder of this input block. If not found, */
/* just use is1n1. Remember, haven't slid down yet. */
-#line 21841 ""
+#line 21832 ""
ioff = 0;
-#line 21842 ""
+#line 21833 ""
if (all_1.ibar > 1) {
-#line 21842 ""
+#line 21833 ""
ioff = all_1.nib[commvl_1.ivmx[all_1.nv +
commvl_1.nvmx[all_1.nv - 1] * 24 - 25] + (
all_1.ibar - 1) * 24 - 25];
-#line 21842 ""
+#line 21833 ""
}
-#line 21843 ""
- i__7 = all_1.nsdat;
-#line 21843 ""
- for (isdat = 1; isdat <= i__7; ++isdat) {
-#line 21844 ""
+#line 21834 ""
+ i__2 = all_1.nsdat;
+#line 21834 ""
+ for (isdat = 1; isdat <= i__2; ++isdat) {
+#line 21835 ""
if (igetbits_(&all_1.isdat1[isdat - 1], &c__5, &c__13)
== commvl_1.ivmx[all_1.nv + commvl_1.nvmx[
all_1.nv - 1] * 24 - 25] && ! bit_test(
@@ -52219,82 +52492,82 @@ L23:
/* is1n1 = max(is1n1,igetbits(isdat2(nsdat),7,19)) */
/* Computing MAX */
-#line 21851 ""
- i__2 = comsln_1.is1n1, i__13 = igetbits_(&
+#line 21842 ""
+ i__7 = comsln_1.is1n1, i__13 = igetbits_(&
all_1.isdat2[isdat - 1], &c__7, &c__19);
-#line 21851 ""
- comsln_1.is1n1 = max(i__2,i__13);
-#line 21852 ""
+#line 21842 ""
+ comsln_1.is1n1 = max(i__7,i__13);
+#line 21843 ""
goto L51;
-#line 21853 ""
+#line 21844 ""
}
-#line 21854 ""
+#line 21845 ""
/* L50: */
-#line 21854 ""
+#line 21845 ""
}
/* If exiting loop normally, did not find end of slur. c'est la vie. */
-#line 21858 ""
+#line 21849 ""
L51:
-#line 21859 ""
- i__7 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd;
-#line 21859 ""
- comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__7);
-#line 21860 ""
+#line 21850 ""
+ i__2 = ncmid_(&all_1.nv, &c__1) + 1 + comsln_1.irzbnd;
+#line 21850 ""
+ comsln_1.isnx = i_dim(&comsln_1.is1n1, &i__2);
+#line 21851 ""
if (comsln_1.isnx > 0) {
/* AHA! Slur likely to interfere with barno. */
/* Modified 090525 to use \bnrs */
-#line 21866 ""
+#line 21857 ""
slint = TRUE_;
-#line 21867 ""
+#line 21858 ""
s_copy(fmtq, "(a16,i1,a14)", (ftnlen)24, (ftnlen)12);
-#line 21868 ""
+#line 21859 ""
if (comsln_1.irzbnd + comsln_1.isnx > 9) {
-#line 21868 ""
+#line 21859 ""
s_copy(fmtq, "(a16,i2,a14)", (ftnlen)24, (ftnlen)
12);
-#line 21868 ""
+#line 21859 ""
}
-#line 21869 ""
+#line 21860 ""
if (comlast_1.islast) {
-#line 21869 ""
+#line 21860 ""
s_wsfe(&io___1449);
/* Writing concatenation */
-#line 21869 ""
+#line 21860 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 21869 ""
+#line 21860 ""
i__5[1] = 3, a__3[1] = "def";
-#line 21869 ""
+#line 21860 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 21869 ""
+#line 21860 ""
i__5[3] = 11, a__3[3] = "raisebarno{";
-#line 21869 ""
+#line 21860 ""
s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16);
-#line 21869 ""
+#line 21860 ""
do_fio(&c__1, ch__22, (ftnlen)16);
-#line 21869 ""
- i__7 = comsln_1.irzbnd + comsln_1.isnx;
-#line 21869 ""
- do_fio(&c__1, (char *)&i__7, (ftnlen)sizeof(
+#line 21860 ""
+ i__2 = comsln_1.irzbnd + comsln_1.isnx;
+#line 21860 ""
+ do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(
integer));
/* Writing concatenation */
-#line 21869 ""
+#line 21860 ""
i__8[0] = 2, a__5[0] = ".5";
-#line 21869 ""
+#line 21860 ""
i__8[1] = 1, a__5[1] = all_1.sq;
-#line 21869 ""
+#line 21860 ""
i__8[2] = 11, a__5[2] = "internote}%";
-#line 21869 ""
+#line 21860 ""
s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
-#line 21869 ""
+#line 21860 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 21869 ""
+#line 21860 ""
e_wsfe();
-#line 21869 ""
+#line 21860 ""
}
/* if (islast) then */
/* if (isnx .le. 9) then */
@@ -52304,11 +52577,11 @@ L51:
/* end if */
/* end if */
-#line 21879 ""
+#line 21870 ""
}
-#line 21880 ""
+#line 21871 ""
}
-#line 21881 ""
+#line 21872 ""
if (comget_1.movbrk > 0) {
/* movbrk = 0 */
@@ -52319,85 +52592,85 @@ L51:
/* indsym = 0,1,2 for doubleBAR , doublebar, rightrepeat. */
/* This is passed to \newmovement. */
-#line 21891 ""
+#line 21882 ""
if (*(unsigned char *)comget_1.rptfq2 == 'E') {
-#line 21891 ""
+#line 21882 ""
*(unsigned char *)comget_1.rptfq2 = 'D';
-#line 21891 ""
+#line 21882 ""
}
-#line 21892 ""
+#line 21883 ""
indsym = i_indx("Ddrbz", comget_1.rptfq2, (ftnlen)5, (
ftnlen)1) - 1;
-#line 21893 ""
+#line 21884 ""
*(unsigned char *)comget_1.rptfq2 = 'E';
/* Also check for Rd or Rr set the normal way */
-#line 21897 ""
+#line 21888 ""
if (bit_test(islnow,8)) {
-#line 21898 ""
+#line 21889 ""
indsym = 1;
-#line 21899 ""
+#line 21890 ""
} else if (bit_test(islnow,6)) {
-#line 21900 ""
+#line 21891 ""
indsym = 2;
-#line 21901 ""
+#line 21892 ""
}
-#line 21902 ""
+#line 21893 ""
if (indsym < 0) {
-#line 21903 ""
+#line 21894 ""
s_wsle(&io___1451);
-#line 21903 ""
+#line 21894 ""
e_wsle();
-#line 21904 ""
+#line 21895 ""
s_wsle(&io___1452);
-#line 21904 ""
+#line 21895 ""
do_lio(&c__9, &c__1, "Illegal end symbol before \"/\""
, (ftnlen)29);
-#line 21904 ""
+#line 21895 ""
e_wsle();
-#line 21905 ""
+#line 21896 ""
stop1_();
-#line 21906 ""
+#line 21897 ""
}
/* Check for continuation (no bar number reset) */
-#line 21910 ""
+#line 21901 ""
if (comlast_1.islast && comnotes_1.nobar1) {
-#line 21911 ""
+#line 21902 ""
s_wsfe(&io___1453);
/* Writing concatenation */
-#line 21911 ""
+#line 21902 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 21911 ""
+#line 21902 ""
i__9[1] = 7, a__6[1] = "advance";
-#line 21911 ""
+#line 21902 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 21911 ""
+#line 21902 ""
i__9[3] = 6, a__6[3] = "barno1";
-#line 21911 ""
+#line 21902 ""
i__9[4] = 1, a__6[4] = all_1.sq;
-#line 21911 ""
+#line 21902 ""
i__9[5] = 6, a__6[5] = "global";
-#line 21911 ""
+#line 21902 ""
i__9[6] = 1, a__6[6] = all_1.sq;
-#line 21911 ""
+#line 21902 ""
i__9[7] = 10, a__6[7] = "startbarno";
-#line 21911 ""
+#line 21902 ""
i__9[8] = 1, a__6[8] = all_1.sq;
-#line 21911 ""
+#line 21902 ""
i__9[9] = 6, a__6[9] = "barno%";
-#line 21911 ""
+#line 21902 ""
s_cat(ch__23, a__6, i__9, &c__10, (ftnlen)40);
-#line 21911 ""
+#line 21902 ""
do_fio(&c__1, ch__23, (ftnlen)40);
-#line 21911 ""
+#line 21902 ""
e_wsfe();
/* Need above for shortening case mcm with Mc */
-#line 21916 ""
+#line 21907 ""
}
/* Per Rainer's suggestion, changing \nbinstruments via 3rd arg of \newmovement */
@@ -52409,528 +52682,528 @@ L51:
/* if (islast) write(11,'(a13,i2,a1,i1,a1)') */
/* * sq//'newmovement{',movgap,'}',indsym,'%' */
/* end if */
-#line 21927 ""
+#line 21918 ""
if (comlast_1.islast) {
/* Writing concatenation */
-#line 21928 ""
+#line 21919 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21928 ""
+#line 21919 ""
i__6[1] = 11, a__4[1] = "newmovement";
-#line 21928 ""
+#line 21919 ""
s_cat(nmq, a__4, i__6, &c__2, (ftnlen)40);
-#line 21929 ""
+#line 21920 ""
lnmq = 12;
-#line 21930 ""
+#line 21921 ""
if (comget_1.movgap < 10) {
-#line 21931 ""
+#line 21922 ""
lnmq = 14;
-#line 21932 ""
+#line 21923 ""
s_wsfi(&io___1456);
-#line 21932 ""
+#line 21923 ""
do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
sizeof(integer));
-#line 21932 ""
+#line 21923 ""
do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
integer));
-#line 21932 ""
+#line 21923 ""
e_wsfi();
-#line 21933 ""
+#line 21924 ""
} else {
-#line 21934 ""
+#line 21925 ""
lnmq = 17;
-#line 21935 ""
+#line 21926 ""
s_wsfi(&io___1457);
-#line 21935 ""
+#line 21926 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 21935 ""
+#line 21926 ""
do_fio(&c__1, (char *)&comget_1.movgap, (ftnlen)
sizeof(integer));
-#line 21935 ""
+#line 21926 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 21935 ""
+#line 21926 ""
do_fio(&c__1, (char *)&indsym, (ftnlen)sizeof(
integer));
-#line 21935 ""
+#line 21926 ""
e_wsfi();
-#line 21936 ""
+#line 21927 ""
}
-#line 21937 ""
+#line 21928 ""
if (comnotes_1.ninow < 10) {
-#line 21938 ""
+#line 21929 ""
++lnmq;
-#line 21939 ""
+#line 21930 ""
ici__1.icierr = 0;
-#line 21939 ""
+#line 21930 ""
ici__1.icirnum = 1;
-#line 21939 ""
+#line 21930 ""
ici__1.icirlen = 1;
-#line 21939 ""
+#line 21930 ""
ici__1.iciunit = nmq + (lnmq - 1);
-#line 21939 ""
+#line 21930 ""
ici__1.icifmt = "(i1)";
-#line 21939 ""
+#line 21930 ""
s_wsfi(&ici__1);
-#line 21939 ""
+#line 21930 ""
do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
sizeof(integer));
-#line 21939 ""
+#line 21930 ""
e_wsfi();
-#line 21940 ""
+#line 21931 ""
} else {
-#line 21941 ""
+#line 21932 ""
lnmq += 4;
-#line 21942 ""
- i__7 = lnmq - 4;
-#line 21942 ""
+#line 21933 ""
+ i__2 = lnmq - 4;
+#line 21933 ""
ici__1.icierr = 0;
-#line 21942 ""
+#line 21933 ""
ici__1.icirnum = 1;
-#line 21942 ""
- ici__1.icirlen = lnmq - i__7;
-#line 21942 ""
- ici__1.iciunit = nmq + i__7;
-#line 21942 ""
+#line 21933 ""
+ ici__1.icirlen = lnmq - i__2;
+#line 21933 ""
+ ici__1.iciunit = nmq + i__2;
+#line 21933 ""
ici__1.icifmt = "(a1,i2,a1)";
-#line 21942 ""
+#line 21933 ""
s_wsfi(&ici__1);
-#line 21942 ""
+#line 21933 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 21942 ""
+#line 21933 ""
do_fio(&c__1, (char *)&comnotes_1.ninow, (ftnlen)
sizeof(integer));
-#line 21942 ""
+#line 21933 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 21942 ""
+#line 21933 ""
e_wsfi();
-#line 21943 ""
+#line 21934 ""
}
-#line 21944 ""
+#line 21935 ""
++lnmq;
-#line 21945 ""
+#line 21936 ""
ici__1.icierr = 0;
-#line 21945 ""
+#line 21936 ""
ici__1.icirnum = 1;
-#line 21945 ""
+#line 21936 ""
ici__1.icirlen = 1;
-#line 21945 ""
+#line 21936 ""
ici__1.iciunit = nmq + (lnmq - 1);
-#line 21945 ""
+#line 21936 ""
ici__1.icifmt = "(a1)";
-#line 21945 ""
+#line 21936 ""
s_wsfi(&ici__1);
-#line 21945 ""
+#line 21936 ""
do_fio(&c__1, "%", (ftnlen)1);
-#line 21945 ""
+#line 21936 ""
e_wsfi();
-#line 21946 ""
+#line 21937 ""
if (comshort_1.ishort == 4) {
/* Ending Short-blank-coda */
-#line 21950 ""
+#line 21941 ""
s_wsfe(&io___1458);
/* Writing concatenation */
-#line 21950 ""
+#line 21941 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21950 ""
+#line 21941 ""
i__6[1] = 11, a__4[1] = "Endpiece}}%";
-#line 21950 ""
+#line 21941 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 21950 ""
+#line 21941 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 21950 ""
+#line 21941 ""
e_wsfe();
-#line 21951 ""
+#line 21942 ""
}
-#line 21952 ""
+#line 21943 ""
s_wsfe(&io___1459);
-#line 21952 ""
+#line 21943 ""
do_fio(&c__1, nmq, lnmq);
-#line 21952 ""
+#line 21943 ""
e_wsfe();
-#line 21953 ""
+#line 21944 ""
if (comshort_1.ishort == 2) {
-#line 21954 ""
+#line 21945 ""
s_wsfe(&io___1460);
/* Writing concatenation */
-#line 21954 ""
+#line 21945 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21954 ""
+#line 21945 ""
i__6[1] = 12, a__4[1] = "stoppiece}}%";
-#line 21954 ""
+#line 21945 ""
s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)13);
-#line 21954 ""
+#line 21945 ""
do_fio(&c__1, ch__17, (ftnlen)13);
-#line 21954 ""
+#line 21945 ""
e_wsfe();
-#line 21955 ""
+#line 21946 ""
comshort_1.ishort = 5;
-#line 21956 ""
+#line 21947 ""
} else if (comshort_1.ishort == 4) {
-#line 21957 ""
+#line 21948 ""
s_wsfe(&io___1461);
/* Writing concatenation */
-#line 21957 ""
+#line 21948 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 21957 ""
+#line 21948 ""
i__4[1] = 3, a__2[1] = "let";
-#line 21957 ""
+#line 21948 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 21957 ""
+#line 21948 ""
i__4[3] = 9, a__2[3] = "stoppiece";
-#line 21957 ""
+#line 21948 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 21957 ""
+#line 21948 ""
i__4[5] = 9, a__2[5] = "holdstop%";
-#line 21957 ""
+#line 21948 ""
s_cat(ch__24, a__2, i__4, &c__6, (ftnlen)24);
-#line 21957 ""
+#line 21948 ""
do_fio(&c__1, ch__24, (ftnlen)24);
-#line 21957 ""
+#line 21948 ""
e_wsfe();
/* Since we bypass newmovement, need to set the vertical gap. */
-#line 21962 ""
+#line 21953 ""
if (comget_1.movgap > 10) {
-#line 21963 ""
+#line 21954 ""
s_wsfe(&io___1462);
/* Writing concatenation */
-#line 21963 ""
+#line 21954 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21963 ""
+#line 21954 ""
i__6[1] = 5, a__4[1] = "vskip";
-#line 21963 ""
+#line 21954 ""
s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6);
-#line 21963 ""
+#line 21954 ""
do_fio(&c__1, ch__25, (ftnlen)6);
-#line 21963 ""
+#line 21954 ""
do_fio(&c__1, (char *)&comget_1.movgap, (
ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 21963 ""
+#line 21954 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 21963 ""
+#line 21954 ""
i__11[1] = 10, a__8[1] = "internote%";
-#line 21963 ""
+#line 21954 ""
s_cat(ch__15, a__8, i__11, &c__2, (ftnlen)11);
-#line 21963 ""
+#line 21954 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 21963 ""
+#line 21954 ""
e_wsfe();
-#line 21965 ""
+#line 21956 ""
} else if (comget_1.movgap > 0) {
-#line 21966 ""
+#line 21957 ""
s_wsfe(&io___1463);
/* Writing concatenation */
-#line 21966 ""
+#line 21957 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21966 ""
+#line 21957 ""
i__6[1] = 5, a__4[1] = "vskip";
-#line 21966 ""
+#line 21957 ""
s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6);
-#line 21966 ""
+#line 21957 ""
do_fio(&c__1, ch__25, (ftnlen)6);
-#line 21966 ""
+#line 21957 ""
do_fio(&c__1, (char *)&comget_1.movgap, (
ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 21966 ""
+#line 21957 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 21966 ""
+#line 21957 ""
i__11[1] = 10, a__8[1] = "internote%";
-#line 21966 ""
+#line 21957 ""
s_cat(ch__15, a__8, i__11, &c__2, (ftnlen)11);
-#line 21966 ""
+#line 21957 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 21966 ""
+#line 21957 ""
e_wsfe();
-#line 21968 ""
+#line 21959 ""
}
-#line 21969 ""
+#line 21960 ""
comshort_1.ishort = 6;
-#line 21970 ""
+#line 21961 ""
}
-#line 21971 ""
+#line 21962 ""
if ((comshort_1.ishort == 5 || comshort_1.ishort == 6)
&& ! comnvi_1.rename) {
-#line 21972 ""
- i__7 = comnotes_1.ninow;
-#line 21972 ""
- for (iinst = 1; iinst <= i__7; ++iinst) {
-#line 21973 ""
+#line 21963 ""
+ i__2 = comnotes_1.ninow;
+#line 21963 ""
+ for (iinst = 1; iinst <= i__2; ++iinst) {
+#line 21964 ""
if (comlast_1.islast) {
-#line 21974 ""
+#line 21965 ""
if (iinst < 10) {
-#line 21975 ""
+#line 21966 ""
s_wsfe(&io___1464);
/* Writing concatenation */
-#line 21975 ""
+#line 21966 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21975 ""
+#line 21966 ""
i__6[1] = 7, a__4[1] = "setname";
-#line 21975 ""
+#line 21966 ""
s_cat(ch__8, a__4, i__6, &c__2, (
ftnlen)8);
-#line 21975 ""
+#line 21966 ""
do_fio(&c__1, ch__8, (ftnlen)8);
-#line 21975 ""
+#line 21966 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)
sizeof(integer));
-#line 21975 ""
+#line 21966 ""
do_fio(&c__1, "{}%", (ftnlen)3);
-#line 21975 ""
+#line 21966 ""
e_wsfe();
-#line 21976 ""
+#line 21967 ""
} else {
-#line 21977 ""
+#line 21968 ""
s_wsfe(&io___1465);
/* Writing concatenation */
-#line 21977 ""
+#line 21968 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 21977 ""
+#line 21968 ""
i__6[1] = 8, a__4[1] = "setname{";
-#line 21977 ""
+#line 21968 ""
s_cat(ch__18, a__4, i__6, &c__2, (
ftnlen)9);
-#line 21977 ""
+#line 21968 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 21977 ""
+#line 21968 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)
sizeof(integer));
-#line 21977 ""
+#line 21968 ""
do_fio(&c__1, "}{}%", (ftnlen)4);
-#line 21977 ""
+#line 21968 ""
e_wsfe();
-#line 21979 ""
+#line 21970 ""
}
-#line 21980 ""
+#line 21971 ""
}
-#line 21981 ""
+#line 21972 ""
/* L62: */
-#line 21981 ""
+#line 21972 ""
}
-#line 21982 ""
+#line 21973 ""
}
-#line 21983 ""
+#line 21974 ""
comnvi_1.rename = FALSE_;
-#line 21984 ""
+#line 21975 ""
}
/* Change generalmeter if necessary */
-#line 21988 ""
+#line 21979 ""
if (comlast_1.islast) {
-#line 21989 ""
+#line 21980 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 21990 ""
+#line 21981 ""
}
-#line 21991 ""
- all_1.mtrnuml = 0;
+/* Removed next line 211207 to fix beaming problem at new movement+meter change. */
+/* mtrnuml = 0 */
/* (Moved all name-writing to getnote, right when 'M' is detected) */
-#line 21995 ""
+#line 21987 ""
if (bit_test(iplnow,28)) {
/* Key signature at movement break */
-#line 21999 ""
+#line 21991 ""
iplnow = bit_clear(iplnow,28);
-#line 22000 ""
+#line 21992 ""
if (comtop_1.isig > 0) {
-#line 22001 ""
+#line 21993 ""
if (comlast_1.islast) {
-#line 22001 ""
+#line 21993 ""
s_wsfe(&io___1466);
/* Writing concatenation */
-#line 22001 ""
+#line 21993 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22001 ""
+#line 21993 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
-#line 22001 ""
+#line 21993 ""
s_cat(ch__26, a__4, i__6, &c__2, (ftnlen)18);
-#line 22001 ""
+#line 21993 ""
do_fio(&c__1, ch__26, (ftnlen)18);
-#line 22001 ""
+#line 21993 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
sizeof(integer));
-#line 22001 ""
+#line 21993 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 22001 ""
+#line 21993 ""
e_wsfe();
-#line 22001 ""
+#line 21993 ""
}
-#line 22003 ""
+#line 21995 ""
} else {
-#line 22004 ""
+#line 21996 ""
if (comlast_1.islast) {
-#line 22004 ""
+#line 21996 ""
s_wsfe(&io___1467);
/* Writing concatenation */
-#line 22004 ""
+#line 21996 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22004 ""
+#line 21996 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
-#line 22004 ""
+#line 21996 ""
s_cat(ch__26, a__4, i__6, &c__2, (ftnlen)18);
-#line 22004 ""
+#line 21996 ""
do_fio(&c__1, ch__26, (ftnlen)18);
-#line 22004 ""
+#line 21996 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)
sizeof(integer));
-#line 22004 ""
+#line 21996 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 22004 ""
+#line 21996 ""
e_wsfe();
-#line 22004 ""
+#line 21996 ""
}
-#line 22006 ""
+#line 21998 ""
}
-#line 22007 ""
+#line 21999 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
-#line 22008 ""
+#line 22000 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
-#line 22010 ""
+#line 22002 ""
}
-#line 22011 ""
+#line 22003 ""
}
-#line 22012 ""
+#line 22004 ""
if (comget_1.parmov >= -.1f) {
/* Resent paragraph indentation */
-#line 22016 ""
+#line 22008 ""
ipi = comget_1.parmov * comtop_1.widthpt + .1f;
-#line 22017 ""
+#line 22009 ""
if (ipi < 10) {
-#line 22018 ""
+#line 22010 ""
if (comlast_1.islast) {
-#line 22018 ""
+#line 22010 ""
s_wsfe(&io___1469);
/* Writing concatenation */
-#line 22018 ""
+#line 22010 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22018 ""
+#line 22010 ""
i__6[1] = 10, a__4[1] = "parindent ";
-#line 22018 ""
+#line 22010 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22018 ""
+#line 22010 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22018 ""
+#line 22010 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
-#line 22018 ""
+#line 22010 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 22018 ""
+#line 22010 ""
e_wsfe();
-#line 22018 ""
+#line 22010 ""
}
-#line 22020 ""
+#line 22012 ""
} else if (ipi < 100) {
-#line 22021 ""
+#line 22013 ""
if (comlast_1.islast) {
-#line 22021 ""
+#line 22013 ""
s_wsfe(&io___1470);
/* Writing concatenation */
-#line 22021 ""
+#line 22013 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22021 ""
+#line 22013 ""
i__6[1] = 10, a__4[1] = "parindent ";
-#line 22021 ""
+#line 22013 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22021 ""
+#line 22013 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22021 ""
+#line 22013 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
-#line 22021 ""
+#line 22013 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 22021 ""
+#line 22013 ""
e_wsfe();
-#line 22021 ""
+#line 22013 ""
}
-#line 22023 ""
+#line 22015 ""
} else {
-#line 22024 ""
+#line 22016 ""
if (comlast_1.islast) {
-#line 22024 ""
+#line 22016 ""
s_wsfe(&io___1471);
/* Writing concatenation */
-#line 22024 ""
+#line 22016 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22024 ""
+#line 22016 ""
i__6[1] = 10, a__4[1] = "parindent ";
-#line 22024 ""
+#line 22016 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22024 ""
+#line 22016 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22024 ""
+#line 22016 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(
integer));
-#line 22024 ""
+#line 22016 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 22024 ""
+#line 22016 ""
e_wsfe();
-#line 22024 ""
+#line 22016 ""
}
-#line 22026 ""
+#line 22018 ""
}
-#line 22027 ""
+#line 22019 ""
}
-#line 22028 ""
+#line 22020 ""
if (comshort_1.ishort == 6) {
-#line 22029 ""
+#line 22021 ""
if (iflagbot == 1) {
-#line 22030 ""
+#line 22022 ""
s_wsfe(&io___1472);
/* Writing concatenation */
-#line 22030 ""
+#line 22022 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22030 ""
+#line 22022 ""
i__5[1] = 5, a__3[1] = "vfill";
-#line 22030 ""
+#line 22022 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22030 ""
+#line 22022 ""
i__5[3] = 5, a__3[3] = "eject";
-#line 22030 ""
+#line 22022 ""
s_cat(ch__14, a__3, i__5, &c__4, (ftnlen)12);
-#line 22030 ""
+#line 22022 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22030 ""
+#line 22022 ""
e_wsfe();
/* iflagbot = 0 */
/* ishort = 0 */
-#line 22033 ""
+#line 22025 ""
} else {
-#line 22034 ""
+#line 22026 ""
s_wsfe(&io___1473);
/* Writing concatenation */
-#line 22034 ""
+#line 22026 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22034 ""
+#line 22026 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22034 ""
+#line 22026 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22034 ""
+#line 22026 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22034 ""
+#line 22026 ""
e_wsfe();
-#line 22035 ""
+#line 22027 ""
}
/* Zero ishort later trying to write alaligne */
-#line 22039 ""
+#line 22031 ""
}
-#line 22040 ""
+#line 22032 ""
}
/* End of movement break stuff */
-#line 22041 ""
+#line 22033 ""
if (isystpg == 1) {
/* First line on a page (not 1st page, still first bar). Tidy up old page */
@@ -52946,307 +53219,307 @@ L51:
/* Check for meter change at start of a new PAGE */
-#line 22056 ""
+#line 22048 ""
if (all_1.mtrnuml > 0) {
/* Meter change at start of a new page. Ugly repeated coding here. */
-#line 22060 ""
+#line 22052 ""
mtrnms = all_1.mtrnuml;
-#line 22061 ""
+#line 22053 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
-#line 22062 ""
+#line 22054 ""
all_1.mtrnuml = mtrnms;
-#line 22063 ""
+#line 22055 ""
if (comget_1.movbrk == 0 && comlast_1.islast) {
-#line 22064 ""
+#line 22056 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22065 ""
+#line 22057 ""
}
-#line 22066 ""
+#line 22058 ""
}
/* Key signature change? */
-#line 22070 ""
+#line 22062 ""
if (bit_test(iplnow,28) && comget_1.movbrk == 0) {
/* Writing concatenation */
-#line 22071 ""
+#line 22063 ""
i__14[0] = 1, a__10[0] = all_1.sq;
-#line 22071 ""
+#line 22063 ""
i__14[1] = 4, a__10[1] = "xbar";
-#line 22071 ""
+#line 22063 ""
i__14[2] = 1, a__10[2] = all_1.sq;
-#line 22071 ""
+#line 22063 ""
i__14[3] = 10, a__10[3] = "addspace{-";
-#line 22071 ""
+#line 22063 ""
i__14[4] = 1, a__10[4] = all_1.sq;
-#line 22071 ""
+#line 22063 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
-#line 22071 ""
+#line 22063 ""
i__14[6] = 1, a__10[6] = all_1.sq;
-#line 22071 ""
+#line 22063 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
-#line 22071 ""
+#line 22063 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
-#line 22073 ""
+#line 22065 ""
lnote = 49;
-#line 22074 ""
+#line 22066 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
-#line 22075 ""
+#line 22067 ""
i__6[0] = 49, a__4[0] = notexq;
-#line 22075 ""
+#line 22067 ""
i__6[1] = 1, a__4[1] = "-";
-#line 22075 ""
+#line 22067 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 22076 ""
+#line 22068 ""
lnote = 50;
-#line 22077 ""
+#line 22069 ""
}
-#line 22078 ""
+#line 22070 ""
if (comlast_1.islast) {
-#line 22078 ""
+#line 22070 ""
s_wsfe(&io___1475);
/* Writing concatenation */
-#line 22078 ""
+#line 22070 ""
i__8[0] = lnote, a__5[0] = notexq;
-#line 22078 ""
- i__7 = abs(comtop_1.isig) + 48;
-#line 22078 ""
- chax_(ch__1, (ftnlen)1, &i__7);
-#line 22078 ""
+#line 22070 ""
+ i__2 = abs(comtop_1.isig) + 48;
+#line 22070 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 22070 ""
i__8[1] = 1, a__5[1] = ch__1;
-#line 22078 ""
+#line 22070 ""
i__8[2] = 2, a__5[2] = "}%";
-#line 22078 ""
+#line 22070 ""
s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82);
-#line 22078 ""
+#line 22070 ""
do_fio(&c__1, ch__27, lnote + 3);
-#line 22078 ""
+#line 22070 ""
e_wsfe();
-#line 22078 ""
+#line 22070 ""
}
-#line 22080 ""
+#line 22072 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
-#line 22081 ""
+#line 22073 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
-#line 22083 ""
+#line 22075 ""
}
-#line 22084 ""
+#line 22076 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
-#line 22084 ""
+#line 22076 ""
s_wsfe(&io___1476);
/* Writing concatenation */
-#line 22084 ""
+#line 22076 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22084 ""
+#line 22076 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22084 ""
+#line 22076 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22084 ""
+#line 22076 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22084 ""
+#line 22076 ""
e_wsfe();
-#line 22084 ""
+#line 22076 ""
}
-#line 22086 ""
+#line 22078 ""
if (comlast_1.islast) {
-#line 22086 ""
+#line 22078 ""
s_wsfe(&io___1477);
/* Writing concatenation */
-#line 22086 ""
+#line 22078 ""
i__9[0] = 1, a__6[0] = all_1.sq;
-#line 22086 ""
+#line 22078 ""
i__9[1] = 14, a__6[1] = "zchangecontext";
-#line 22086 ""
+#line 22078 ""
i__9[2] = 1, a__6[2] = all_1.sq;
-#line 22086 ""
+#line 22078 ""
i__9[3] = 10, a__6[3] = "addspace{-";
-#line 22086 ""
+#line 22078 ""
i__9[4] = 1, a__6[4] = all_1.sq;
-#line 22086 ""
+#line 22078 ""
i__9[5] = 14, a__6[5] = "afterruleskip}";
-#line 22086 ""
+#line 22078 ""
i__9[6] = 1, a__6[6] = all_1.sq;
-#line 22086 ""
+#line 22078 ""
i__9[7] = 10, a__6[7] = "zstoppiece";
-#line 22086 ""
+#line 22078 ""
i__9[8] = 1, a__6[8] = all_1.sq;
-#line 22086 ""
+#line 22078 ""
i__9[9] = 13, a__6[9] = "PMXbarnotrue%";
-#line 22086 ""
+#line 22078 ""
s_cat(ch__28, a__6, i__9, &c__10, (ftnlen)66);
-#line 22086 ""
+#line 22078 ""
do_fio(&c__1, ch__28, (ftnlen)66);
-#line 22086 ""
+#line 22078 ""
e_wsfe();
-#line 22086 ""
+#line 22078 ""
}
-#line 22089 ""
+#line 22081 ""
} else if (all_1.mtrnuml > 0 && comget_1.movbrk == 0) {
/* Meter change but no signature change */
-#line 22093 ""
+#line 22085 ""
if (comlast_1.islast) {
-#line 22093 ""
+#line 22085 ""
s_wsfe(&io___1478);
/* Writing concatenation */
-#line 22093 ""
+#line 22085 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
-#line 22093 ""
+#line 22085 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[3] = 10, a__1[3] = "addspace{-";
-#line 22093 ""
+#line 22085 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
-#line 22093 ""
+#line 22085 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[7] = 3, a__1[7] = "let";
-#line 22093 ""
+#line 22085 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[9] = 4, a__1[9] = "bnat";
-#line 22093 ""
+#line 22085 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 22093 ""
+#line 22085 ""
i__3[11] = 9, a__1[11] = "barnoadd%";
-#line 22093 ""
+#line 22085 ""
s_cat(ch__29, a__1, i__3, &c__12, (ftnlen)60);
-#line 22093 ""
+#line 22085 ""
do_fio(&c__1, ch__29, (ftnlen)60);
-#line 22093 ""
+#line 22085 ""
e_wsfe();
-#line 22093 ""
+#line 22085 ""
}
-#line 22097 ""
+#line 22089 ""
if (comlast_1.islast) {
-#line 22097 ""
+#line 22089 ""
s_wsfe(&io___1479);
/* Writing concatenation */
-#line 22097 ""
+#line 22089 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[1] = 3, a__1[1] = "def";
-#line 22097 ""
+#line 22089 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[3] = 9, a__1[3] = "barnoadd{";
-#line 22097 ""
+#line 22089 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[5] = 3, a__1[5] = "let";
-#line 22097 ""
+#line 22089 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[7] = 8, a__1[7] = "barnoadd";
-#line 22097 ""
+#line 22089 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[9] = 5, a__1[9] = "bnat}";
-#line 22097 ""
+#line 22089 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 22097 ""
+#line 22089 ""
i__3[11] = 11, a__1[11] = "zstoppiece%";
-#line 22097 ""
+#line 22089 ""
s_cat(ch__30, a__1, i__3, &c__12, (ftnlen)45);
-#line 22097 ""
+#line 22089 ""
do_fio(&c__1, ch__30, (ftnlen)45);
-#line 22097 ""
+#line 22089 ""
e_wsfe();
-#line 22097 ""
+#line 22089 ""
}
-#line 22100 ""
+#line 22092 ""
} else {
-#line 22101 ""
+#line 22093 ""
if (comlast_1.islast) {
-#line 22102 ""
+#line 22094 ""
if ((comshort_1.ishort == 4 || comshort_1.ishort
== 2) && iflagbot == 1) {
-#line 22104 ""
+#line 22096 ""
ntmp = combibarcnt_1.ibarcnt - ibarcnt0 -
comshort_1.nmbr + comshort_1.mbrsum;
-#line 22105 ""
+#line 22097 ""
if (ntmp <= 9) {
-#line 22106 ""
+#line 22098 ""
*(unsigned char *)shortfraq = (char) (
ntmp + 48);
-#line 22107 ""
+#line 22099 ""
lntmp = 1;
-#line 22108 ""
+#line 22100 ""
} else {
-#line 22109 ""
+#line 22101 ""
s_wsfi(&io___1484);
-#line 22109 ""
+#line 22101 ""
do_fio(&c__1, (char *)&ntmp, (ftnlen)
sizeof(integer));
-#line 22109 ""
+#line 22101 ""
e_wsfi();
-#line 22110 ""
+#line 22102 ""
lntmp = 2;
-#line 22111 ""
+#line 22103 ""
}
-#line 22112 ""
+#line 22104 ""
s_wsfe(&io___1485);
/* Writing concatenation */
-#line 22112 ""
+#line 22104 ""
i__15[0] = 1, a__11[0] = all_1.sq;
-#line 22112 ""
+#line 22104 ""
i__15[1] = 10, a__11[1] = "endpiece}}";
-#line 22112 ""
+#line 22104 ""
i__15[2] = 1, a__11[2] = all_1.sq;
-#line 22112 ""
+#line 22104 ""
i__15[3] = 7, a__11[3] = "advance";
-#line 22112 ""
+#line 22104 ""
i__15[4] = 1, a__11[4] = all_1.sq;
-#line 22112 ""
+#line 22104 ""
i__15[5] = 5, a__11[5] = "barno";
-#line 22112 ""
+#line 22104 ""
i__15[6] = lntmp, a__11[6] = shortfraq;
-#line 22112 ""
+#line 22104 ""
s_cat(ch__31, a__11, i__15, &c__7, (ftnlen)28)
;
-#line 22112 ""
+#line 22104 ""
do_fio(&c__1, ch__31, lntmp + 25);
-#line 22112 ""
+#line 22104 ""
e_wsfe();
/* Move down so can insert fil@begin */
/* iflagbot = 0 */
/* ishort = 0 */
-#line 22119 ""
+#line 22111 ""
} else if (comshort_1.ishort != 6 &&
comshort_1.ishort != 2 || iflagbot != 1) {
-#line 22121 ""
+#line 22113 ""
s_wsfe(&io___1486);
/* Writing concatenation */
-#line 22121 ""
+#line 22113 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22121 ""
+#line 22113 ""
i__6[1] = 10, a__4[1] = "stoppiece%";
-#line 22121 ""
+#line 22113 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22121 ""
+#line 22113 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22121 ""
+#line 22113 ""
e_wsfe();
-#line 22122 ""
+#line 22114 ""
}
-#line 22123 ""
+#line 22115 ""
}
-#line 22124 ""
+#line 22116 ""
}
/* This is the key spot when vshrink is used. Value of vshrink here comes from */
@@ -53260,1211 +53533,1211 @@ L51:
/* second pass, vshrink at top of page one is dealt with in topfile, which is called */
/* *before* any reading in any "Av" at the top of the first input block. */
-#line 22137 ""
+#line 22129 ""
if (! vshrink) {
-#line 22138 ""
+#line 22130 ""
if (comlast_1.islast && combottop_1.bottopgap) {
-#line 22139 ""
+#line 22131 ""
if (dabs(combottop_1.botamt) > 1e-6f) {
-#line 22140 ""
+#line 22132 ""
if (combottop_1.botamt > 9.95f) {
-#line 22141 ""
+#line 22133 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22142 ""
+#line 22134 ""
} else if (combottop_1.botamt > 0.f) {
-#line 22143 ""
+#line 22135 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22144 ""
+#line 22136 ""
} else if (combottop_1.botamt > -9.95f) {
-#line 22145 ""
+#line 22137 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22146 ""
+#line 22138 ""
} else {
-#line 22147 ""
+#line 22139 ""
s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22148 ""
+#line 22140 ""
}
-#line 22149 ""
+#line 22141 ""
s_wsfe(&io___1487);
/* Writing concatenation */
-#line 22149 ""
+#line 22141 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22149 ""
+#line 22141 ""
i__5[1] = 4, a__3[1] = "null";
-#line 22149 ""
+#line 22141 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22149 ""
+#line 22141 ""
i__5[3] = 5, a__3[3] = "vskip";
-#line 22149 ""
+#line 22141 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 22149 ""
+#line 22141 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22149 ""
+#line 22141 ""
do_fio(&c__1, (char *)&combottop_1.botamt, (
ftnlen)sizeof(real));
/* Writing concatenation */
-#line 22149 ""
+#line 22141 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22149 ""
+#line 22141 ""
i__6[1] = 10, a__4[1] = "Internote%";
-#line 22149 ""
+#line 22141 ""
s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11);
-#line 22149 ""
+#line 22141 ""
do_fio(&c__1, ch__32, (ftnlen)11);
-#line 22149 ""
+#line 22141 ""
e_wsfe();
-#line 22151 ""
+#line 22143 ""
}
-#line 22152 ""
+#line 22144 ""
}
-#line 22153 ""
+#line 22145 ""
xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot /
etatop;
-#line 22154 ""
+#line 22146 ""
if (xnstbot < 9.95f) {
-#line 22155 ""
+#line 22147 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10)
;
-#line 22156 ""
+#line 22148 ""
} else {
-#line 22157 ""
+#line 22149 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10)
;
-#line 22158 ""
+#line 22150 ""
}
-#line 22159 ""
+#line 22151 ""
if (comlast_1.islast) {
-#line 22159 ""
+#line 22151 ""
s_wsfe(&io___1489);
/* Writing concatenation */
-#line 22159 ""
+#line 22151 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22159 ""
+#line 22151 ""
i__6[1] = 5, a__4[1] = "vskip";
-#line 22159 ""
+#line 22151 ""
s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6);
-#line 22159 ""
+#line 22151 ""
do_fio(&c__1, ch__25, (ftnlen)6);
-#line 22159 ""
+#line 22151 ""
do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(
real));
/* Writing concatenation */
-#line 22159 ""
+#line 22151 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22159 ""
+#line 22151 ""
i__5[1] = 10, a__3[1] = "Interligne";
-#line 22159 ""
+#line 22151 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22159 ""
+#line 22151 ""
i__5[3] = 6, a__3[3] = "eject%";
-#line 22159 ""
+#line 22151 ""
s_cat(ch__26, a__3, i__5, &c__4, (ftnlen)18);
-#line 22159 ""
+#line 22151 ""
do_fio(&c__1, ch__26, (ftnlen)18);
-#line 22159 ""
+#line 22151 ""
e_wsfe();
-#line 22159 ""
+#line 22151 ""
}
-#line 22161 ""
+#line 22153 ""
if (comlast_1.islast && combottop_1.bottopgap) {
-#line 22162 ""
+#line 22154 ""
if (dabs(combottop_1.topamt) > 1e-6f) {
-#line 22163 ""
+#line 22155 ""
if (combottop_1.topamt > 9.95f) {
-#line 22164 ""
+#line 22156 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22165 ""
+#line 22157 ""
} else if (combottop_1.topamt > 0.f) {
-#line 22166 ""
+#line 22158 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22167 ""
+#line 22159 ""
} else if (combottop_1.topamt > -9.95f) {
-#line 22168 ""
+#line 22160 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22169 ""
+#line 22161 ""
} else {
-#line 22170 ""
+#line 22162 ""
s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (
ftnlen)10);
-#line 22171 ""
+#line 22163 ""
}
-#line 22172 ""
+#line 22164 ""
s_wsfe(&io___1490);
/* Writing concatenation */
-#line 22172 ""
+#line 22164 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22172 ""
+#line 22164 ""
i__5[1] = 4, a__3[1] = "null";
-#line 22172 ""
+#line 22164 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22172 ""
+#line 22164 ""
i__5[3] = 5, a__3[3] = "vskip";
-#line 22172 ""
+#line 22164 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 22172 ""
+#line 22164 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22172 ""
+#line 22164 ""
do_fio(&c__1, (char *)&combottop_1.topamt, (
ftnlen)sizeof(real));
/* Writing concatenation */
-#line 22172 ""
+#line 22164 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22172 ""
+#line 22164 ""
i__6[1] = 10, a__4[1] = "Internote%";
-#line 22172 ""
+#line 22164 ""
s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11);
-#line 22172 ""
+#line 22164 ""
do_fio(&c__1, ch__32, (ftnlen)11);
-#line 22172 ""
+#line 22164 ""
e_wsfe();
-#line 22174 ""
+#line 22166 ""
}
-#line 22175 ""
+#line 22167 ""
combottop_1.bottopgap = FALSE_;
-#line 22176 ""
+#line 22168 ""
}
-#line 22177 ""
+#line 22169 ""
} else {
-#line 22178 ""
+#line 22170 ""
if (comlast_1.islast) {
-#line 22179 ""
+#line 22171 ""
if (iflagbot == 1 && comshort_1.ishort == 6) {
/* cleanup for case bcm only */
-#line 22183 ""
+#line 22175 ""
iflagbot = 0;
-#line 22184 ""
+#line 22176 ""
comshort_1.ishort = 0;
-#line 22185 ""
+#line 22177 ""
} else {
-#line 22186 ""
+#line 22178 ""
s_wsfe(&io___1491);
/* Writing concatenation */
-#line 22186 ""
+#line 22178 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22186 ""
+#line 22178 ""
i__5[1] = 5, a__3[1] = "vfill";
-#line 22186 ""
+#line 22178 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22186 ""
+#line 22178 ""
i__5[3] = 6, a__3[3] = "eject%";
-#line 22186 ""
+#line 22178 ""
s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)13);
-#line 22186 ""
+#line 22178 ""
do_fio(&c__1, ch__17, (ftnlen)13);
-#line 22186 ""
+#line 22178 ""
e_wsfe();
-#line 22187 ""
+#line 22179 ""
if (iflagbot == 1 && comshort_1.ishort == 2) {
/* Clean up case bsl only */
-#line 22189 ""
+#line 22181 ""
s_wsfe(&io___1492);
/* Writing concatenation */
-#line 22189 ""
+#line 22181 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22189 ""
+#line 22181 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22189 ""
+#line 22181 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22189 ""
+#line 22181 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22189 ""
+#line 22181 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22189 ""
+#line 22181 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22189 ""
+#line 22181 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)
35);
-#line 22189 ""
+#line 22181 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22189 ""
+#line 22181 ""
e_wsfe();
-#line 22191 ""
+#line 22183 ""
iflagbot = 0;
-#line 22192 ""
+#line 22184 ""
comshort_1.ishort = 0;
-#line 22193 ""
+#line 22185 ""
}
-#line 22194 ""
+#line 22186 ""
}
-#line 22195 ""
+#line 22187 ""
}
-#line 22196 ""
+#line 22188 ""
}
-#line 22197 ""
+#line 22189 ""
++comnotes_1.ipage;
/* Now that page is ejected, compute new vshrink */
-#line 22201 ""
+#line 22193 ""
vshrink = xintstaff[comnotes_1.ipage - 1] > 20.f &&
comlast_1.usevshrink;
-#line 22202 ""
+#line 22194 ""
if (vshrink) {
-#line 22203 ""
+#line 22195 ""
comarp_1.xinsnow = 10.f;
-#line 22204 ""
+#line 22196 ""
} else {
-#line 22205 ""
+#line 22197 ""
comarp_1.xinsnow = xintstaff[comnotes_1.ipage - 1];
-#line 22206 ""
+#line 22198 ""
}
-#line 22207 ""
+#line 22199 ""
if (comget_1.fintstf > 0.f && comnotes_1.ipage > 1) {
-#line 22208 ""
+#line 22200 ""
comarp_1.xinsnow = comarp_1.xinsnow *
comget_1.fintstf / comget_1.gintstf;
-#line 22209 ""
+#line 22201 ""
comget_1.fintstf = -1.f;
-#line 22210 ""
+#line 22202 ""
}
-#line 22211 ""
+#line 22203 ""
if (comarp_1.xinsnow < 9.95f) {
-#line 22212 ""
+#line 22204 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22213 ""
+#line 22205 ""
} else if (comarp_1.xinsnow < 99.95f) {
-#line 22214 ""
+#line 22206 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22215 ""
+#line 22207 ""
} else {
-#line 22216 ""
+#line 22208 ""
s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22217 ""
+#line 22209 ""
}
/* Vertical spacing parameters, then restart */
-#line 22221 ""
+#line 22213 ""
if (comis4bignv_1.is4bignv) {
-#line 22221 ""
+#line 22213 ""
comarp_1.xinsnow *= .95f;
-#line 22221 ""
+#line 22213 ""
}
-#line 22222 ""
+#line 22214 ""
if (comlast_1.islast) {
-#line 22223 ""
+#line 22215 ""
s_wsfe(&io___1493);
/* Writing concatenation */
-#line 22223 ""
+#line 22215 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22223 ""
+#line 22215 ""
i__6[1] = 11, a__4[1] = "interstaff{";
-#line 22223 ""
+#line 22215 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22223 ""
+#line 22215 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22223 ""
+#line 22215 ""
do_fio(&c__1, (char *)&comarp_1.xinsnow, (ftnlen)
sizeof(real));
/* Writing concatenation */
-#line 22223 ""
+#line 22215 ""
i__8[0] = 1, a__5[0] = "}";
-#line 22223 ""
+#line 22215 ""
i__8[1] = 1, a__5[1] = all_1.sq;
-#line 22223 ""
+#line 22215 ""
i__8[2] = 9, a__5[2] = "contpiece";
-#line 22223 ""
+#line 22215 ""
s_cat(ch__15, a__5, i__8, &c__3, (ftnlen)11);
-#line 22223 ""
+#line 22215 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22223 ""
+#line 22215 ""
e_wsfe();
-#line 22225 ""
+#line 22217 ""
}
/* Check for meter change at start of a new PAGE */
-#line 22229 ""
+#line 22221 ""
if (all_1.mtrnuml > 0) {
/* Meter change at start of a new page */
-#line 22233 ""
+#line 22225 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
-#line 22234 ""
+#line 22226 ""
if (comget_1.movbrk == 0) {
-#line 22235 ""
+#line 22227 ""
if (comlast_1.islast) {
-#line 22236 ""
+#line 22228 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22237 ""
+#line 22229 ""
}
-#line 22238 ""
+#line 22230 ""
if (all_1.mtrdnp > 0) {
-#line 22239 ""
+#line 22231 ""
if (comlast_1.islast) {
-#line 22239 ""
+#line 22231 ""
s_wsfe(&io___1494);
/* Writing concatenation */
-#line 22239 ""
+#line 22231 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22239 ""
+#line 22231 ""
i__6[1] = 10, a__4[1] = "newtimes2%";
-#line 22239 ""
+#line 22231 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)
11);
-#line 22239 ""
+#line 22231 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22239 ""
+#line 22231 ""
e_wsfe();
-#line 22239 ""
+#line 22231 ""
}
-#line 22240 ""
+#line 22232 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
-#line 22240 ""
+#line 22232 ""
comgrace_1.xb4mbr = all_1.musicsize *
-.2f;
-#line 22240 ""
+#line 22232 ""
}
-#line 22241 ""
+#line 22233 ""
}
-#line 22242 ""
+#line 22234 ""
}
-#line 22243 ""
+#line 22235 ""
}
/* If no real titles here, which there probably will never be, make vertical */
/* space at page top with \titles{...}. headlog=.false.<=>no real titles */
-#line 22248 ""
+#line 22240 ""
if (comshort_1.ishort == 4 && iflagbot == 1) {
-#line 22249 ""
+#line 22241 ""
comshort_1.ishort = 0;
-#line 22250 ""
+#line 22242 ""
iflagbot = 0;
-#line 22251 ""
+#line 22243 ""
s_wsfe(&io___1495);
/* Writing concatenation */
-#line 22251 ""
+#line 22243 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22251 ""
+#line 22243 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22251 ""
+#line 22243 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22251 ""
+#line 22243 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22251 ""
+#line 22243 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22251 ""
+#line 22243 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22251 ""
+#line 22243 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22251 ""
+#line 22243 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22251 ""
+#line 22243 ""
e_wsfe();
-#line 22253 ""
+#line 22245 ""
}
-#line 22254 ""
+#line 22246 ""
puttitle_(&inhnoh, &xnsttop[comnotes_1.ipage - 1], &
etatop, all_1.sq, &etait, &etatc, &etacs1, &
all_1.nv, &vshrink, all_1.sepsymq, (ftnlen)1, (
ftnlen)1);
-#line 22256 ""
+#line 22248 ""
if (comnotes_1.headerspecial) {
-#line 22256 ""
+#line 22248 ""
s_wsfe(&io___1496);
/* Writing concatenation */
-#line 22256 ""
+#line 22248 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 22256 ""
+#line 22248 ""
i__6[0] = 1, a__4[0] = ch__1;
-#line 22256 ""
+#line 22248 ""
i__6[1] = 28, a__4[1] = "special{header=psslurs.pro}%"
;
-#line 22256 ""
+#line 22248 ""
s_cat(ch__7, a__4, i__6, &c__2, (ftnlen)29);
-#line 22256 ""
+#line 22248 ""
do_fio(&c__1, ch__7, (ftnlen)29);
-#line 22256 ""
+#line 22248 ""
e_wsfe();
-#line 22256 ""
+#line 22248 ""
}
/* Write special header for first page */
-#line 22261 ""
+#line 22253 ""
} else {
/* First bar of system, not a new page, force line break */
-#line 22265 ""
+#line 22257 ""
if (bit_test(iplnow,28)) {
/* Signature change */
/* Writing concatenation */
-#line 22269 ""
+#line 22261 ""
i__14[0] = 1, a__10[0] = all_1.sq;
-#line 22269 ""
+#line 22261 ""
i__14[1] = 4, a__10[1] = "xbar";
-#line 22269 ""
+#line 22261 ""
i__14[2] = 1, a__10[2] = all_1.sq;
-#line 22269 ""
+#line 22261 ""
i__14[3] = 10, a__10[3] = "addspace{-";
-#line 22269 ""
+#line 22261 ""
i__14[4] = 1, a__10[4] = all_1.sq;
-#line 22269 ""
+#line 22261 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
-#line 22269 ""
+#line 22261 ""
i__14[6] = 1, a__10[6] = all_1.sq;
-#line 22269 ""
+#line 22261 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
-#line 22269 ""
+#line 22261 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
-#line 22271 ""
+#line 22263 ""
lnote = 49;
-#line 22272 ""
+#line 22264 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
-#line 22273 ""
+#line 22265 ""
i__6[0] = 49, a__4[0] = notexq;
-#line 22273 ""
+#line 22265 ""
i__6[1] = 1, a__4[1] = "-";
-#line 22273 ""
+#line 22265 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 22274 ""
+#line 22266 ""
lnote = 50;
-#line 22275 ""
+#line 22267 ""
}
-#line 22276 ""
+#line 22268 ""
if (comlast_1.islast) {
-#line 22276 ""
+#line 22268 ""
s_wsfe(&io___1497);
/* Writing concatenation */
-#line 22276 ""
+#line 22268 ""
i__8[0] = lnote, a__5[0] = notexq;
-#line 22276 ""
- i__7 = abs(comtop_1.isig) + 48;
-#line 22276 ""
- chax_(ch__1, (ftnlen)1, &i__7);
-#line 22276 ""
+#line 22268 ""
+ i__2 = abs(comtop_1.isig) + 48;
+#line 22268 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 22268 ""
i__8[1] = 1, a__5[1] = ch__1;
-#line 22276 ""
+#line 22268 ""
i__8[2] = 2, a__5[2] = "}%";
-#line 22276 ""
+#line 22268 ""
s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82);
-#line 22276 ""
+#line 22268 ""
do_fio(&c__1, ch__27, lnote + 3);
-#line 22276 ""
+#line 22268 ""
e_wsfe();
-#line 22276 ""
+#line 22268 ""
}
-#line 22278 ""
+#line 22270 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
-#line 22279 ""
+#line 22271 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
-#line 22281 ""
+#line 22273 ""
}
-#line 22282 ""
+#line 22274 ""
if (comlast_1.islast) {
-#line 22282 ""
+#line 22274 ""
s_wsfe(&io___1498);
/* Writing concatenation */
-#line 22282 ""
+#line 22274 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22282 ""
+#line 22274 ""
i__5[1] = 7, a__3[1] = "advance";
-#line 22282 ""
+#line 22274 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22282 ""
+#line 22274 ""
i__5[3] = 8, a__3[3] = "barno-1%";
-#line 22282 ""
+#line 22274 ""
s_cat(ch__13, a__3, i__5, &c__4, (ftnlen)17);
-#line 22282 ""
+#line 22274 ""
do_fio(&c__1, ch__13, (ftnlen)17);
-#line 22282 ""
+#line 22274 ""
e_wsfe();
-#line 22282 ""
+#line 22274 ""
}
-#line 22283 ""
+#line 22275 ""
if (all_1.mtrnuml != 0) {
/* Meter+sig change, new line, may need mods if movement break here. */
-#line 22287 ""
+#line 22279 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
-#line 22288 ""
+#line 22280 ""
if (comlast_1.islast) {
-#line 22289 ""
+#line 22281 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22290 ""
+#line 22282 ""
if (comignorenats_1.ignorenats) {
-#line 22290 ""
+#line 22282 ""
s_wsfe(&io___1499);
/* Writing concatenation */
-#line 22290 ""
+#line 22282 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22290 ""
+#line 22282 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22290 ""
+#line 22282 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)
12);
-#line 22290 ""
+#line 22282 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22290 ""
+#line 22282 ""
e_wsfe();
-#line 22290 ""
+#line 22282 ""
}
-#line 22291 ""
+#line 22283 ""
s_wsfe(&io___1500);
/* Writing concatenation */
-#line 22291 ""
+#line 22283 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
-#line 22291 ""
+#line 22283 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[3] = 10, a__1[3] = "addspace{-";
-#line 22291 ""
+#line 22283 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
-#line 22291 ""
+#line 22283 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[7] = 10, a__1[7] = "zstoppiece";
-#line 22291 ""
+#line 22283 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[9] = 12, a__1[9] = "PMXbarnotrue";
-#line 22291 ""
+#line 22283 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 22291 ""
+#line 22283 ""
i__3[11] = 10, a__1[11] = "contpiece%";
-#line 22291 ""
+#line 22283 ""
s_cat(ch__33, a__1, i__3, &c__12, (ftnlen)76);
-#line 22291 ""
+#line 22283 ""
do_fio(&c__1, ch__33, (ftnlen)76);
-#line 22291 ""
+#line 22283 ""
e_wsfe();
-#line 22294 ""
+#line 22286 ""
s_wsfe(&io___1501);
/* Writing concatenation */
-#line 22294 ""
+#line 22286 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22294 ""
+#line 22286 ""
i__5[1] = 10, a__3[1] = "addspace{-";
-#line 22294 ""
+#line 22286 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22294 ""
+#line 22286 ""
i__5[3] = 15, a__3[3] = "afterruleskip}%";
-#line 22294 ""
+#line 22286 ""
s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)27);
-#line 22294 ""
+#line 22286 ""
do_fio(&c__1, ch__5, (ftnlen)27);
-#line 22294 ""
+#line 22286 ""
e_wsfe();
-#line 22296 ""
+#line 22288 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22297 ""
+#line 22289 ""
if (comignorenats_1.ignorenats) {
-#line 22297 ""
+#line 22289 ""
s_wsfe(&io___1502);
/* Writing concatenation */
-#line 22297 ""
+#line 22289 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22297 ""
+#line 22289 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22297 ""
+#line 22289 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)
12);
-#line 22297 ""
+#line 22289 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22297 ""
+#line 22289 ""
e_wsfe();
-#line 22297 ""
+#line 22289 ""
}
-#line 22298 ""
+#line 22290 ""
s_wsfe(&io___1503);
/* Writing concatenation */
-#line 22298 ""
+#line 22290 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22298 ""
+#line 22290 ""
i__6[1] = 14, a__4[1] = "zchangecontext";
-#line 22298 ""
+#line 22290 ""
s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)15);
-#line 22298 ""
+#line 22290 ""
do_fio(&c__1, ch__16, (ftnlen)15);
-#line 22298 ""
+#line 22290 ""
e_wsfe();
-#line 22299 ""
+#line 22291 ""
}
-#line 22300 ""
+#line 22292 ""
} else {
-#line 22301 ""
+#line 22293 ""
if (comlast_1.islast &&
comignorenats_1.ignorenats) {
-#line 22301 ""
+#line 22293 ""
s_wsfe(&io___1504);
/* Writing concatenation */
-#line 22301 ""
+#line 22293 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22301 ""
+#line 22293 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22301 ""
+#line 22293 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22301 ""
+#line 22293 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22301 ""
+#line 22293 ""
e_wsfe();
-#line 22301 ""
+#line 22293 ""
}
-#line 22303 ""
+#line 22295 ""
if (comlast_1.islast) {
-#line 22303 ""
+#line 22295 ""
s_wsfe(&io___1505);
/* Writing concatenation */
-#line 22303 ""
+#line 22295 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[1] = 14, a__1[1] = "xchangecontext";
-#line 22303 ""
+#line 22295 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[3] = 10, a__1[3] = "addspace{-";
-#line 22303 ""
+#line 22295 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[5] = 14, a__1[5] = "afterruleskip}";
-#line 22303 ""
+#line 22295 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[7] = 10, a__1[7] = "zstoppiece";
-#line 22303 ""
+#line 22295 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[9] = 12, a__1[9] = "PMXbarnotrue";
-#line 22303 ""
+#line 22295 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 22303 ""
+#line 22295 ""
i__3[11] = 10, a__1[11] = "contpiece%";
-#line 22303 ""
+#line 22295 ""
s_cat(ch__33, a__1, i__3, &c__12, (ftnlen)76);
-#line 22303 ""
+#line 22295 ""
do_fio(&c__1, ch__33, (ftnlen)76);
-#line 22303 ""
+#line 22295 ""
e_wsfe();
-#line 22303 ""
+#line 22295 ""
}
-#line 22306 ""
+#line 22298 ""
}
-#line 22307 ""
+#line 22299 ""
} else if (all_1.mtrnuml == 0 && (comshort_1.ishort == 0
|| comshort_1.ishort == 6)) {
/* No meter change */
-#line 22312 ""
+#line 22304 ""
if (comlast_1.islast) {
-#line 22313 ""
+#line 22305 ""
if (comshort_1.ishort != 6) {
-#line 22314 ""
+#line 22306 ""
s_wsfe(&io___1506);
/* Writing concatenation */
-#line 22314 ""
+#line 22306 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22314 ""
+#line 22306 ""
i__6[1] = 8, a__4[1] = "alaligne";
-#line 22314 ""
+#line 22306 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 22314 ""
+#line 22306 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22314 ""
+#line 22306 ""
e_wsfe();
-#line 22315 ""
+#line 22307 ""
} else {
-#line 22316 ""
+#line 22308 ""
comshort_1.ishort = 0;
-#line 22317 ""
+#line 22309 ""
}
-#line 22318 ""
+#line 22310 ""
}
-#line 22319 ""
+#line 22311 ""
} else if (comshort_1.ishort != 0) {
-#line 22320 ""
+#line 22312 ""
if (comshort_1.ishort == 1) {
/* Start short line */
-#line 22321 ""
+#line 22313 ""
s_wsfi(&io___1507);
-#line 22321 ""
+#line 22313 ""
do_fio(&c__1, (char *)&comshort_1.shortfrac, (
ftnlen)sizeof(real));
-#line 22321 ""
+#line 22313 ""
e_wsfi();
-#line 22322 ""
+#line 22314 ""
s_wsfe(&io___1508);
/* Writing concatenation */
-#line 22322 ""
+#line 22314 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22322 ""
+#line 22314 ""
i__5[1] = 9, a__3[1] = "stoppiece";
-#line 22322 ""
+#line 22314 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22322 ""
+#line 22314 ""
i__5[3] = 13, a__3[3] = "parindent 0pt";
-#line 22322 ""
+#line 22314 ""
s_cat(ch__24, a__3, i__5, &c__4, (ftnlen)24);
-#line 22322 ""
+#line 22314 ""
do_fio(&c__1, ch__24, (ftnlen)24);
-#line 22322 ""
+#line 22314 ""
e_wsfe();
-#line 22323 ""
+#line 22315 ""
s_wsfe(&io___1509);
/* Writing concatenation */
-#line 22323 ""
+#line 22315 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22323 ""
+#line 22315 ""
i__5[1] = 5, a__3[1] = "vskip";
-#line 22323 ""
+#line 22315 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22323 ""
+#line 22315 ""
i__5[3] = 7, a__3[3] = "parskip";
-#line 22323 ""
+#line 22315 ""
s_cat(ch__10, a__3, i__5, &c__4, (ftnlen)14);
-#line 22323 ""
+#line 22315 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 22323 ""
+#line 22315 ""
e_wsfe();
-#line 22324 ""
+#line 22316 ""
s_wsfe(&io___1510);
/* Writing concatenation */
-#line 22324 ""
+#line 22316 ""
i__16[0] = 1, a__12[0] = all_1.sq;
-#line 22324 ""
+#line 22316 ""
i__16[1] = 7, a__12[1] = "hbox to";
-#line 22324 ""
+#line 22316 ""
i__16[2] = 1, a__12[2] = all_1.sq;
-#line 22324 ""
+#line 22316 ""
i__16[3] = 6, a__12[3] = "hsize{";
-#line 22324 ""
+#line 22316 ""
i__16[4] = 1, a__12[4] = all_1.sq;
-#line 22324 ""
+#line 22316 ""
i__16[5] = 5, a__12[5] = "vbox{";
-#line 22324 ""
+#line 22316 ""
i__16[6] = 1, a__12[6] = all_1.sq;
-#line 22324 ""
+#line 22316 ""
i__16[7] = 6, a__12[7] = "hsize=";
-#line 22324 ""
+#line 22316 ""
i__16[8] = 3, a__12[8] = shortfraq;
-#line 22324 ""
+#line 22316 ""
i__16[9] = 1, a__12[9] = all_1.sq;
-#line 22324 ""
+#line 22316 ""
i__16[10] = 6, a__12[10] = "hsize%";
-#line 22324 ""
+#line 22316 ""
s_cat(ch__34, a__12, i__16, &c__11, (ftnlen)38);
-#line 22324 ""
+#line 22316 ""
do_fio(&c__1, ch__34, (ftnlen)38);
-#line 22324 ""
+#line 22316 ""
e_wsfe();
-#line 22327 ""
+#line 22319 ""
s_wsfe(&io___1511);
/* Writing concatenation */
-#line 22327 ""
+#line 22319 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22327 ""
+#line 22319 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22327 ""
+#line 22319 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22327 ""
+#line 22319 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22327 ""
+#line 22319 ""
e_wsfe();
-#line 22328 ""
+#line 22320 ""
s_wsfe(&io___1512);
/* Writing concatenation */
-#line 22328 ""
+#line 22320 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22328 ""
+#line 22320 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22328 ""
+#line 22320 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22328 ""
+#line 22320 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22328 ""
+#line 22320 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22328 ""
+#line 22320 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22328 ""
+#line 22320 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22328 ""
+#line 22320 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22328 ""
+#line 22320 ""
e_wsfe();
-#line 22330 ""
+#line 22322 ""
ibarcnt0 = combibarcnt_1.ibarcnt;
-#line 22331 ""
+#line 22323 ""
comshort_1.mbrsum = 0;
-#line 22332 ""
+#line 22324 ""
comshort_1.ishort = 2;
-#line 22333 ""
+#line 22325 ""
comshort_1.nmbr = 0;
-#line 22334 ""
+#line 22326 ""
} else if (comshort_1.ishort == 2) {
/* End short line, no new mv */
-#line 22335 ""
+#line 22327 ""
ntmp = combibarcnt_1.ibarcnt - ibarcnt0 -
comshort_1.nmbr + comshort_1.mbrsum;
-#line 22336 ""
+#line 22328 ""
if (ntmp <= 9) {
-#line 22337 ""
+#line 22329 ""
*(unsigned char *)shortfraq = (char) (ntmp +
48);
-#line 22338 ""
+#line 22330 ""
lntmp = 1;
-#line 22339 ""
+#line 22331 ""
} else {
-#line 22340 ""
+#line 22332 ""
s_wsfi(&io___1513);
-#line 22340 ""
+#line 22332 ""
do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof(
integer));
-#line 22340 ""
+#line 22332 ""
e_wsfi();
-#line 22341 ""
+#line 22333 ""
lntmp = 2;
-#line 22342 ""
+#line 22334 ""
}
-#line 22343 ""
+#line 22335 ""
s_wsfe(&io___1514);
/* Writing concatenation */
-#line 22343 ""
+#line 22335 ""
i__15[0] = 1, a__11[0] = all_1.sq;
-#line 22343 ""
+#line 22335 ""
i__15[1] = 11, a__11[1] = "stoppiece}}";
-#line 22343 ""
+#line 22335 ""
i__15[2] = 1, a__11[2] = all_1.sq;
-#line 22343 ""
+#line 22335 ""
i__15[3] = 7, a__11[3] = "advance";
-#line 22343 ""
+#line 22335 ""
i__15[4] = 1, a__11[4] = all_1.sq;
-#line 22343 ""
+#line 22335 ""
i__15[5] = 5, a__11[5] = "barno";
-#line 22343 ""
+#line 22335 ""
i__15[6] = lntmp, a__11[6] = shortfraq;
-#line 22343 ""
+#line 22335 ""
s_cat(ch__7, a__11, i__15, &c__7, (ftnlen)29);
-#line 22343 ""
+#line 22335 ""
do_fio(&c__1, ch__7, lntmp + 26);
-#line 22343 ""
+#line 22335 ""
e_wsfe();
/* Not clear why we needed this */
/* //sq//'startbarno'//sq//'barno%' */
-#line 22348 ""
+#line 22340 ""
s_wsfe(&io___1515);
/* Writing concatenation */
-#line 22348 ""
+#line 22340 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22348 ""
+#line 22340 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22348 ""
+#line 22340 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22348 ""
+#line 22340 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22348 ""
+#line 22340 ""
e_wsfe();
-#line 22349 ""
+#line 22341 ""
s_wsfe(&io___1516);
/* Writing concatenation */
-#line 22349 ""
+#line 22341 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22349 ""
+#line 22341 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22349 ""
+#line 22341 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22349 ""
+#line 22341 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22349 ""
+#line 22341 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22349 ""
+#line 22341 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22349 ""
+#line 22341 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22349 ""
+#line 22341 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22349 ""
+#line 22341 ""
e_wsfe();
-#line 22351 ""
+#line 22343 ""
comshort_1.ishort = 0;
-#line 22352 ""
+#line 22344 ""
} else if (comshort_1.ishort == 5) {
/* End short line, new mvt */
-#line 22353 ""
+#line 22345 ""
if (comnotes_1.nobar1) {
/* Continue bar numbering */
-#line 22354 ""
+#line 22346 ""
s_wsfe(&io___1517);
/* Writing concatenation */
-#line 22354 ""
+#line 22346 ""
i__10[0] = 1, a__7[0] = all_1.sq;
-#line 22354 ""
+#line 22346 ""
i__10[1] = 7, a__7[1] = "advance";
-#line 22354 ""
+#line 22346 ""
i__10[2] = 1, a__7[2] = all_1.sq;
-#line 22354 ""
+#line 22346 ""
i__10[3] = 5, a__7[3] = "barno";
-#line 22354 ""
+#line 22346 ""
*(unsigned char *)&ch__1[0] =
combibarcnt_1.ibarcnt - ibarcnt0 + 48;
-#line 22354 ""
+#line 22346 ""
i__10[4] = 1, a__7[4] = ch__1;
-#line 22354 ""
+#line 22346 ""
i__10[5] = 1, a__7[5] = all_1.sq;
-#line 22354 ""
+#line 22346 ""
i__10[6] = 10, a__7[6] = "startbarno";
-#line 22354 ""
+#line 22346 ""
i__10[7] = 1, a__7[7] = all_1.sq;
-#line 22354 ""
+#line 22346 ""
i__10[8] = 6, a__7[8] = "barno%";
-#line 22354 ""
+#line 22346 ""
s_cat(ch__35, a__7, i__10, &c__9, (ftnlen)33);
-#line 22354 ""
+#line 22346 ""
do_fio(&c__1, ch__35, (ftnlen)33);
-#line 22354 ""
+#line 22346 ""
e_wsfe();
/* Must leave in \startbarno to get msm with LMc to work. */
-#line 22360 ""
+#line 22352 ""
}
-#line 22361 ""
+#line 22353 ""
s_wsfe(&io___1518);
/* Writing concatenation */
-#line 22361 ""
+#line 22353 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22361 ""
+#line 22353 ""
i__4[1] = 10, a__2[1] = "startpiece";
-#line 22361 ""
+#line 22353 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22361 ""
+#line 22353 ""
i__4[3] = 8, a__2[3] = "addspace";
-#line 22361 ""
+#line 22353 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22361 ""
+#line 22353 ""
i__4[5] = 14, a__2[5] = "afterruleskip%";
-#line 22361 ""
+#line 22353 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22361 ""
+#line 22353 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22361 ""
+#line 22353 ""
e_wsfe();
-#line 22363 ""
+#line 22355 ""
comshort_1.ishort = 0;
-#line 22364 ""
+#line 22356 ""
} else if (comshort_1.ishort == 3) {
/* May never come thru here. Stuff is done later at least for mcl.pmx */
/* Mid line gap, start coda */
-#line 22366 ""
+#line 22358 ""
s_wsfi(&io___1519);
-#line 22366 ""
+#line 22358 ""
do_fio(&c__1, (char *)&comshort_1.codafrac, (
ftnlen)sizeof(real));
-#line 22366 ""
+#line 22358 ""
e_wsfi();
-#line 22367 ""
+#line 22359 ""
s_wsfe(&io___1520);
/* Writing concatenation */
-#line 22367 ""
+#line 22359 ""
i__16[0] = 1, a__12[0] = all_1.sq;
-#line 22367 ""
+#line 22359 ""
i__16[1] = 9, a__12[1] = "endpiece}";
-#line 22367 ""
+#line 22359 ""
i__16[2] = 1, a__12[2] = all_1.sq;
-#line 22367 ""
+#line 22359 ""
i__16[3] = 7, a__12[3] = "advance";
-#line 22367 ""
+#line 22359 ""
i__16[4] = 1, a__12[4] = all_1.sq;
-#line 22367 ""
+#line 22359 ""
i__16[5] = 5, a__12[5] = "barno";
-#line 22367 ""
+#line 22359 ""
*(unsigned char *)&ch__1[0] =
combibarcnt_1.ibarcnt - ibarcnt0 + 48;
-#line 22367 ""
+#line 22359 ""
i__16[6] = 1, a__12[6] = ch__1;
-#line 22367 ""
+#line 22359 ""
i__16[7] = 1, a__12[7] = all_1.sq;
-#line 22367 ""
+#line 22359 ""
i__16[8] = 10, a__12[8] = "startbarno";
-#line 22367 ""
+#line 22359 ""
i__16[9] = 1, a__12[9] = all_1.sq;
-#line 22367 ""
+#line 22359 ""
i__16[10] = 6, a__12[10] = "barno%";
-#line 22367 ""
+#line 22359 ""
s_cat(ch__36, a__12, i__16, &c__11, (ftnlen)43);
-#line 22367 ""
+#line 22359 ""
do_fio(&c__1, ch__36, (ftnlen)43);
-#line 22367 ""
+#line 22359 ""
e_wsfe();
-#line 22370 ""
+#line 22362 ""
s_wsfe(&io___1521);
/* Writing concatenation */
-#line 22370 ""
+#line 22362 ""
i__14[0] = 1, a__10[0] = all_1.sq;
-#line 22370 ""
+#line 22362 ""
i__14[1] = 5, a__10[1] = "hfill";
-#line 22370 ""
+#line 22362 ""
i__14[2] = 1, a__10[2] = all_1.sq;
-#line 22370 ""
+#line 22362 ""
i__14[3] = 5, a__10[3] = "vbox{";
-#line 22370 ""
+#line 22362 ""
i__14[4] = 1, a__10[4] = all_1.sq;
-#line 22370 ""
+#line 22362 ""
i__14[5] = 6, a__10[5] = "hsize=";
-#line 22370 ""
+#line 22362 ""
i__14[6] = 3, a__10[6] = shortfraq;
-#line 22370 ""
+#line 22362 ""
i__14[7] = 1, a__10[7] = "%";
-#line 22370 ""
+#line 22362 ""
s_cat(ch__3, a__10, i__14, &c__8, (ftnlen)23);
-#line 22370 ""
+#line 22362 ""
do_fio(&c__1, ch__3, (ftnlen)23);
-#line 22370 ""
+#line 22362 ""
e_wsfe();
-#line 22372 ""
+#line 22364 ""
s_wsfe(&io___1522);
/* Writing concatenation */
-#line 22372 ""
+#line 22364 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22372 ""
+#line 22364 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22372 ""
+#line 22364 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22372 ""
+#line 22364 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22372 ""
+#line 22364 ""
e_wsfe();
-#line 22373 ""
+#line 22365 ""
s_wsfe(&io___1523);
/* Writing concatenation */
-#line 22373 ""
+#line 22365 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22373 ""
+#line 22365 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22373 ""
+#line 22365 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22373 ""
+#line 22365 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22373 ""
+#line 22365 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22373 ""
+#line 22365 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22373 ""
+#line 22365 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22373 ""
+#line 22365 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22373 ""
+#line 22365 ""
e_wsfe();
-#line 22375 ""
+#line 22367 ""
comshort_1.ishort = 4;
-#line 22376 ""
+#line 22368 ""
} else if (comshort_1.ishort == 4) {
/* End coda */
-#line 22377 ""
+#line 22369 ""
ntmp = combibarcnt_1.ibarcnt - ibarcnt0 -
comshort_1.nmbr + comshort_1.mbrsum;
-#line 22378 ""
+#line 22370 ""
if (ntmp <= 9) {
-#line 22379 ""
+#line 22371 ""
*(unsigned char *)shortfraq = (char) (ntmp +
48);
-#line 22380 ""
+#line 22372 ""
lntmp = 1;
-#line 22381 ""
+#line 22373 ""
} else {
-#line 22382 ""
+#line 22374 ""
s_wsfi(&io___1524);
-#line 22382 ""
+#line 22374 ""
do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof(
integer));
-#line 22382 ""
+#line 22374 ""
e_wsfi();
-#line 22383 ""
+#line 22375 ""
lntmp = 2;
-#line 22384 ""
+#line 22376 ""
}
-#line 22385 ""
+#line 22377 ""
s_wsfe(&io___1525);
/* Writing concatenation */
-#line 22385 ""
+#line 22377 ""
i__15[0] = 1, a__11[0] = all_1.sq;
-#line 22385 ""
+#line 22377 ""
i__15[1] = 10, a__11[1] = "endpiece}}";
-#line 22385 ""
+#line 22377 ""
i__15[2] = 1, a__11[2] = all_1.sq;
-#line 22385 ""
+#line 22377 ""
i__15[3] = 7, a__11[3] = "advance";
-#line 22385 ""
+#line 22377 ""
i__15[4] = 1, a__11[4] = all_1.sq;
-#line 22385 ""
+#line 22377 ""
i__15[5] = 5, a__11[5] = "barno";
-#line 22385 ""
+#line 22377 ""
i__15[6] = lntmp, a__11[6] = shortfraq;
-#line 22385 ""
+#line 22377 ""
s_cat(ch__31, a__11, i__15, &c__7, (ftnlen)28);
-#line 22385 ""
+#line 22377 ""
do_fio(&c__1, ch__31, lntmp + 25);
-#line 22385 ""
+#line 22377 ""
e_wsfe();
-#line 22387 ""
+#line 22379 ""
s_wsfe(&io___1526);
/* Writing concatenation */
-#line 22387 ""
+#line 22379 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22387 ""
+#line 22379 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22387 ""
+#line 22379 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22387 ""
+#line 22379 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22387 ""
+#line 22379 ""
e_wsfe();
-#line 22388 ""
+#line 22380 ""
s_wsfe(&io___1527);
/* Writing concatenation */
-#line 22388 ""
+#line 22380 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22388 ""
+#line 22380 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22388 ""
+#line 22380 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22388 ""
+#line 22380 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22388 ""
+#line 22380 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22388 ""
+#line 22380 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22388 ""
+#line 22380 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22388 ""
+#line 22380 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22388 ""
+#line 22380 ""
e_wsfe();
-#line 22390 ""
+#line 22382 ""
comshort_1.ishort = 0;
-#line 22391 ""
+#line 22383 ""
comshort_1.mbrsum = 0;
-#line 22392 ""
+#line 22384 ""
comshort_1.nmbr = 0;
-#line 22393 ""
+#line 22385 ""
}
-#line 22394 ""
+#line 22386 ""
} else if (all_1.mtrnuml != 0) {
/* New meter, no new sig, end of line, not new page. */
@@ -54474,2003 +54747,2007 @@ L51:
/* \zalaligne\generalmeter{\meterfrac{3}{4}}\addspace{-\afterruleskip}% */
/* \zchangecontext */
-#line 22404 ""
+#line 22396 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
-#line 22405 ""
+#line 22397 ""
if (comget_1.movbrk == 0) {
-#line 22406 ""
+#line 22398 ""
if (comlast_1.islast) {
-#line 22407 ""
+#line 22399 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22408 ""
+#line 22400 ""
}
-#line 22409 ""
+#line 22401 ""
if (all_1.mtrdnp > 0) {
-#line 22410 ""
+#line 22402 ""
if (comlast_1.islast) {
-#line 22411 ""
+#line 22403 ""
s_wsfe(&io___1528);
/* Writing concatenation */
-#line 22411 ""
+#line 22403 ""
i__3[0] = 1, a__1[0] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[1] = 3, a__1[1] = "let";
-#line 22411 ""
+#line 22403 ""
i__3[2] = 1, a__1[2] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[3] = 4, a__1[3] = "bnat";
-#line 22411 ""
+#line 22403 ""
i__3[4] = 1, a__1[4] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[5] = 8, a__1[5] = "barnoadd";
-#line 22411 ""
+#line 22403 ""
i__3[6] = 1, a__1[6] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[7] = 3, a__1[7] = "def";
-#line 22411 ""
+#line 22403 ""
i__3[8] = 1, a__1[8] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[9] = 9, a__1[9] = "barnoadd{";
-#line 22411 ""
+#line 22403 ""
i__3[10] = 1, a__1[10] = all_1.sq;
-#line 22411 ""
+#line 22403 ""
i__3[11] = 7, a__1[11] = "empty}%";
-#line 22411 ""
+#line 22403 ""
s_cat(ch__23, a__1, i__3, &c__12, (ftnlen)
40);
-#line 22411 ""
+#line 22403 ""
do_fio(&c__1, ch__23, (ftnlen)40);
-#line 22411 ""
+#line 22403 ""
e_wsfe();
-#line 22414 ""
+#line 22406 ""
s_wsfe(&io___1529);
/* Writing concatenation */
-#line 22414 ""
+#line 22406 ""
i__17[0] = 1, a__13[0] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[1] = 14, a__13[1] = "xchangecontext"
;
-#line 22414 ""
+#line 22406 ""
i__17[2] = 1, a__13[2] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[3] = 10, a__13[3] = "addspace{-";
-#line 22414 ""
+#line 22406 ""
i__17[4] = 1, a__13[4] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[5] = 14, a__13[5] = "afterruleskip}"
;
-#line 22414 ""
+#line 22406 ""
i__17[6] = 1, a__13[6] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[7] = 9, a__13[7] = "zalaligne";
-#line 22414 ""
+#line 22406 ""
i__17[8] = 1, a__13[8] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[9] = 3, a__13[9] = "let";
-#line 22414 ""
+#line 22406 ""
i__17[10] = 1, a__13[10] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[11] = 8, a__13[11] = "barnoadd";
-#line 22414 ""
+#line 22406 ""
i__17[12] = 1, a__13[12] = all_1.sq;
-#line 22414 ""
+#line 22406 ""
i__17[13] = 4, a__13[13] = "bnat";
-#line 22414 ""
+#line 22406 ""
s_cat(ch__37, a__13, i__17, &c__14, (
ftnlen)69);
-#line 22414 ""
+#line 22406 ""
do_fio(&c__1, ch__37, (ftnlen)69);
-#line 22414 ""
+#line 22406 ""
e_wsfe();
-#line 22417 ""
+#line 22409 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22418 ""
+#line 22410 ""
s_wsfe(&io___1530);
/* Writing concatenation */
-#line 22418 ""
+#line 22410 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22418 ""
+#line 22410 ""
i__4[1] = 10, a__2[1] = "addspace{-";
-#line 22418 ""
+#line 22410 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22418 ""
+#line 22410 ""
i__4[3] = 14, a__2[3] = "afterruleskip}";
-#line 22418 ""
+#line 22410 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22418 ""
+#line 22410 ""
i__4[5] = 14, a__2[5] = "zchangecontext";
-#line 22418 ""
+#line 22410 ""
s_cat(ch__38, a__2, i__4, &c__6, (ftnlen)
41);
-#line 22418 ""
+#line 22410 ""
do_fio(&c__1, ch__38, (ftnlen)41);
-#line 22418 ""
+#line 22410 ""
e_wsfe();
-#line 22420 ""
+#line 22412 ""
}
-#line 22421 ""
+#line 22413 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
-#line 22421 ""
+#line 22413 ""
comgrace_1.xb4mbr = all_1.musicsize *
-.2f;
-#line 22421 ""
+#line 22413 ""
}
-#line 22422 ""
+#line 22414 ""
} else {
-#line 22423 ""
+#line 22415 ""
if (comlast_1.islast) {
-#line 22423 ""
+#line 22415 ""
s_wsfe(&io___1531);
/* Writing concatenation */
-#line 22423 ""
+#line 22415 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22423 ""
+#line 22415 ""
i__6[1] = 8, a__4[1] = "alaligne";
-#line 22423 ""
+#line 22415 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)
9);
-#line 22423 ""
+#line 22415 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22423 ""
+#line 22415 ""
e_wsfe();
-#line 22423 ""
+#line 22415 ""
}
-#line 22424 ""
+#line 22416 ""
}
-#line 22425 ""
+#line 22417 ""
} else {
-#line 22426 ""
+#line 22418 ""
if (comlast_1.islast) {
-#line 22426 ""
+#line 22418 ""
s_wsfe(&io___1532);
/* Writing concatenation */
-#line 22426 ""
+#line 22418 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22426 ""
+#line 22418 ""
i__6[1] = 8, a__4[1] = "alaligne";
-#line 22426 ""
+#line 22418 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 22426 ""
+#line 22418 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22426 ""
+#line 22418 ""
e_wsfe();
-#line 22426 ""
+#line 22418 ""
}
-#line 22427 ""
+#line 22419 ""
}
-#line 22428 ""
+#line 22420 ""
}
-#line 22429 ""
+#line 22421 ""
}
/* Modified 090525 to use \bnrs */
-#line 22433 ""
+#line 22425 ""
if (slint) {
-#line 22434 ""
+#line 22426 ""
slint = FALSE_;
-#line 22435 ""
+#line 22427 ""
if (comlast_1.islast) {
-#line 22435 ""
+#line 22427 ""
s_wsfe(&io___1533);
/* Writing concatenation */
-#line 22435 ""
+#line 22427 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22435 ""
+#line 22427 ""
i__5[1] = 3, a__3[1] = "def";
-#line 22435 ""
+#line 22427 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22435 ""
+#line 22427 ""
i__5[3] = 11, a__3[3] = "raisebarno{";
-#line 22435 ""
+#line 22427 ""
s_cat(ch__22, a__3, i__5, &c__4, (ftnlen)16);
-#line 22435 ""
+#line 22427 ""
do_fio(&c__1, ch__22, (ftnlen)16);
-#line 22435 ""
+#line 22427 ""
do_fio(&c__1, (char *)&comsln_1.irzbnd, (ftnlen)
sizeof(integer));
/* Writing concatenation */
-#line 22435 ""
+#line 22427 ""
i__8[0] = 2, a__5[0] = ".5";
-#line 22435 ""
+#line 22427 ""
i__8[1] = 1, a__5[1] = all_1.sq;
-#line 22435 ""
+#line 22427 ""
i__8[2] = 11, a__5[2] = "internote}%";
-#line 22435 ""
+#line 22427 ""
s_cat(ch__10, a__5, i__8, &c__3, (ftnlen)14);
-#line 22435 ""
+#line 22427 ""
do_fio(&c__1, ch__10, (ftnlen)14);
-#line 22435 ""
+#line 22427 ""
e_wsfe();
-#line 22435 ""
+#line 22427 ""
}
-#line 22437 ""
+#line 22429 ""
}
-#line 22438 ""
+#line 22430 ""
comget_1.movbrk = 0;
-#line 22439 ""
+#line 22431 ""
}
/* Clean up if we squelched bar number reset at movement break */
-#line 22443 ""
+#line 22435 ""
if (comnotes_1.nobar1) {
-#line 22444 ""
+#line 22436 ""
if (comlast_1.islast) {
-#line 22444 ""
+#line 22436 ""
s_wsfe(&io___1534);
/* Writing concatenation */
-#line 22444 ""
+#line 22436 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22444 ""
+#line 22436 ""
i__6[1] = 11, a__4[1] = "startbarno1";
-#line 22444 ""
+#line 22436 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22444 ""
+#line 22436 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22444 ""
+#line 22436 ""
e_wsfe();
-#line 22444 ""
+#line 22436 ""
}
-#line 22445 ""
+#line 22437 ""
comnotes_1.nobar1 = FALSE_;
-#line 22446 ""
+#line 22438 ""
}
-#line 22447 ""
- i__7 = s_rsle(&io___1535);
-#line 22447 ""
- if (i__7 != 0) {
-#line 22447 ""
+#line 22439 ""
+ i__2 = s_rsle(&io___1535);
+#line 22439 ""
+ if (i__2 != 0) {
+#line 22439 ""
goto L14;
-#line 22447 ""
+#line 22439 ""
}
-#line 22447 ""
- i__7 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(
+#line 22439 ""
+ i__2 = do_lio(&c__3, &c__1, (char *)&iauto, (ftnlen)sizeof(
integer));
-#line 22447 ""
- if (i__7 != 0) {
-#line 22447 ""
+#line 22439 ""
+ if (i__2 != 0) {
+#line 22439 ""
goto L14;
-#line 22447 ""
+#line 22439 ""
}
-#line 22447 ""
- i__7 = e_rsle();
-#line 22447 ""
- if (i__7 != 0) {
-#line 22447 ""
+#line 22439 ""
+ i__2 = e_rsle();
+#line 22439 ""
+ if (i__2 != 0) {
+#line 22439 ""
goto L14;
-#line 22447 ""
+#line 22439 ""
}
-#line 22448 ""
+#line 22440 ""
L14:
/* We come thru here for the 1st bar of every system, so initialize is1n1 */
-#line 22452 ""
+#line 22444 ""
comsln_1.is1n1 = 0;
/* Brought down from above */
-#line 22456 ""
+#line 22448 ""
if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1]) {
-#line 22457 ""
+#line 22449 ""
isystpg = 0;
/* The following is to avoid moving this reset of isystpg, but still send a signal */
/* down below for last system shortening events */
-#line 22462 ""
+#line 22454 ""
if (comshort_1.ishort == 2) {
-#line 22462 ""
+#line 22454 ""
iflagbot = 1;
-#line 22462 ""
+#line 22454 ""
}
-#line 22463 ""
+#line 22455 ""
}
/* Check for linebreak ties */
-#line 22467 ""
+#line 22459 ""
if (ispstie) {
-#line 22467 ""
+#line 22459 ""
linebreakties_(all_1.isdat1, all_1.isdat2, all_1.isdat3,
all_1.isdat4, &all_1.nsdat, &ispstie, all_1.sepsymq, (
ftnlen)1);
-#line 22467 ""
+#line 22459 ""
}
-#line 22470 ""
+#line 22462 ""
} else {
/* Not first bar of system */
-#line 22474 ""
+#line 22466 ""
if (bit_test(iplnow,28)) {
/* Signature change */
-#line 22478 ""
+#line 22470 ""
if (all_1.mtrnuml != 0) {
/* Meter+signature change mid line, assume no movement break */
-#line 22482 ""
+#line 22474 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &
combeam_1.ibmtyp, &ibmrep);
-#line 22483 ""
+#line 22475 ""
if (comlast_1.islast) {
-#line 22483 ""
+#line 22475 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22483 ""
+#line 22475 ""
}
/* Writing concatenation */
-#line 22484 ""
+#line 22476 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22484 ""
+#line 22476 ""
i__6[1] = 17, a__4[1] = "generalsignature{";
-#line 22484 ""
+#line 22476 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 22485 ""
+#line 22477 ""
lnote = 18;
-#line 22486 ""
+#line 22478 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
-#line 22487 ""
+#line 22479 ""
i__6[0] = 18, a__4[0] = notexq;
-#line 22487 ""
+#line 22479 ""
i__6[1] = 1, a__4[1] = "-";
-#line 22487 ""
+#line 22479 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 22488 ""
+#line 22480 ""
lnote = 19;
-#line 22489 ""
+#line 22481 ""
}
-#line 22490 ""
+#line 22482 ""
if (comlast_1.islast) {
-#line 22491 ""
+#line 22483 ""
iptemp = abs(comtop_1.isig) + 48;
-#line 22492 ""
+#line 22484 ""
chax_(ch__1, (ftnlen)1, &iptemp);
-#line 22492 ""
+#line 22484 ""
*(unsigned char *)charq = *(unsigned char *)&ch__1[0];
/* Writing concatenation */
-#line 22493 ""
+#line 22485 ""
i__8[0] = lnote, a__5[0] = notexq;
-#line 22493 ""
+#line 22485 ""
i__8[1] = 1, a__5[1] = charq;
-#line 22493 ""
+#line 22485 ""
i__8[2] = 2, a__5[2] = "}%";
-#line 22493 ""
+#line 22485 ""
s_cat(notexq, a__5, i__8, &c__3, (ftnlen)79);
-#line 22494 ""
+#line 22486 ""
lnote += 3;
-#line 22495 ""
+#line 22487 ""
s_wsfe(&io___1538);
-#line 22495 ""
+#line 22487 ""
do_fio(&c__1, notexq, lnote);
-#line 22495 ""
+#line 22487 ""
e_wsfe();
-#line 22496 ""
+#line 22488 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans)
{
-#line 22497 ""
+#line 22489 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
-#line 22499 ""
+#line 22491 ""
}
-#line 22500 ""
+#line 22492 ""
if (comignorenats_1.ignorenats) {
-#line 22500 ""
+#line 22492 ""
s_wsfe(&io___1539);
/* Writing concatenation */
-#line 22500 ""
+#line 22492 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22500 ""
+#line 22492 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22500 ""
+#line 22492 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22500 ""
+#line 22492 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22500 ""
+#line 22492 ""
e_wsfe();
-#line 22500 ""
+#line 22492 ""
}
-#line 22501 ""
+#line 22493 ""
s_wsfe(&io___1540);
/* Writing concatenation */
-#line 22501 ""
+#line 22493 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22501 ""
+#line 22493 ""
i__6[1] = 15, a__4[1] = "xchangecontext%";
-#line 22501 ""
+#line 22493 ""
s_cat(ch__22, a__4, i__6, &c__2, (ftnlen)16);
-#line 22501 ""
+#line 22493 ""
do_fio(&c__1, ch__22, (ftnlen)16);
-#line 22501 ""
+#line 22493 ""
e_wsfe();
-#line 22502 ""
+#line 22494 ""
}
-#line 22503 ""
+#line 22495 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
/* Compute space for multibar rest */
-#line 22507 ""
+#line 22499 ""
if (comtop_1.lastisig * comtop_1.isig >= 0) {
/* Computing MAX */
-#line 22508 ""
- i__7 = abs(comtop_1.lastisig), i__2 = abs(
+#line 22500 ""
+ i__2 = abs(comtop_1.lastisig), i__7 = abs(
comtop_1.isig);
-#line 22508 ""
- naccs = max(i__7,i__2);
-#line 22509 ""
+#line 22500 ""
+ naccs = max(i__2,i__7);
+#line 22501 ""
} else {
-#line 22510 ""
- naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
- abs(i__7));
-#line 22511 ""
+#line 22502 ""
+ naccs = (i__2 = comtop_1.lastisig - comtop_1.isig,
+ abs(i__2));
+#line 22503 ""
}
/* xb4mbr = (facmtr+naccs*.24)*musicsize */
-#line 22513 ""
+#line 22505 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
-#line 22514 ""
+#line 22506 ""
}
-#line 22515 ""
+#line 22507 ""
} else {
/* Signature change only */
/* Writing concatenation */
-#line 22519 ""
+#line 22511 ""
i__14[0] = 1, a__10[0] = all_1.sq;
-#line 22519 ""
+#line 22511 ""
i__14[1] = 4, a__10[1] = "xbar";
-#line 22519 ""
+#line 22511 ""
i__14[2] = 1, a__10[2] = all_1.sq;
-#line 22519 ""
+#line 22511 ""
i__14[3] = 10, a__10[3] = "addspace{-";
-#line 22519 ""
+#line 22511 ""
i__14[4] = 1, a__10[4] = all_1.sq;
-#line 22519 ""
+#line 22511 ""
i__14[5] = 14, a__10[5] = "afterruleskip}";
-#line 22519 ""
+#line 22511 ""
i__14[6] = 1, a__10[6] = all_1.sq;
-#line 22519 ""
+#line 22511 ""
i__14[7] = 17, a__10[7] = "generalsignature{";
-#line 22519 ""
+#line 22511 ""
s_cat(notexq, a__10, i__14, &c__8, (ftnlen)79);
-#line 22521 ""
+#line 22513 ""
lnote = 49;
-#line 22522 ""
+#line 22514 ""
if (comtop_1.isig < 0) {
/* Writing concatenation */
-#line 22523 ""
+#line 22515 ""
i__6[0] = 49, a__4[0] = notexq;
-#line 22523 ""
+#line 22515 ""
i__6[1] = 1, a__4[1] = "-";
-#line 22523 ""
+#line 22515 ""
s_cat(notexq, a__4, i__6, &c__2, (ftnlen)79);
-#line 22524 ""
+#line 22516 ""
lnote = 50;
-#line 22525 ""
+#line 22517 ""
}
-#line 22526 ""
+#line 22518 ""
if (comlast_1.islast) {
-#line 22526 ""
+#line 22518 ""
s_wsfe(&io___1542);
/* Writing concatenation */
-#line 22526 ""
+#line 22518 ""
i__8[0] = lnote, a__5[0] = notexq;
-#line 22526 ""
- i__7 = abs(comtop_1.isig) + 48;
-#line 22526 ""
- chax_(ch__1, (ftnlen)1, &i__7);
-#line 22526 ""
+#line 22518 ""
+ i__2 = abs(comtop_1.isig) + 48;
+#line 22518 ""
+ chax_(ch__1, (ftnlen)1, &i__2);
+#line 22518 ""
i__8[1] = 1, a__5[1] = ch__1;
-#line 22526 ""
+#line 22518 ""
i__8[2] = 2, a__5[2] = "}%";
-#line 22526 ""
+#line 22518 ""
s_cat(ch__27, a__5, i__8, &c__3, (ftnlen)82);
-#line 22526 ""
+#line 22518 ""
do_fio(&c__1, ch__27, lnote + 3);
-#line 22526 ""
+#line 22518 ""
e_wsfe();
-#line 22526 ""
+#line 22518 ""
}
-#line 22528 ""
+#line 22520 ""
if (comlast_1.islast && cominsttrans_1.laterinsttrans) {
-#line 22529 ""
+#line 22521 ""
writesetsign_(&cominsttrans_1.ninsttrans,
cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &
cominsttrans_1.laterinsttrans);
-#line 22531 ""
+#line 22523 ""
}
-#line 22532 ""
+#line 22524 ""
if (comlast_1.islast && comignorenats_1.ignorenats) {
-#line 22532 ""
+#line 22524 ""
s_wsfe(&io___1543);
/* Writing concatenation */
-#line 22532 ""
+#line 22524 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22532 ""
+#line 22524 ""
i__6[1] = 11, a__4[1] = "ignorenats%";
-#line 22532 ""
+#line 22524 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22532 ""
+#line 22524 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22532 ""
+#line 22524 ""
e_wsfe();
-#line 22532 ""
+#line 22524 ""
}
-#line 22534 ""
+#line 22526 ""
if (comlast_1.islast) {
-#line 22534 ""
+#line 22526 ""
s_wsfe(&io___1544);
/* Writing concatenation */
-#line 22534 ""
+#line 22526 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22534 ""
+#line 22526 ""
i__4[1] = 14, a__2[1] = "zchangecontext";
-#line 22534 ""
+#line 22526 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22534 ""
+#line 22526 ""
i__4[3] = 12, a__2[3] = "addspace{-.5";
-#line 22534 ""
+#line 22526 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22534 ""
+#line 22526 ""
i__4[5] = 15, a__2[5] = "afterruleskip}%";
-#line 22534 ""
+#line 22526 ""
s_cat(ch__39, a__2, i__4, &c__6, (ftnlen)44);
-#line 22534 ""
+#line 22526 ""
do_fio(&c__1, ch__39, (ftnlen)44);
-#line 22534 ""
+#line 22526 ""
e_wsfe();
-#line 22534 ""
+#line 22526 ""
}
-#line 22536 ""
+#line 22528 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
/* Compute space for multibar rest */
-#line 22540 ""
+#line 22532 ""
if (comtop_1.lastisig * comtop_1.isig >= 0) {
/* Computing MAX */
-#line 22541 ""
- i__7 = abs(comtop_1.lastisig), i__2 = abs(
+#line 22533 ""
+ i__2 = abs(comtop_1.lastisig), i__7 = abs(
comtop_1.isig);
-#line 22541 ""
- naccs = max(i__7,i__2);
-#line 22542 ""
+#line 22533 ""
+ naccs = max(i__2,i__7);
+#line 22534 ""
} else {
-#line 22543 ""
- naccs = (i__7 = comtop_1.lastisig - comtop_1.isig,
- abs(i__7));
-#line 22544 ""
+#line 22535 ""
+ naccs = (i__2 = comtop_1.lastisig - comtop_1.isig,
+ abs(i__2));
+#line 22536 ""
}
/* xb4mbr = naccs*.24*musicsize */
-#line 22546 ""
+#line 22538 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
-#line 22547 ""
+#line 22539 ""
}
-#line 22548 ""
+#line 22540 ""
}
-#line 22549 ""
+#line 22541 ""
} else if (comshort_1.ishort == 3) {
/* Gap before coda, assumed no signature change! */
-#line 22553 ""
+#line 22545 ""
ntmp = combibarcnt_1.ibarcnt - ibarcnt0 - comshort_1.nmbr +
comshort_1.mbrsum;
-#line 22554 ""
+#line 22546 ""
if (ntmp <= 9) {
-#line 22555 ""
+#line 22547 ""
*(unsigned char *)shortfraq = (char) (ntmp + 48);
-#line 22556 ""
+#line 22548 ""
lntmp = 1;
-#line 22557 ""
+#line 22549 ""
} else {
-#line 22558 ""
+#line 22550 ""
s_wsfi(&io___1545);
-#line 22558 ""
+#line 22550 ""
do_fio(&c__1, (char *)&ntmp, (ftnlen)sizeof(integer));
-#line 22558 ""
+#line 22550 ""
e_wsfi();
-#line 22559 ""
+#line 22551 ""
lntmp = 2;
-#line 22560 ""
+#line 22552 ""
}
-#line 22561 ""
+#line 22553 ""
s_wsfe(&io___1546);
/* Writing concatenation */
-#line 22561 ""
+#line 22553 ""
i__15[0] = 1, a__11[0] = all_1.sq;
-#line 22561 ""
+#line 22553 ""
i__15[1] = 9, a__11[1] = "endpiece}";
-#line 22561 ""
+#line 22553 ""
i__15[2] = 1, a__11[2] = all_1.sq;
-#line 22561 ""
+#line 22553 ""
i__15[3] = 7, a__11[3] = "advance";
-#line 22561 ""
+#line 22553 ""
i__15[4] = 1, a__11[4] = all_1.sq;
-#line 22561 ""
+#line 22553 ""
i__15[5] = 5, a__11[5] = "barno";
-#line 22561 ""
+#line 22553 ""
i__15[6] = lntmp, a__11[6] = shortfraq;
-#line 22561 ""
+#line 22553 ""
s_cat(ch__5, a__11, i__15, &c__7, (ftnlen)27);
-#line 22561 ""
+#line 22553 ""
do_fio(&c__1, ch__5, lntmp + 24);
-#line 22561 ""
+#line 22553 ""
e_wsfe();
-#line 22563 ""
+#line 22555 ""
if (comshort_1.nocodabn) {
-#line 22564 ""
+#line 22556 ""
s_wsfe(&io___1547);
/* Writing concatenation */
-#line 22564 ""
+#line 22556 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22564 ""
+#line 22556 ""
i__6[1] = 7, a__4[1] = "nobarno";
-#line 22564 ""
+#line 22556 ""
s_cat(ch__8, a__4, i__6, &c__2, (ftnlen)8);
-#line 22564 ""
+#line 22556 ""
do_fio(&c__1, ch__8, (ftnlen)8);
-#line 22564 ""
+#line 22556 ""
e_wsfe();
-#line 22565 ""
+#line 22557 ""
comshort_1.nocodabn = FALSE_;
-#line 22566 ""
+#line 22558 ""
}
-#line 22567 ""
+#line 22559 ""
s_wsfi(&io___1548);
-#line 22567 ""
+#line 22559 ""
do_fio(&c__1, (char *)&comshort_1.codafrac, (ftnlen)sizeof(
real));
-#line 22567 ""
+#line 22559 ""
e_wsfi();
-#line 22568 ""
+#line 22560 ""
s_wsfe(&io___1549);
/* Writing concatenation */
-#line 22568 ""
+#line 22560 ""
i__10[0] = 1, a__7[0] = all_1.sq;
-#line 22568 ""
+#line 22560 ""
i__10[1] = 5, a__7[1] = "hfill";
-#line 22568 ""
+#line 22560 ""
i__10[2] = 1, a__7[2] = all_1.sq;
-#line 22568 ""
+#line 22560 ""
i__10[3] = 5, a__7[3] = "vbox{";
-#line 22568 ""
+#line 22560 ""
i__10[4] = 1, a__7[4] = all_1.sq;
-#line 22568 ""
+#line 22560 ""
i__10[5] = 6, a__7[5] = "hsize=";
-#line 22568 ""
+#line 22560 ""
i__10[6] = 3, a__7[6] = shortfraq;
-#line 22568 ""
+#line 22560 ""
i__10[7] = 1, a__7[7] = all_1.sq;
-#line 22568 ""
+#line 22560 ""
i__10[8] = 6, a__7[8] = "hsize%";
-#line 22568 ""
+#line 22560 ""
s_cat(ch__7, a__7, i__10, &c__9, (ftnlen)29);
-#line 22568 ""
+#line 22560 ""
do_fio(&c__1, ch__7, (ftnlen)29);
-#line 22568 ""
+#line 22560 ""
e_wsfe();
-#line 22570 ""
+#line 22562 ""
s_wsfe(&io___1550);
/* Writing concatenation */
-#line 22570 ""
+#line 22562 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22570 ""
+#line 22562 ""
i__6[1] = 9, a__4[1] = "contpiece";
-#line 22570 ""
+#line 22562 ""
s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)10);
-#line 22570 ""
+#line 22562 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22570 ""
+#line 22562 ""
e_wsfe();
-#line 22571 ""
+#line 22563 ""
s_wsfe(&io___1551);
/* Writing concatenation */
-#line 22571 ""
+#line 22563 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22571 ""
+#line 22563 ""
i__4[1] = 12, a__2[1] = "makeatletter";
-#line 22571 ""
+#line 22563 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22571 ""
+#line 22563 ""
i__4[3] = 9, a__2[3] = "fil@begin";
-#line 22571 ""
+#line 22563 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22571 ""
+#line 22563 ""
i__4[5] = 11, a__2[5] = "makeatother";
-#line 22571 ""
+#line 22563 ""
s_cat(ch__9, a__2, i__4, &c__6, (ftnlen)35);
-#line 22571 ""
+#line 22563 ""
do_fio(&c__1, ch__9, (ftnlen)35);
-#line 22571 ""
+#line 22563 ""
e_wsfe();
-#line 22573 ""
+#line 22565 ""
comshort_1.ishort = 4;
-#line 22574 ""
+#line 22566 ""
} else if (all_1.mtrnuml == 0) {
/* No meter change */
-#line 22578 ""
+#line 22570 ""
if (comlast_1.islast) {
-#line 22578 ""
+#line 22570 ""
s_wsfe(&io___1552);
/* Writing concatenation */
-#line 22578 ""
+#line 22570 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22578 ""
+#line 22570 ""
i__6[1] = 4, a__4[1] = "xbar";
-#line 22578 ""
+#line 22570 ""
s_cat(ch__40, a__4, i__6, &c__2, (ftnlen)5);
-#line 22578 ""
+#line 22570 ""
do_fio(&c__1, ch__40, (ftnlen)5);
-#line 22578 ""
+#line 22570 ""
e_wsfe();
-#line 22578 ""
+#line 22570 ""
}
-#line 22579 ""
+#line 22571 ""
} else {
/* Change meter midline */
-#line 22583 ""
+#line 22575 ""
setmeter_(&all_1.mtrnuml, &all_1.mtrdenl, &combeam_1.ibmtyp, &
ibmrep);
-#line 22584 ""
+#line 22576 ""
if (comget_1.movbrk == 0) {
-#line 22585 ""
+#line 22577 ""
if (comlast_1.islast) {
-#line 22586 ""
+#line 22578 ""
wgmeter_(&all_1.mtrnmp, &all_1.mtrdnp);
-#line 22587 ""
+#line 22579 ""
}
-#line 22588 ""
+#line 22580 ""
if (all_1.mtrdnp > 0) {
-#line 22589 ""
+#line 22581 ""
if (comlast_1.islast) {
-#line 22590 ""
+#line 22582 ""
s_wsfe(&io___1553);
/* Writing concatenation */
-#line 22590 ""
+#line 22582 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22590 ""
+#line 22582 ""
i__6[1] = 10, a__4[1] = "newtimes0%";
-#line 22590 ""
+#line 22582 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22590 ""
+#line 22582 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22590 ""
+#line 22582 ""
e_wsfe();
-#line 22591 ""
+#line 22583 ""
}
/* if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize */
-#line 22593 ""
+#line 22585 ""
if (all_1.ibar == comgrace_1.ibarmbr) {
-#line 22593 ""
+#line 22585 ""
comgrace_1.xb4mbr = all_1.musicsize * -.2f;
-#line 22593 ""
+#line 22585 ""
}
-#line 22594 ""
+#line 22586 ""
} else {
-#line 22595 ""
+#line 22587 ""
if (comlast_1.islast) {
-#line 22595 ""
+#line 22587 ""
s_wsfe(&io___1554);
/* Writing concatenation */
-#line 22595 ""
+#line 22587 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22595 ""
+#line 22587 ""
i__6[1] = 4, a__4[1] = "xbar";
-#line 22595 ""
+#line 22587 ""
s_cat(ch__40, a__4, i__6, &c__2, (ftnlen)5);
-#line 22595 ""
+#line 22587 ""
do_fio(&c__1, ch__40, (ftnlen)5);
-#line 22595 ""
+#line 22587 ""
e_wsfe();
-#line 22595 ""
+#line 22587 ""
}
-#line 22596 ""
+#line 22588 ""
}
-#line 22597 ""
+#line 22589 ""
}
-#line 22598 ""
+#line 22590 ""
}
-#line 22599 ""
+#line 22591 ""
}
/* Now that xbar's are written, can put in left-repeats at line beginnings */
-#line 22603 ""
+#line 22595 ""
if (lrptpend) {
-#line 22604 ""
+#line 22596 ""
if (comlast_1.islast) {
-#line 22604 ""
+#line 22596 ""
s_wsfe(&io___1555);
/* Writing concatenation */
-#line 22604 ""
+#line 22596 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22604 ""
+#line 22596 ""
i__4[1] = 7, a__2[1] = "advance";
-#line 22604 ""
+#line 22596 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22604 ""
+#line 22596 ""
i__4[3] = 7, a__2[3] = "barno-1";
-#line 22604 ""
+#line 22596 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22604 ""
+#line 22596 ""
i__4[5] = 10, a__2[5] = "leftrepeat";
-#line 22604 ""
+#line 22596 ""
s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
-#line 22604 ""
+#line 22596 ""
do_fio(&c__1, ch__5, (ftnlen)27);
-#line 22604 ""
+#line 22596 ""
e_wsfe();
-#line 22604 ""
+#line 22596 ""
}
-#line 22606 ""
+#line 22598 ""
lrptpend = FALSE_;
-#line 22607 ""
+#line 22599 ""
}
-#line 22608 ""
+#line 22600 ""
if (all_1.ibar > 1) {
/* For bars after first, slide all stuff down to beginning of arrays */
-#line 22612 ""
- i__7 = all_1.nv;
-#line 22612 ""
- for (all_1.iv = 1; all_1.iv <= i__7; ++all_1.iv) {
-#line 22613 ""
- i__2 = commvl_1.nvmx[all_1.iv - 1];
-#line 22613 ""
- for (kv = 1; kv <= i__2; ++kv) {
-#line 22614 ""
+#line 22604 ""
+ i__2 = all_1.nv;
+#line 22604 ""
+ for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
+#line 22605 ""
+ i__7 = commvl_1.nvmx[all_1.iv - 1];
+#line 22605 ""
+ for (kv = 1; kv <= i__7; ++kv) {
+#line 22606 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 22615 ""
+#line 22607 ""
ioff = all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 -
25];
-#line 22616 ""
+#line 22608 ""
i__13 = all_1.nib[commvl_1.ivx + all_1.ibar * 24 - 25] -
ioff;
-#line 22616 ""
+#line 22608 ""
for (ip = 1; ip <= i__13; ++ip) {
-#line 22617 ""
+#line 22609 ""
all_1.nolev[commvl_1.ivx + ip * 24 - 25] =
all_1.nolev[commvl_1.ivx + (ip + ioff) * 24 -
25];
-#line 22618 ""
+#line 22610 ""
all_1.nodur[commvl_1.ivx + ip * 24 - 25] =
all_1.nodur[commvl_1.ivx + (ip + ioff) * 24 -
25];
-#line 22619 ""
+#line 22611 ""
all_1.nacc[commvl_1.ivx + ip * 24 - 25] = all_1.nacc[
commvl_1.ivx + (ip + ioff) * 24 - 25];
-#line 22620 ""
+#line 22612 ""
all_1.irest[commvl_1.ivx + ip * 24 - 25] =
all_1.irest[commvl_1.ivx + (ip + ioff) * 24 -
25];
-#line 22621 ""
+#line 22613 ""
all_1.islur[commvl_1.ivx + ip * 24 - 25] =
all_1.islur[commvl_1.ivx + (ip + ioff) * 24 -
25];
-#line 22622 ""
+#line 22614 ""
all_1.ipl[commvl_1.ivx + ip * 24 - 25] = all_1.ipl[
commvl_1.ivx + (ip + ioff) * 24 - 25];
-#line 22623 ""
+#line 22615 ""
all_1.iornq[commvl_1.ivx + ip * 24 - 1] = all_1.iornq[
commvl_1.ivx + (ip + ioff) * 24 - 1];
-#line 22624 ""
+#line 22616 ""
all_1.mult[commvl_1.ivx + ip * 24 - 25] = all_1.mult[
commvl_1.ivx + (ip + ioff) * 24 - 25];
-#line 22625 ""
+#line 22617 ""
if (all_1.figbass && commvl_1.ivx == 1 ||
commvl_1.ivx == comfig_1.ivxfig2) {
-#line 22626 ""
+#line 22618 ""
if (commvl_1.ivx == 1) {
-#line 22627 ""
+#line 22619 ""
all_1.isfig[(ip << 1) - 2] = all_1.isfig[(ip
+ ioff << 1) - 2];
-#line 22628 ""
+#line 22620 ""
} else {
-#line 22629 ""
+#line 22621 ""
all_1.isfig[(ip << 1) - 1] = all_1.isfig[(ip
+ ioff << 1) - 1];
-#line 22630 ""
+#line 22622 ""
}
-#line 22631 ""
+#line 22623 ""
}
-#line 22632 ""
+#line 22624 ""
/* L12: */
-#line 22632 ""
+#line 22624 ""
}
-#line 22633 ""
+#line 22625 ""
if (commvl_1.ivx <= all_1.nv && comcc_1.ncc[all_1.iv - 1]
> 1) {
-#line 22634 ""
+#line 22626 ""
islide = 0;
-#line 22635 ""
+#line 22627 ""
i__13 = comcc_1.ncc[all_1.iv - 1];
-#line 22635 ""
+#line 22627 ""
for (icc = 1; icc <= i__13; ++icc) {
-#line 22636 ""
+#line 22628 ""
if (comcc_1.tcc[all_1.iv + icc * 24 - 25] <= (
real) all_1.lenbar) {
/* This time will drop <=0 when slid. */
-#line 22640 ""
+#line 22632 ""
islide = icc - 1;
-#line 22641 ""
+#line 22633 ""
comcc_1.ncmidcc[all_1.iv - 1] =
comcc_1.ncmidcc[all_1.iv + icc * 24 -
25];
-#line 22642 ""
+#line 22634 ""
} else {
-#line 22643 ""
+#line 22635 ""
comcc_1.tcc[all_1.iv + (icc - islide) * 24 -
25] = comcc_1.tcc[all_1.iv + icc * 24
- 25] - all_1.lenbar;
-#line 22644 ""
+#line 22636 ""
comcc_1.ncmidcc[all_1.iv + (icc - islide) *
24 - 25] = comcc_1.ncmidcc[all_1.iv +
icc * 24 - 25];
-#line 22645 ""
+#line 22637 ""
}
-#line 22646 ""
+#line 22638 ""
/* L13: */
-#line 22646 ""
+#line 22638 ""
}
-#line 22647 ""
+#line 22639 ""
comcc_1.ncc[all_1.iv - 1] -= islide;
-#line 22648 ""
+#line 22640 ""
comcc_1.tcc[all_1.iv - 1] = 0.f;
-#line 22649 ""
+#line 22641 ""
}
-#line 22650 ""
-/* L11: */
-#line 22650 ""
+#line 22642 ""
+/* L1199: */
+#line 22642 ""
}
-#line 22650 ""
+#line 22643 ""
+/* L11: */
+#line 22643 ""
}
-#line 22651 ""
+#line 22644 ""
i__2 = comgrace_1.ngrace;
-#line 22651 ""
+#line 22644 ""
for (ig = 1; ig <= i__2; ++ig) {
-#line 22652 ""
+#line 22645 ""
comgrace_1.ipg[ig - 1] -= all_1.nib[comgrace_1.ivg[ig - 1] + (
all_1.ibar - 1) * 24 - 25];
-#line 22653 ""
+#line 22646 ""
if (all_1.ibar > 2) {
-#line 22653 ""
+#line 22646 ""
comgrace_1.ipg[ig - 1] += all_1.nib[comgrace_1.ivg[ig - 1]
+ (all_1.ibar - 2) * 24 - 25];
-#line 22653 ""
+#line 22646 ""
}
-#line 22654 ""
+#line 22647 ""
/* L15: */
-#line 22654 ""
+#line 22647 ""
}
-#line 22655 ""
+#line 22648 ""
i__2 = comgrace_1.nlit;
-#line 22655 ""
+#line 22648 ""
for (il = 1; il <= i__2; ++il) {
-#line 22656 ""
+#line 22649 ""
comgrace_1.iplit[il - 1] -= all_1.nib[comgrace_1.ivlit[il - 1]
+ (all_1.ibar - 1) * 24 - 25];
-#line 22657 ""
+#line 22650 ""
if (all_1.ibar > 2) {
-#line 22657 ""
+#line 22650 ""
comgrace_1.iplit[il - 1] += all_1.nib[comgrace_1.ivlit[il
- 1] + (all_1.ibar - 2) * 24 - 25];
-#line 22657 ""
+#line 22650 ""
}
-#line 22658 ""
+#line 22651 ""
/* L21: */
-#line 22658 ""
+#line 22651 ""
}
-#line 22659 ""
+#line 22652 ""
i__2 = comtrill_1.ntrill;
-#line 22659 ""
+#line 22652 ""
for (it = 1; it <= i__2; ++it) {
-#line 22660 ""
+#line 22653 ""
comtrill_1.iptrill[it - 1] -= all_1.nib[comtrill_1.ivtrill[it
- 1] + (all_1.ibar - 1) * 24 - 25];
-#line 22661 ""
+#line 22654 ""
if (all_1.ibar > 2) {
-#line 22661 ""
+#line 22654 ""
comtrill_1.iptrill[it - 1] += all_1.nib[
comtrill_1.ivtrill[it - 1] + (all_1.ibar - 2) *
24 - 25];
-#line 22661 ""
+#line 22654 ""
}
-#line 22663 ""
+#line 22656 ""
/* L22: */
-#line 22663 ""
+#line 22656 ""
}
-#line 22664 ""
+#line 22657 ""
i__2 = comtrill_1.ncrd;
-#line 22664 ""
+#line 22657 ""
for (icrd = 1; icrd <= i__2; ++icrd) {
-#line 22665 ""
+#line 22658 ""
commvl_1.ivx = (15 & lbit_shift(comtrill_1.icrdat[icrd - 1], (
ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[icrd - 1],
&c__1, &c__28) << 4);
-#line 22667 ""
+#line 22660 ""
ipnew = (255 & comtrill_1.icrdat[icrd - 1]) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
-#line 22668 ""
+#line 22661 ""
if (all_1.ibar > 2) {
-#line 22668 ""
+#line 22661 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22668 ""
+#line 22661 ""
}
-#line 22669 ""
+#line 22662 ""
comtrill_1.icrdat[icrd - 1] = -256 & comtrill_1.icrdat[icrd -
1];
-#line 22670 ""
+#line 22663 ""
comtrill_1.icrdat[icrd - 1] = max(0,ipnew) |
comtrill_1.icrdat[icrd - 1];
-#line 22671 ""
+#line 22664 ""
/* L27: */
-#line 22671 ""
+#line 22664 ""
}
-#line 22672 ""
+#line 22665 ""
i__2 = comtrill_1.nudorn;
-#line 22672 ""
+#line 22665 ""
for (iudorn = 1; iudorn <= i__2; ++iudorn) {
-#line 22673 ""
+#line 22666 ""
commvl_1.ivx = comivxudorn_1.ivxudorn[iudorn - 1];
-#line 22674 ""
+#line 22667 ""
ipnew = (255 & comtrill_1.kudorn[iudorn - 1]) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
-#line 22675 ""
+#line 22668 ""
if (all_1.ibar > 2) {
-#line 22675 ""
+#line 22668 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22675 ""
+#line 22668 ""
}
-#line 22676 ""
+#line 22669 ""
comtrill_1.kudorn[iudorn - 1] = -256 & comtrill_1.kudorn[
iudorn - 1];
-#line 22677 ""
+#line 22670 ""
comtrill_1.kudorn[iudorn - 1] = max(0,ipnew) |
comtrill_1.kudorn[iudorn - 1];
-#line 22678 ""
+#line 22671 ""
/* L29: */
-#line 22678 ""
+#line 22671 ""
}
-#line 22679 ""
+#line 22672 ""
i__2 = comdyn_1.ndyn;
-#line 22679 ""
+#line 22672 ""
for (idyn = 1; idyn <= i__2; ++idyn) {
-#line 22680 ""
+#line 22673 ""
idynd = comdyn_1.idyndat[idyn - 1];
-#line 22681 ""
+#line 22674 ""
commvl_1.ivx = (15 & idynd) + (igetbits_(&comdyn_1.idynda2[
idyn - 1], &c__1, &c__10) << 4);
-#line 22682 ""
+#line 22675 ""
ipnew = igetbits_(&idynd, &c__8, &c__4) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
/* The following construction avoids array bound errors in some compilers */
-#line 22686 ""
+#line 22679 ""
if (all_1.ibar > 2) {
-#line 22687 ""
+#line 22680 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22688 ""
+#line 22681 ""
}
-#line 22689 ""
+#line 22682 ""
ipnew = i_dim(&ipnew, &c__0);
-#line 22690 ""
+#line 22683 ""
setbits_(&idynd, &c__8, &c__4, &ipnew);
-#line 22691 ""
+#line 22684 ""
comdyn_1.idyndat[idyn - 1] = idynd;
-#line 22692 ""
+#line 22685 ""
/* L42: */
-#line 22692 ""
+#line 22685 ""
}
-#line 22693 ""
+#line 22686 ""
i__2 = comdyn_1.ntxtdyn;
-#line 22693 ""
+#line 22686 ""
for (itxtdyn = 1; itxtdyn <= i__2; ++itxtdyn) {
-#line 22694 ""
+#line 22687 ""
idynd = comdyn_1.ivxiptxt[itxtdyn - 1];
-#line 22695 ""
+#line 22688 ""
commvl_1.ivx = 31 & idynd;
-#line 22696 ""
+#line 22689 ""
ipnew = igetbits_(&idynd, &c__8, &c__5) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
-#line 22697 ""
+#line 22690 ""
if (all_1.ibar > 2) {
-#line 22698 ""
+#line 22691 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22699 ""
+#line 22692 ""
}
-#line 22700 ""
+#line 22693 ""
ipnew = i_dim(&ipnew, &c__0);
/* call setbits(idynd,8,4,ipnew) */
-#line 22702 ""
+#line 22695 ""
setbits_(&idynd, &c__8, &c__5, &ipnew);
-#line 22703 ""
+#line 22696 ""
comdyn_1.ivxiptxt[itxtdyn - 1] = idynd;
-#line 22704 ""
+#line 22697 ""
/* L43: */
-#line 22704 ""
+#line 22697 ""
}
-#line 22705 ""
+#line 22698 ""
i__2 = all_1.nsdat;
-#line 22705 ""
+#line 22698 ""
for (isdat = 1; isdat <= i__2; ++isdat) {
-#line 22706 ""
+#line 22699 ""
isdata = all_1.isdat1[isdat - 1];
-#line 22707 ""
+#line 22700 ""
commvl_1.ivx = commvl_1.ivmx[igetbits_(&isdata, &c__5, &c__13)
+ (igetbits_(&isdata, &c__1, &c__12) + 1) * 24 - 25];
-#line 22708 ""
+#line 22701 ""
ipnew = igetbits_(&isdata, &c__8, &c__3) - all_1.nib[
commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
-#line 22709 ""
+#line 22702 ""
if (all_1.ibar > 2) {
-#line 22710 ""
+#line 22703 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22711 ""
+#line 22704 ""
}
-#line 22712 ""
+#line 22705 ""
ipnew = i_dim(&ipnew, &c__0);
-#line 22713 ""
+#line 22706 ""
setbits_(&isdata, &c__8, &c__3, &ipnew);
-#line 22714 ""
+#line 22707 ""
all_1.isdat1[isdat - 1] = isdata;
-#line 22715 ""
+#line 22708 ""
/* L41: */
-#line 22715 ""
+#line 22708 ""
}
-#line 22716 ""
+#line 22709 ""
i__2 = comcb_1.nbc;
-#line 22716 ""
+#line 22709 ""
for (ibc = 1; ibc <= i__2; ++ibc) {
-#line 22717 ""
+#line 22710 ""
commvl_1.ivx = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&
comcb_1.ibcdata[ibc - 1], &c__1, &c__28) << 4);
-#line 22718 ""
+#line 22711 ""
ipnew = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4) -
all_1.nib[commvl_1.ivx + (all_1.ibar - 1) * 24 - 25];
-#line 22719 ""
+#line 22712 ""
if (all_1.ibar > 2) {
-#line 22720 ""
+#line 22713 ""
ipnew += all_1.nib[commvl_1.ivx + (all_1.ibar - 2) * 24 -
25];
-#line 22721 ""
+#line 22714 ""
}
-#line 22722 ""
+#line 22715 ""
ipnew = i_dim(&ipnew, &c__0);
-#line 22723 ""
+#line 22716 ""
setbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4, &ipnew);
-#line 22724 ""
+#line 22717 ""
/* L44: */
-#line 22724 ""
+#line 22717 ""
}
-#line 22725 ""
+#line 22718 ""
i__2 = comarpshift_1.numarpshift;
-#line 22725 ""
+#line 22718 ""
for (iarps = 1; iarps <= i__2; ++iarps) {
-#line 22726 ""
+#line 22719 ""
comarpshift_1.iparpshift[iarps - 1] -= all_1.nib[
comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar - 1)
* 24 - 25];
-#line 22728 ""
+#line 22721 ""
if (all_1.ibar > 2) {
-#line 22729 ""
+#line 22722 ""
comarpshift_1.iparpshift[iarps - 1] += all_1.nib[
comarpshift_1.ivarpshift[iarps - 1] + (all_1.ibar
- 2) * 24 - 25];
-#line 22731 ""
+#line 22724 ""
}
-#line 22732 ""
+#line 22725 ""
/* L45: */
-#line 22732 ""
+#line 22725 ""
}
/* Bookkeeping for figures. This will set nfigs = 0 if there are no figs left. */
/* If there are figs left, it will reset all times relative to start of */
/* current bar. */
-#line 22738 ""
+#line 22731 ""
for (commvl_1.ivx = 1; commvl_1.ivx <= 2; ++commvl_1.ivx) {
-#line 22739 ""
+#line 22732 ""
if (all_1.figbass) {
-#line 22740 ""
+#line 22733 ""
islide = 0;
-#line 22741 ""
+#line 22734 ""
i__2 = comfig_1.nfigs[commvl_1.ivx - 1];
-#line 22741 ""
+#line 22734 ""
for (jfig = 1; jfig <= i__2; ++jfig) {
-#line 22742 ""
+#line 22735 ""
if (comfig_1.itfig[commvl_1.ivx + (jfig << 1) - 3] <
all_1.lenbar) {
/* This figure was already used */
-#line 22746 ""
+#line 22739 ""
islide = jfig;
-#line 22747 ""
+#line 22740 ""
} else {
-#line 22748 ""
+#line 22741 ""
comfig_1.itfig[commvl_1.ivx + (jfig - islide << 1)
- 3] = comfig_1.itfig[commvl_1.ivx + (
jfig << 1) - 3] - all_1.lenbar;
-#line 22749 ""
+#line 22742 ""
s_copy(comfig_1.figq + (commvl_1.ivx + (jfig -
islide << 1) - 3) * 10, comfig_1.figq + (
commvl_1.ivx + (jfig << 1) - 3) * 10, (
ftnlen)10, (ftnlen)10);
-#line 22750 ""
+#line 22743 ""
comgrace_1.itoff[commvl_1.ivx + (jfig - islide <<
1) - 3] = comgrace_1.itoff[commvl_1.ivx +
(jfig << 1) - 3];
-#line 22751 ""
+#line 22744 ""
comfig_1.ivupfig[commvl_1.ivx + (jfig - islide <<
1) - 3] = comfig_1.ivupfig[commvl_1.ivx +
(jfig << 1) - 3];
-#line 22752 ""
+#line 22745 ""
comfig_1.ivvfig[commvl_1.ivx + (jfig - islide <<
1) - 3] = comfig_1.ivvfig[commvl_1.ivx + (
jfig << 1) - 3];
-#line 22753 ""
+#line 22746 ""
}
-#line 22754 ""
+#line 22747 ""
/* L20: */
-#line 22754 ""
+#line 22747 ""
}
-#line 22755 ""
+#line 22748 ""
comfig_1.nfigs[commvl_1.ivx - 1] -= islide;
-#line 22756 ""
+#line 22749 ""
}
-#line 22757 ""
+#line 22750 ""
if (comfig_1.nfigs[1] == 0) {
-#line 22757 ""
+#line 22750 ""
goto L47;
-#line 22757 ""
+#line 22750 ""
}
-#line 22758 ""
+#line 22751 ""
/* L46: */
-#line 22758 ""
+#line 22751 ""
}
-#line 22759 ""
+#line 22752 ""
L47:
-#line 22760 ""
+#line 22753 ""
;
-#line 22760 ""
+#line 22753 ""
}
/* End of sliding down for bars after first in gulp. */
/* The following may not be needed by makeabar, but just in case... */
-#line 22766 ""
+#line 22759 ""
if (all_1.firstgulp && all_1.lenb0 != 0) {
-#line 22767 ""
+#line 22760 ""
if (all_1.ibar == 1) {
-#line 22768 ""
+#line 22761 ""
all_1.lenbar = all_1.lenb0;
-#line 22769 ""
+#line 22762 ""
} else {
-#line 22770 ""
+#line 22763 ""
all_1.lenbar = all_1.lenb1;
-#line 22771 ""
+#line 22764 ""
}
-#line 22772 ""
+#line 22765 ""
}
/* Equal line spacing stuff */
-#line 22776 ""
+#line 22769 ""
if (comget_1.equalize && comask_1.bar1syst) {
-#line 22777 ""
+#line 22770 ""
if (isystpg == 1) {
-#line 22778 ""
+#line 22771 ""
s_wsfe(&io___1571);
/* Writing concatenation */
-#line 22778 ""
+#line 22771 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22778 ""
+#line 22771 ""
i__6[1] = 8, a__4[1] = "starteq%";
-#line 22778 ""
+#line 22771 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 22778 ""
+#line 22771 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22778 ""
+#line 22771 ""
e_wsfe();
-#line 22779 ""
+#line 22772 ""
} else if (isystpg == comnotes_1.nsystp[comnotes_1.ipage - 1] - 1)
{
-#line 22780 ""
+#line 22773 ""
s_wsfe(&io___1572);
/* Writing concatenation */
-#line 22780 ""
+#line 22773 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22780 ""
+#line 22773 ""
i__6[1] = 6, a__4[1] = "endeq%";
-#line 22780 ""
+#line 22773 ""
s_cat(ch__41, a__4, i__6, &c__2, (ftnlen)7);
-#line 22780 ""
+#line 22773 ""
do_fio(&c__1, ch__41, (ftnlen)7);
-#line 22780 ""
+#line 22773 ""
e_wsfe();
-#line 22781 ""
+#line 22774 ""
}
-#line 22782 ""
+#line 22775 ""
}
-#line 22783 ""
+#line 22776 ""
make1bar_(&ibmrep, &tglp1, tstart, cwrest, squez, istop, numbms,
istart);
-#line 22785 ""
+#line 22778 ""
make2bar_(&comnotes_1.ninow, &tglp1, tstart, cwrest, squez, istop,
numbms, istart, comclefq_1.clefq, (ftnlen)1);
/* Hardspace before barline? */
-#line 22790 ""
+#line 22783 ""
hardb4 = 0.f;
-#line 22791 ""
+#line 22784 ""
i__2 = all_1.nv;
-#line 22791 ""
+#line 22784 ""
for (all_1.iv = 1; all_1.iv <= i__2; ++all_1.iv) {
-#line 22792 ""
+#line 22785 ""
i__7 = commvl_1.nvmx[all_1.iv - 1];
-#line 22792 ""
+#line 22785 ""
for (kv = 1; kv <= i__7; ++kv) {
-#line 22793 ""
+#line 22786 ""
commvl_1.ivx = commvl_1.ivmx[all_1.iv + kv * 24 - 25];
-#line 22794 ""
+#line 22787 ""
if (bit_test(all_1.irest[commvl_1.ivx + all_1.nn[commvl_1.ivx
- 1] * 24 - 25],18)) {
-#line 22795 ""
+#line 22788 ""
++comudsp_1.nudoff[commvl_1.ivx - 1];
/* Computing MAX */
-#line 22796 ""
+#line 22789 ""
r__1 = hardb4, r__2 = comudsp_1.udoff[commvl_1.ivx +
comudsp_1.nudoff[commvl_1.ivx - 1] * 24 - 25];
-#line 22796 ""
+#line 22789 ""
hardb4 = dmax(r__1,r__2);
-#line 22797 ""
+#line 22790 ""
}
-#line 22798 ""
-/* L35: */
-#line 22798 ""
+#line 22791 ""
+/* L3599: */
+#line 22791 ""
}
-#line 22798 ""
+#line 22792 ""
+/* L35: */
+#line 22792 ""
}
-#line 22799 ""
+#line 22793 ""
if (hardb4 > 0.f) {
-#line 22800 ""
+#line 22794 ""
if (comlast_1.islast) {
-#line 22800 ""
+#line 22794 ""
s_wsfe(&io___1580);
/* Writing concatenation */
-#line 22800 ""
+#line 22794 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22800 ""
+#line 22794 ""
i__6[1] = 10, a__4[1] = "hardspace{";
-#line 22800 ""
+#line 22794 ""
s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)11);
-#line 22800 ""
+#line 22794 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22800 ""
+#line 22794 ""
do_fio(&c__1, (char *)&hardb4, (ftnlen)sizeof(real));
-#line 22800 ""
+#line 22794 ""
do_fio(&c__1, "pt}%", (ftnlen)4);
-#line 22800 ""
+#line 22794 ""
e_wsfe();
-#line 22800 ""
+#line 22794 ""
}
/* This was causing an incorrect poe in an example, which did not affect main */
/* spacing, but did cause an extra accidental space to be too small */
-#line 22806 ""
+#line 22800 ""
comask_1.fixednew -= hardb4;
-#line 22807 ""
+#line 22801 ""
}
-#line 22808 ""
+#line 22802 ""
/* L10: */
-#line 22808 ""
+#line 22802 ""
}
-#line 22809 ""
+#line 22803 ""
all_1.firstgulp = FALSE_;
-#line 22810 ""
+#line 22804 ""
all_1.lenb0 = 0;
-#line 22811 ""
+#line 22805 ""
goto L30;
-#line 22812 ""
+#line 22806 ""
L40:
-#line 22812 ""
+#line 22806 ""
cl__1.cerr = 0;
-#line 22812 ""
+#line 22806 ""
cl__1.cunit = 12;
-#line 22812 ""
+#line 22806 ""
cl__1.csta = 0;
-#line 22812 ""
+#line 22806 ""
f_clos(&cl__1);
-#line 22813 ""
+#line 22807 ""
cl__1.cerr = 0;
-#line 22813 ""
+#line 22807 ""
cl__1.cunit = 13;
-#line 22813 ""
+#line 22807 ""
cl__1.csta = 0;
-#line 22813 ""
+#line 22807 ""
f_clos(&cl__1);
-#line 22814 ""
+#line 22808 ""
inbuff_1.ilbuf = 1;
-#line 22815 ""
+#line 22809 ""
inbuff_1.ipbuf = 0;
-#line 22816 ""
+#line 22810 ""
wdpt = comtop_1.widthpt;
-#line 22817 ""
+#line 22811 ""
if (all_1.iline == 1) {
-#line 22817 ""
+#line 22811 ""
wdpt = comtop_1.widthpt * (1 - comtop_1.fracindent);
-#line 22817 ""
+#line 22811 ""
}
-#line 22818 ""
+#line 22812 ""
poe = (wdpt - fsyst * all_1.musicsize - nbarss * .4f - comask_1.fixednew)
/ (elsktot + comask_1.fbar * nbarss - comask_1.scaldold);
-#line 22820 ""
+#line 22814 ""
poevec[nsyst] = poe;
-#line 22821 ""
+#line 22815 ""
if (! comlast_1.islast) {
-#line 22822 ""
+#line 22816 ""
cl__1.cerr = 0;
-#line 22822 ""
+#line 22816 ""
cl__1.cunit = 11;
-#line 22822 ""
+#line 22816 ""
cl__1.csta = 0;
-#line 22822 ""
+#line 22816 ""
f_clos(&cl__1);
-#line 22823 ""
+#line 22817 ""
cl__1.cerr = 0;
-#line 22823 ""
+#line 22817 ""
cl__1.cunit = 16;
-#line 22823 ""
+#line 22817 ""
cl__1.csta = 0;
-#line 22823 ""
+#line 22817 ""
f_clos(&cl__1);
-#line 22824 ""
+#line 22818 ""
if (all_1.figbass) {
-#line 22824 ""
+#line 22818 ""
cl__1.cerr = 0;
-#line 22824 ""
+#line 22818 ""
cl__1.cunit = 14;
-#line 22824 ""
+#line 22818 ""
cl__1.csta = 0;
-#line 22824 ""
+#line 22818 ""
f_clos(&cl__1);
-#line 22824 ""
+#line 22818 ""
}
-#line 22825 ""
+#line 22819 ""
return 0;
-#line 22826 ""
+#line 22820 ""
}
-#line 22827 ""
+#line 22821 ""
i__1 = comas2_1.nasksys;
-#line 22827 ""
+#line 22821 ""
for (ia = 1; ia <= i__1; ++ia) {
-#line 22828 ""
+#line 22822 ""
++comas3_1.iask;
-#line 22829 ""
+#line 22823 ""
comas3_1.ask[comas3_1.iask - 1] = (comas2_1.wasksys[ia - 1] / poe - (
r__1 = comas2_1.elasksys[ia - 1], dabs(r__1))) /
comshort_1.poefa[all_1.iline - 1];
-#line 22830 ""
+#line 22824 ""
if (comas2_1.elasksys[ia - 1] > 0.f) {
-#line 22830 ""
+#line 22824 ""
comas3_1.ask[comas3_1.iask - 1] = r_dim(&comas3_1.ask[
comas3_1.iask - 1], &c_b1008);
-#line 22830 ""
+#line 22824 ""
}
-#line 22831 ""
+#line 22825 ""
/* L19: */
-#line 22831 ""
+#line 22825 ""
}
-#line 22832 ""
+#line 22826 ""
i__1 = nhssys;
-#line 22832 ""
+#line 22826 ""
for (ia = 1; ia <= i__1; ++ia) {
-#line 22833 ""
+#line 22827 ""
++nhstot;
/* Computing MAX */
-#line 22834 ""
+#line 22828 ""
r__1 = hpts[ia - 1] - hesk[ia - 1] * poe;
-#line 22834 ""
+#line 22828 ""
comhsp_1.hpttot[nhstot - 1] = dmax(r__1,0.f);
-#line 22835 ""
+#line 22829 ""
/* L26: */
-#line 22835 ""
+#line 22829 ""
}
-#line 22836 ""
+#line 22830 ""
if (comlast_1.islast && onvolt) {
-#line 22836 ""
+#line 22830 ""
s_wsfe(&io___1581);
/* Writing concatenation */
-#line 22836 ""
+#line 22830 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22836 ""
+#line 22830 ""
i__6[1] = 11, a__4[1] = "endvoltabox";
-#line 22836 ""
+#line 22830 ""
s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)12);
-#line 22836 ""
+#line 22830 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22836 ""
+#line 22830 ""
e_wsfe();
-#line 22836 ""
+#line 22830 ""
}
-#line 22838 ""
+#line 22832 ""
s_copy(rendq, "% ", (ftnlen)3, (ftnlen)3);
-#line 22839 ""
+#line 22833 ""
if (comshort_1.ishort != 0) {
-#line 22839 ""
+#line 22833 ""
s_copy(rendq, "}}%", (ftnlen)3, (ftnlen)3);
-#line 22839 ""
+#line 22833 ""
}
-#line 22840 ""
+#line 22834 ""
if (*(unsigned char *)comget_1.rptfq2 != 'E') {
/* Terminal repeat. Right or double? */
-#line 22844 ""
+#line 22838 ""
if (*(unsigned char *)comget_1.rptfq2 == 'r') {
-#line 22845 ""
+#line 22839 ""
if (comlast_1.islast) {
-#line 22845 ""
+#line 22839 ""
s_wsfe(&io___1583);
/* Writing concatenation */
-#line 22845 ""
+#line 22839 ""
i__12[0] = 1, a__9[0] = all_1.sq;
-#line 22845 ""
+#line 22839 ""
i__12[1] = 14, a__9[1] = "setrightrepeat";
-#line 22845 ""
+#line 22839 ""
i__12[2] = 1, a__9[2] = all_1.sq;
-#line 22845 ""
+#line 22839 ""
i__12[3] = 8, a__9[3] = "endpiece";
-#line 22845 ""
+#line 22839 ""
i__12[4] = 3, a__9[4] = rendq;
-#line 22845 ""
+#line 22839 ""
s_cat(ch__5, a__9, i__12, &c__5, (ftnlen)27);
-#line 22845 ""
+#line 22839 ""
do_fio(&c__1, ch__5, (ftnlen)27);
-#line 22845 ""
+#line 22839 ""
e_wsfe();
-#line 22845 ""
+#line 22839 ""
}
-#line 22847 ""
+#line 22841 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'd') {
-#line 22848 ""
+#line 22842 ""
if (comlast_1.islast) {
-#line 22848 ""
+#line 22842 ""
s_wsfe(&io___1584);
/* Writing concatenation */
-#line 22848 ""
+#line 22842 ""
i__12[0] = 1, a__9[0] = all_1.sq;
-#line 22848 ""
+#line 22842 ""
i__12[1] = 12, a__9[1] = "setdoublebar";
-#line 22848 ""
+#line 22842 ""
i__12[2] = 1, a__9[2] = all_1.sq;
-#line 22848 ""
+#line 22842 ""
i__12[3] = 8, a__9[3] = "endpiece";
-#line 22848 ""
+#line 22842 ""
i__12[4] = 3, a__9[4] = rendq;
-#line 22848 ""
+#line 22842 ""
s_cat(ch__42, a__9, i__12, &c__5, (ftnlen)25);
-#line 22848 ""
+#line 22842 ""
do_fio(&c__1, ch__42, (ftnlen)25);
-#line 22848 ""
+#line 22842 ""
e_wsfe();
-#line 22848 ""
+#line 22842 ""
}
-#line 22850 ""
+#line 22844 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'b') {
-#line 22851 ""
+#line 22845 ""
if (comlast_1.islast) {
-#line 22851 ""
+#line 22845 ""
s_wsfe(&io___1585);
/* Writing concatenation */
-#line 22851 ""
+#line 22845 ""
i__8[0] = 1, a__5[0] = all_1.sq;
-#line 22851 ""
+#line 22845 ""
i__8[1] = 8, a__5[1] = "endpiece";
-#line 22851 ""
+#line 22845 ""
i__8[2] = 3, a__5[2] = rendq;
-#line 22851 ""
+#line 22845 ""
s_cat(ch__14, a__5, i__8, &c__3, (ftnlen)12);
-#line 22851 ""
+#line 22845 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22851 ""
+#line 22845 ""
e_wsfe();
-#line 22851 ""
+#line 22845 ""
}
-#line 22852 ""
+#line 22846 ""
} else if (*(unsigned char *)comget_1.rptfq2 == 'z') {
-#line 22853 ""
+#line 22847 ""
if (comlast_1.islast) {
-#line 22853 ""
+#line 22847 ""
s_wsfe(&io___1586);
/* Writing concatenation */
-#line 22853 ""
+#line 22847 ""
i__12[0] = 1, a__9[0] = all_1.sq;
-#line 22853 ""
+#line 22847 ""
i__12[1] = 12, a__9[1] = "setzalaligne";
-#line 22853 ""
+#line 22847 ""
i__12[2] = 1, a__9[2] = all_1.sq;
-#line 22853 ""
+#line 22847 ""
i__12[3] = 8, a__9[3] = "Endpiece";
-#line 22853 ""
+#line 22847 ""
i__12[4] = 3, a__9[4] = rendq;
-#line 22853 ""
+#line 22847 ""
s_cat(ch__42, a__9, i__12, &c__5, (ftnlen)25);
-#line 22853 ""
+#line 22847 ""
do_fio(&c__1, ch__42, (ftnlen)25);
-#line 22853 ""
+#line 22847 ""
e_wsfe();
-#line 22853 ""
+#line 22847 ""
}
-#line 22855 ""
+#line 22849 ""
} else {
-#line 22856 ""
+#line 22850 ""
s_wsle(&io___1587);
-#line 22856 ""
+#line 22850 ""
e_wsle();
-#line 22857 ""
+#line 22851 ""
s_wsle(&io___1588);
-#line 22857 ""
+#line 22851 ""
do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\
"q2:", (ftnlen)37);
-#line 22857 ""
+#line 22851 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
-#line 22857 ""
+#line 22851 ""
e_wsle();
-#line 22858 ""
+#line 22852 ""
s_wsle(&io___1589);
-#line 22858 ""
+#line 22852 ""
do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf"\
"q2:", (ftnlen)37);
-#line 22858 ""
+#line 22852 ""
do_lio(&c__9, &c__1, comget_1.rptfq2, (ftnlen)1);
-#line 22858 ""
+#line 22852 ""
e_wsle();
-#line 22859 ""
+#line 22853 ""
if (comlast_1.islast) {
-#line 22859 ""
+#line 22853 ""
s_wsfe(&io___1590);
/* Writing concatenation */
-#line 22859 ""
+#line 22853 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22859 ""
+#line 22853 ""
i__6[1] = 8, a__4[1] = "Endpiece";
-#line 22859 ""
+#line 22853 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 22859 ""
+#line 22853 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22859 ""
+#line 22853 ""
e_wsfe();
-#line 22859 ""
+#line 22853 ""
}
-#line 22860 ""
+#line 22854 ""
}
-#line 22861 ""
+#line 22855 ""
} else {
-#line 22862 ""
+#line 22856 ""
s_wsfe(&io___1591);
/* Writing concatenation */
-#line 22862 ""
+#line 22856 ""
i__8[0] = 1, a__5[0] = all_1.sq;
-#line 22862 ""
+#line 22856 ""
i__8[1] = 8, a__5[1] = "Endpiece";
-#line 22862 ""
+#line 22856 ""
i__8[2] = 3, a__5[2] = rendq;
-#line 22862 ""
+#line 22856 ""
s_cat(ch__14, a__5, i__8, &c__3, (ftnlen)12);
-#line 22862 ""
+#line 22856 ""
do_fio(&c__1, ch__14, (ftnlen)12);
-#line 22862 ""
+#line 22856 ""
e_wsfe();
-#line 22863 ""
+#line 22857 ""
}
-#line 22864 ""
+#line 22858 ""
if (! vshrink) {
-#line 22865 ""
+#line 22859 ""
if (comlast_1.islast && combottop_1.bottopgap) {
-#line 22866 ""
+#line 22860 ""
if (dabs(combottop_1.botamt) > 1e-6f) {
-#line 22867 ""
+#line 22861 ""
if (combottop_1.botamt > 9.95f) {
-#line 22868 ""
+#line 22862 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22869 ""
+#line 22863 ""
} else if (combottop_1.botamt > 0.f) {
-#line 22870 ""
+#line 22864 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22871 ""
+#line 22865 ""
} else if (combottop_1.botamt > -9.95f) {
-#line 22872 ""
+#line 22866 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22873 ""
+#line 22867 ""
} else {
-#line 22874 ""
+#line 22868 ""
s_copy(fmtq, "(a,f5.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22875 ""
+#line 22869 ""
}
-#line 22876 ""
+#line 22870 ""
s_wsfe(&io___1592);
/* Writing concatenation */
-#line 22876 ""
+#line 22870 ""
i__5[0] = 1, a__3[0] = all_1.sq;
-#line 22876 ""
+#line 22870 ""
i__5[1] = 4, a__3[1] = "null";
-#line 22876 ""
+#line 22870 ""
i__5[2] = 1, a__3[2] = all_1.sq;
-#line 22876 ""
+#line 22870 ""
i__5[3] = 5, a__3[3] = "vskip";
-#line 22876 ""
+#line 22870 ""
s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)11);
-#line 22876 ""
+#line 22870 ""
do_fio(&c__1, ch__15, (ftnlen)11);
-#line 22876 ""
+#line 22870 ""
do_fio(&c__1, (char *)&combottop_1.botamt, (ftnlen)sizeof(
real));
/* Writing concatenation */
-#line 22876 ""
+#line 22870 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22876 ""
+#line 22870 ""
i__6[1] = 10, a__4[1] = "Internote%";
-#line 22876 ""
+#line 22870 ""
s_cat(ch__32, a__4, i__6, &c__2, (ftnlen)11);
-#line 22876 ""
+#line 22870 ""
do_fio(&c__1, ch__32, (ftnlen)11);
-#line 22876 ""
+#line 22870 ""
e_wsfe();
-#line 22878 ""
+#line 22872 ""
}
-#line 22879 ""
+#line 22873 ""
}
-#line 22880 ""
+#line 22874 ""
xnstbot = xnsttop[comnotes_1.ipage - 1] * etabot / etatop;
-#line 22881 ""
+#line 22875 ""
if (xnstbot < 9.95f) {
-#line 22882 ""
+#line 22876 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22883 ""
+#line 22877 ""
} else {
-#line 22884 ""
+#line 22878 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
-#line 22885 ""
+#line 22879 ""
}
-#line 22886 ""
+#line 22880 ""
if (comlast_1.islast) {
-#line 22886 ""
+#line 22880 ""
s_wsfe(&io___1593);
/* Writing concatenation */
-#line 22886 ""
+#line 22880 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22886 ""
+#line 22880 ""
i__6[1] = 5, a__4[1] = "vskip";
-#line 22886 ""
+#line 22880 ""
s_cat(ch__25, a__4, i__6, &c__2, (ftnlen)6);
-#line 22886 ""
+#line 22880 ""
do_fio(&c__1, ch__25, (ftnlen)6);
-#line 22886 ""
+#line 22880 ""
do_fio(&c__1, (char *)&xnstbot, (ftnlen)sizeof(real));
/* Writing concatenation */
-#line 22886 ""
+#line 22880 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22886 ""
+#line 22880 ""
i__4[1] = 10, a__2[1] = "Interligne";
-#line 22886 ""
+#line 22880 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22886 ""
+#line 22880 ""
i__4[3] = 5, a__2[3] = "eject";
-#line 22886 ""
+#line 22880 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22886 ""
+#line 22880 ""
i__4[5] = 9, a__2[5] = "endmuflex";
-#line 22886 ""
+#line 22880 ""
s_cat(ch__5, a__2, i__4, &c__6, (ftnlen)27);
-#line 22886 ""
+#line 22880 ""
do_fio(&c__1, ch__5, (ftnlen)27);
-#line 22886 ""
+#line 22880 ""
e_wsfe();
-#line 22886 ""
+#line 22880 ""
}
-#line 22888 ""
+#line 22882 ""
if (comlast_1.islast) {
-#line 22888 ""
+#line 22882 ""
s_wsfe(&io___1594);
/* Writing concatenation */
-#line 22888 ""
+#line 22882 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22888 ""
+#line 22882 ""
i__6[1] = 3, a__4[1] = "bye";
-#line 22888 ""
+#line 22882 ""
s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4);
-#line 22888 ""
+#line 22882 ""
do_fio(&c__1, ch__21, (ftnlen)4);
-#line 22888 ""
+#line 22882 ""
e_wsfe();
-#line 22888 ""
+#line 22882 ""
}
-#line 22889 ""
+#line 22883 ""
} else {
-#line 22890 ""
+#line 22884 ""
if (comlast_1.islast) {
-#line 22890 ""
+#line 22884 ""
s_wsfe(&io___1595);
/* Writing concatenation */
-#line 22890 ""
+#line 22884 ""
i__4[0] = 1, a__2[0] = all_1.sq;
-#line 22890 ""
+#line 22884 ""
i__4[1] = 5, a__2[1] = "vfill";
-#line 22890 ""
+#line 22884 ""
i__4[2] = 1, a__2[2] = all_1.sq;
-#line 22890 ""
+#line 22884 ""
i__4[3] = 5, a__2[3] = "eject";
-#line 22890 ""
+#line 22884 ""
i__4[4] = 1, a__2[4] = all_1.sq;
-#line 22890 ""
+#line 22884 ""
i__4[5] = 9, a__2[5] = "endmuflex";
-#line 22890 ""
+#line 22884 ""
s_cat(ch__43, a__2, i__4, &c__6, (ftnlen)22);
-#line 22890 ""
+#line 22884 ""
do_fio(&c__1, ch__43, (ftnlen)22);
-#line 22890 ""
+#line 22884 ""
e_wsfe();
-#line 22890 ""
+#line 22884 ""
}
-#line 22892 ""
+#line 22886 ""
if (comlast_1.islast) {
-#line 22892 ""
+#line 22886 ""
s_wsfe(&io___1596);
/* Writing concatenation */
-#line 22892 ""
+#line 22886 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22892 ""
+#line 22886 ""
i__6[1] = 3, a__4[1] = "bye";
-#line 22892 ""
+#line 22886 ""
s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)4);
-#line 22892 ""
+#line 22886 ""
do_fio(&c__1, ch__21, (ftnlen)4);
-#line 22892 ""
+#line 22886 ""
e_wsfe();
-#line 22892 ""
+#line 22886 ""
}
-#line 22893 ""
+#line 22887 ""
}
-#line 22894 ""
+#line 22888 ""
al__1.aerr = 0;
-#line 22894 ""
+#line 22888 ""
al__1.aunit = 11;
-#line 22894 ""
+#line 22888 ""
f_rew(&al__1);
-#line 22895 ""
+#line 22889 ""
if (all_1.figbass) {
-#line 22896 ""
+#line 22890 ""
s_wsfe(&io___1597);
/* Writing concatenation */
-#line 22896 ""
+#line 22890 ""
i__6[0] = 1, a__4[0] = all_1.sq;
-#line 22896 ""
+#line 22890 ""
i__6[1] = 8, a__4[1] = "figdrop=";
-#line 22896 ""
+#line 22890 ""
s_cat(ch__18, a__4, i__6, &c__2, (ftnlen)9);
-#line 22896 ""
+#line 22890 ""
do_fio(&c__1, ch__18, (ftnlen)9);
-#line 22896 ""
+#line 22890 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 2], (ftnlen)
sizeof(integer));
/* Writing concatenation */
-#line 22896 ""
+#line 22890 ""
i__8[0] = 1, a__5[0] = " ";
-#line 22896 ""
+#line 22890 ""
i__8[1] = 1, a__5[1] = all_1.sq;
-#line 22896 ""
+#line 22890 ""
i__8[2] = 8, a__5[2] = "figdtwo=";
-#line 22896 ""
+#line 22890 ""
s_cat(ch__20, a__5, i__8, &c__3, (ftnlen)10);
-#line 22896 ""
+#line 22890 ""
do_fio(&c__1, ch__20, (ftnlen)10);
-#line 22896 ""
+#line 22890 ""
do_fio(&c__1, (char *)&all_1.ifigdr[(all_1.iline << 1) - 1], (ftnlen)
sizeof(integer));
/* Writing concatenation */
-#line 22896 ""
+#line 22890 ""
i__11[0] = 1, a__8[0] = all_1.sq;
-#line 22896 ""
+#line 22890 ""
i__11[1] = 4, a__8[1] = "fi}%";
-#line 22896 ""
+#line 22890 ""
s_cat(ch__40, a__8, i__11, &c__2, (ftnlen)5);
-#line 22896 ""
+#line 22890 ""
do_fio(&c__1, ch__40, (ftnlen)5);
-#line 22896 ""
+#line 22890 ""
e_wsfe();
-#line 22899 ""
+#line 22893 ""
al__1.aerr = 0;
-#line 22899 ""
+#line 22893 ""
al__1.aunit = 14;
-#line 22899 ""
+#line 22893 ""
f_rew(&al__1);
-#line 22900 ""
+#line 22894 ""
}
-#line 22901 ""
+#line 22895 ""
askfig_(pathnameq, &lpath, basenameq, &lbase, &all_1.figbass, &istype0, (
ftnlen)40, (ftnlen)44);
-#line 22902 ""
+#line 22896 ""
if (! (*optimize)) {
-#line 22903 ""
+#line 22897 ""
s_wsle(&io___1598);
-#line 22903 ""
+#line 22897 ""
e_wsle();
-#line 22904 ""
+#line 22898 ""
s_wsle(&io___1599);
/* Writing concatenation */
-#line 22904 ""
+#line 22898 ""
i__5[0] = 8, a__3[0] = "Writing ";
-#line 22904 ""
+#line 22898 ""
i__5[1] = lpath, a__3[1] = pathnameq;
-#line 22904 ""
+#line 22898 ""
i__5[2] = lbase, a__3[2] = basenameq;
-#line 22904 ""
+#line 22898 ""
i__5[3] = 4, a__3[3] = ".tex";
-#line 22904 ""
+#line 22898 ""
s_cat(ch__44, a__3, i__5, &c__4, (ftnlen)96);
-#line 22904 ""
+#line 22898 ""
do_lio(&c__9, &c__1, ch__44, lpath + 8 + lbase + 4);
-#line 22904 ""
+#line 22898 ""
e_wsle();
-#line 22906 ""
+#line 22900 ""
s_wsle(&io___1600);
-#line 22906 ""
+#line 22900 ""
do_lio(&c__9, &c__1, "Done with second PMX pass.", (ftnlen)26);
-#line 22906 ""
+#line 22900 ""
e_wsle();
-#line 22907 ""
+#line 22901 ""
s_wsfe(&io___1601);
/* Writing concatenation */
-#line 22907 ""
+#line 22901 ""
i__5[0] = 8, a__3[0] = "Writing ";
-#line 22907 ""
+#line 22901 ""
i__5[1] = lpath, a__3[1] = pathnameq;
-#line 22907 ""
+#line 22901 ""
i__5[2] = lbase, a__3[2] = basenameq;
-#line 22907 ""
+#line 22901 ""
i__5[3] = 4, a__3[3] = ".tex";
-#line 22907 ""
+#line 22901 ""
s_cat(ch__44, a__3, i__5, &c__4, (ftnlen)96);
-#line 22907 ""
+#line 22901 ""
do_fio(&c__1, ch__44, lpath + 8 + lbase + 4);
-#line 22907 ""
+#line 22901 ""
e_wsfe();
-#line 22909 ""
+#line 22903 ""
s_wsfe(&io___1602);
-#line 22909 ""
+#line 22903 ""
do_fio(&c__1, " Done with second PMX pass. Now run TeX", (ftnlen)40);
-#line 22909 ""
+#line 22903 ""
e_wsfe();
-#line 22910 ""
+#line 22904 ""
}
-#line 22911 ""
+#line 22905 ""
return 0;
} /* pmxb_ */
@@ -56492,41 +56769,41 @@ L40:
/* Compute avg. & norm. std. dev. of poe. */
-#line 22919 ""
+#line 22913 ""
/* Parameter adjustments */
-#line 22919 ""
+#line 22913 ""
--poe;
-#line 22919 ""
+#line 22913 ""
-#line 22919 ""
+#line 22913 ""
/* Function Body */
-#line 22919 ""
+#line 22913 ""
sumx = 0.f;
-#line 22920 ""
+#line 22914 ""
sumxx = 0.f;
-#line 22921 ""
+#line 22915 ""
i__1 = *nsyst;
-#line 22921 ""
+#line 22915 ""
for (isyst = 1; isyst <= i__1; ++isyst) {
-#line 22922 ""
+#line 22916 ""
sumx += poe[isyst];
/* Computing 2nd power */
-#line 22923 ""
+#line 22917 ""
r__1 = poe[isyst];
-#line 22923 ""
+#line 22917 ""
sumxx += r__1 * r__1;
-#line 22924 ""
+#line 22918 ""
/* L1: */
-#line 22924 ""
+#line 22918 ""
}
/* Computing 2nd power */
-#line 22925 ""
+#line 22919 ""
r__1 = sumx;
-#line 22925 ""
+#line 22919 ""
*devnorm = sqrt(*nsyst * sumxx / (r__1 * r__1) - 1);
-#line 22926 ""
+#line 22920 ""
*poebar = sumx / *nsyst;
-#line 22927 ""
+#line 22921 ""
return 0;
} /* poestats_ */
@@ -56573,308 +56850,308 @@ L40:
/* levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. */
/* icrdot(icrd)(27-29) sequence order of chord note if accid, top down */
-#line 22949 ""
+#line 22943 ""
for (i__ = 1; i__ <= 88; ++i__) {
-#line 22950 ""
+#line 22944 ""
levtabl[i__ - 1] = 0;
-#line 22951 ""
+#line 22945 ""
/* L11: */
-#line 22951 ""
+#line 22945 ""
}
-#line 22952 ""
+#line 22946 ""
i__1 = comtrill_1.ncrd;
-#line 22952 ""
+#line 22946 ""
for (comtrill_1.icrd1 = 1; comtrill_1.icrd1 <= i__1; ++comtrill_1.icrd1) {
-#line 22953 ""
+#line 22947 ""
ivx1 = (15 & lbit_shift(comtrill_1.icrdat[comtrill_1.icrd1 - 1], (
ftnlen)-8)) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd1
- 1], &c__1, &c__28) << 4);
-#line 22955 ""
+#line 22949 ""
ip1 = 255 & comtrill_1.icrdat[comtrill_1.icrd1 - 1];
-#line 22956 ""
+#line 22950 ""
if (ip1 == *ip && ivx1 == *ivx) {
-#line 22956 ""
+#line 22950 ""
goto L2;
-#line 22956 ""
+#line 22950 ""
}
-#line 22957 ""
+#line 22951 ""
/* L1: */
-#line 22957 ""
+#line 22951 ""
}
-#line 22958 ""
+#line 22952 ""
s_wsle(&io___1610);
-#line 22958 ""
+#line 22952 ""
e_wsle();
-#line 22959 ""
+#line 22953 ""
s_wsle(&io___1611);
-#line 22959 ""
+#line 22953 ""
do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc"\
"e to Dr. Don!", (ftnlen)63);
-#line 22959 ""
+#line 22953 ""
e_wsle();
-#line 22961 ""
+#line 22955 ""
stop1_();
-#line 22962 ""
+#line 22956 ""
L2:
-#line 22963 ""
+#line 22957 ""
comtrill_1.maxlev = *nolevm;
-#line 22964 ""
+#line 22958 ""
comtrill_1.minlev = *nolevm;
-#line 22965 ""
+#line 22959 ""
levtabl[*nolevm - 1] = -1;
-#line 22966 ""
+#line 22960 ""
is2nd = FALSE_;
-#line 22967 ""
+#line 22961 ""
naccid = 0;
-#line 22968 ""
+#line 22962 ""
levmaxacc = -100;
-#line 22969 ""
+#line 22963 ""
levminacc = 1000;
/* Check 1st 3 bits of nacc for accid on main note of chord. */
-#line 22973 ""
+#line 22967 ""
if ((7 & *nacc) > 0) {
-#line 22974 ""
+#line 22968 ""
naccid = 1;
/* Start list of notes with accid's. There will be naccid of them. kicrd=0 if main, */
/* otherwise icrd value for note with accidental. */
-#line 22979 ""
+#line 22973 ""
kicrd[0] = 0;
-#line 22980 ""
+#line 22974 ""
levmaxacc = *nolevm;
-#line 22981 ""
+#line 22975 ""
levminacc = *nolevm;
/* Start the level-ranking */
-#line 22985 ""
+#line 22979 ""
icrdot0 = 1;
-#line 22986 ""
+#line 22980 ""
}
-#line 22987 ""
+#line 22981 ""
i__1 = comtrill_1.ncrd;
-#line 22987 ""
+#line 22981 ""
for (comtrill_1.icrd2 = comtrill_1.icrd1; comtrill_1.icrd2 <= i__1;
++comtrill_1.icrd2) {
-#line 22988 ""
+#line 22982 ""
nolev = igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2 - 1], &c__7, &
c__12);
-#line 22989 ""
+#line 22983 ""
levtabl[nolev - 1] = comtrill_1.icrd2;
-#line 22990 ""
+#line 22984 ""
comtrill_1.maxlev = max(comtrill_1.maxlev,nolev);
-#line 22991 ""
+#line 22985 ""
comtrill_1.minlev = min(comtrill_1.minlev,nolev);
/* Check for accidental */
-#line 22995 ""
+#line 22989 ""
if (bit_test(comtrill_1.icrdat[comtrill_1.icrd2 - 1],19)) {
-#line 22996 ""
+#line 22990 ""
++naccid;
-#line 22997 ""
+#line 22991 ""
levmaxacc = max(levmaxacc,nolev);
-#line 22998 ""
+#line 22992 ""
levminacc = min(levminacc,nolev);
/* Add this icrd to list of values for notes with accid's. */
-#line 23002 ""
+#line 22996 ""
kicrd[naccid - 1] = comtrill_1.icrd2;
-#line 23003 ""
+#line 22997 ""
if (! bit_test(*nacc,28)) {
/* Order not forced, so get the level-ranking, top down */
-#line 23007 ""
+#line 23001 ""
iorder = 1;
-#line 23008 ""
+#line 23002 ""
i__2 = naccid - 1;
-#line 23008 ""
+#line 23002 ""
for (iaccid = 1; iaccid <= i__2; ++iaccid) {
-#line 23009 ""
+#line 23003 ""
if (kicrd[iaccid - 1] == 0) {
-#line 23010 ""
+#line 23004 ""
if (*nolevm > nolev) {
-#line 23011 ""
+#line 23005 ""
++iorder;
-#line 23012 ""
+#line 23006 ""
} else {
-#line 23013 ""
+#line 23007 ""
++icrdot0;
-#line 23014 ""
+#line 23008 ""
}
-#line 23015 ""
+#line 23009 ""
} else {
-#line 23016 ""
+#line 23010 ""
if (igetbits_(&comtrill_1.icrdat[kicrd[iaccid - 1] -
1], &c__7, &c__12) > nolev) {
-#line 23018 ""
+#line 23012 ""
++iorder;
-#line 23019 ""
+#line 23013 ""
} else {
-#line 23020 ""
+#line 23014 ""
iold = igetbits_(&comtrill_1.icrdot[kicrd[iaccid
- 1] - 1], &c__3, &c__27);
-#line 23021 ""
+#line 23015 ""
i__3 = iold + 1;
-#line 23021 ""
+#line 23015 ""
setbits_(&comtrill_1.icrdot[kicrd[iaccid - 1] - 1]
, &c__3, &c__27, &i__3);
-#line 23022 ""
+#line 23016 ""
}
-#line 23023 ""
+#line 23017 ""
}
-#line 23024 ""
+#line 23018 ""
/* L12: */
-#line 23024 ""
+#line 23018 ""
}
-#line 23025 ""
+#line 23019 ""
setbits_(&comtrill_1.icrdot[comtrill_1.icrd2 - 1], &c__3, &
c__27, &iorder);
-#line 23026 ""
+#line 23020 ""
}
-#line 23027 ""
+#line 23021 ""
}
/* Exit loop if last note in this chord */
-#line 23031 ""
+#line 23025 ""
if (comtrill_1.icrd2 == comtrill_1.ncrd) {
-#line 23031 ""
+#line 23025 ""
goto L4;
-#line 23031 ""
+#line 23025 ""
}
-#line 23032 ""
+#line 23026 ""
if (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__8, &c__0) != *
ip || igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &c__4, &
c__8) + (igetbits_(&comtrill_1.icrdat[comtrill_1.icrd2], &
c__1, &c__28) << 4) != *ivx) {
-#line 23032 ""
+#line 23026 ""
goto L4;
-#line 23032 ""
+#line 23026 ""
}
/* * igetbits(icrdat(icrd2+1),4,8) .ne. ivx) go to 4 */
-#line 23036 ""
+#line 23030 ""
/* L3: */
-#line 23036 ""
+#line 23030 ""
}
-#line 23037 ""
+#line 23031 ""
s_wsle(&io___1622);
-#line 23037 ""
+#line 23031 ""
e_wsle();
-#line 23038 ""
+#line 23032 ""
s_wsle(&io___1623);
-#line 23038 ""
+#line 23032 ""
do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr."\
" Don!", (ftnlen)55);
-#line 23038 ""
+#line 23032 ""
e_wsle();
-#line 23039 ""
+#line 23033 ""
stop1_();
-#line 23040 ""
+#line 23034 ""
L4:
/* Now icrd1, icrd2 define range of icrd for this chord. */
/* Bypass autos-shifting if any manual shifts are present */
-#line 23046 ""
+#line 23040 ""
if (bit_test(*irest,20) || bit_test(*irest,27)) {
-#line 23046 ""
+#line 23040 ""
goto L10;
-#line 23046 ""
+#line 23040 ""
}
/* Check for 2nds */
-#line 23050 ""
+#line 23044 ""
for (ilev = 1; ilev <= 87; ++ilev) {
-#line 23051 ""
+#line 23045 ""
if (levtabl[ilev - 1] != 0 && levtabl[ilev] != 0) {
/* There is at least one 2nd.. */
-#line 23055 ""
+#line 23049 ""
if (*(unsigned char *)udq == 'u') {
/* Upstem. Start with 2nd just found and go up, rt-shifting upper */
/* member of each pair */
-#line 23060 ""
+#line 23054 ""
ile = ilev;
/* Set main-note flag for ANY right-shift */
-#line 23064 ""
+#line 23058 ""
*irest = bit_set(*irest,20);
-#line 23065 ""
+#line 23059 ""
L7:
-#line 23066 ""
+#line 23060 ""
if (levtabl[ile] < 0) {
/* Upstem, & upper member is main so must be rt-shifted. This would move */
/* stem too, so we rt-shift the OTHER note, and set flag that signals */
/* to interchange pitches just when these two notes are placed. */
-#line 23072 ""
+#line 23066 ""
*nacc = bit_set(*nacc,30);
-#line 23073 ""
+#line 23067 ""
comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 1] - 1],24);
-#line 23074 ""
+#line 23068 ""
} else {
/* Upper member is chord note, must be rt-shifted */
-#line 23078 ""
+#line 23072 ""
comtrill_1.icrdat[levtabl[ile] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile] - 1],24);
-#line 23079 ""
+#line 23073 ""
}
-#line 23080 ""
+#line 23074 ""
++ile;
-#line 23081 ""
+#line 23075 ""
L8:
-#line 23082 ""
+#line 23076 ""
++ile;
-#line 23083 ""
+#line 23077 ""
if (ile < 87) {
-#line 23084 ""
+#line 23078 ""
if (levtabl[ile - 1] != 0 && levtabl[ile] != 0) {
-#line 23085 ""
+#line 23079 ""
goto L7;
-#line 23086 ""
+#line 23080 ""
} else {
-#line 23087 ""
+#line 23081 ""
goto L8;
-#line 23088 ""
+#line 23082 ""
}
-#line 23089 ""
+#line 23083 ""
}
-#line 23090 ""
+#line 23084 ""
goto L10;
-#line 23091 ""
+#line 23085 ""
} else {
/* Downstem. Start at top and work down, left-shifting lower member of each pair. */
/* We know that lowest pair is at (ilev,ilev+1). */
-#line 23096 ""
+#line 23090 ""
ile = 88;
/* Set main-note flag for ANY right-shift */
-#line 23100 ""
+#line 23094 ""
*irest = bit_set(*irest,27);
-#line 23101 ""
+#line 23095 ""
L9:
-#line 23102 ""
+#line 23096 ""
if (levtabl[ile - 1] != 0 && levtabl[ile - 2] != 0) {
-#line 23103 ""
+#line 23097 ""
if (levtabl[ile - 2] < 0) {
/* ipl = ibset(ipl,8) */
@@ -56882,57 +57159,57 @@ L9:
/* stem too, so we left-shift the OTHER note, and set flag that signals */
/* to interchange pitches just when these two notes are placed. */
-#line 23110 ""
+#line 23104 ""
*nacc = bit_set(*nacc,31);
-#line 23111 ""
+#line 23105 ""
comtrill_1.icrdat[levtabl[ile - 1] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 1] - 1],23);
-#line 23112 ""
+#line 23106 ""
} else {
/* Lower member is chord note, must be shifted */
-#line 23116 ""
+#line 23110 ""
comtrill_1.icrdat[levtabl[ile - 2] - 1] = bit_set(
comtrill_1.icrdat[levtabl[ile - 2] - 1],23);
-#line 23118 ""
+#line 23112 ""
}
-#line 23119 ""
+#line 23113 ""
--ile;
-#line 23120 ""
+#line 23114 ""
}
-#line 23121 ""
+#line 23115 ""
--ile;
-#line 23122 ""
+#line 23116 ""
if (ile >= ilev + 1) {
-#line 23122 ""
+#line 23116 ""
goto L9;
-#line 23122 ""
+#line 23116 ""
}
-#line 23123 ""
+#line 23117 ""
goto L10;
-#line 23124 ""
+#line 23118 ""
}
-#line 23125 ""
+#line 23119 ""
}
-#line 23126 ""
+#line 23120 ""
/* L5: */
-#line 23126 ""
+#line 23120 ""
}
-#line 23127 ""
+#line 23121 ""
L10:
/* Done with 2nds, now do accid's. Call even if just one, in case left shifts. */
/* if (naccid .gt. 1) call crdaccs(nacc,ipl,irest,naccid, */
-#line 23132 ""
+#line 23126 ""
if (naccid >= 1) {
-#line 23132 ""
+#line 23126 ""
crdaccs_(nacc, ipl, irest, &naccid, kicrd, nolevm, &levmaxacc, &
levminacc, &icrdot0, twooftwo, icashft);
-#line 23132 ""
+#line 23126 ""
}
-#line 23134 ""
+#line 23128 ""
return 0;
} /* precrd_ */
@@ -56951,19 +57228,19 @@ L10:
/* Send string to console and to log file */
-#line 23141 ""
+#line 23135 ""
s_wsle(&io___1626);
-#line 23141 ""
+#line 23135 ""
do_lio(&c__9, &c__1, string, string_len);
-#line 23141 ""
+#line 23135 ""
e_wsle();
-#line 23142 ""
+#line 23136 ""
s_wsfe(&io___1627);
-#line 23142 ""
+#line 23136 ""
do_fio(&c__1, string, string_len);
-#line 23142 ""
+#line 23136 ""
e_wsfe();
-#line 23143 ""
+#line 23137 ""
return 0;
} /* printl_ */
@@ -57011,320 +57288,320 @@ L10:
/* Find which iarp, if any */
-#line 23164 ""
+#line 23158 ""
i__1 = comarp_1.narp;
-#line 23164 ""
+#line 23158 ""
for (iarp = 1; iarp <= i__1; ++iarp) {
-#line 23165 ""
+#line 23159 ""
if ((r__1 = *tnow - comarp_1.tar[iarp - 1], dabs(r__1)) <
comtol_1.tol) {
-#line 23165 ""
+#line 23159 ""
goto L2;
-#line 23165 ""
+#line 23159 ""
}
-#line 23166 ""
+#line 23160 ""
/* L1: */
-#line 23166 ""
+#line 23160 ""
}
/* If here, this is the *first* call for this arp. */
-#line 23170 ""
+#line 23164 ""
++comarp_1.narp;
-#line 23171 ""
+#line 23165 ""
comarp_1.tar[comarp_1.narp - 1] = *tnow + comtol_1.tol * .5f;
-#line 23172 ""
+#line 23166 ""
comarp_1.ivar1[comarp_1.narp - 1] = *iv;
-#line 23173 ""
+#line 23167 ""
comarp_1.ipar1[comarp_1.narp - 1] = *ip;
-#line 23174 ""
+#line 23168 ""
comarp_1.levar1[comarp_1.narp - 1] = *nolev;
-#line 23175 ""
+#line 23169 ""
comarp_1.ncmar1[comarp_1.narp - 1] = *ncm;
-#line 23176 ""
+#line 23170 ""
return 0;
-#line 23177 ""
+#line 23171 ""
L2:
/* If here, this is *second* call at this time, narp points to values from 1st. */
/* Check for shift. Set IsArpShift and iarps */
-#line 23183 ""
+#line 23177 ""
i__1 = comarpshift_1.numarpshift;
-#line 23183 ""
+#line 23177 ""
for (iarps = 1; iarps <= i__1; ++iarps) {
-#line 23184 ""
+#line 23178 ""
if (comarpshift_1.ivarpshift[iarps - 1] == comarp_1.ivar1[iarp - 1] &&
comarpshift_1.iparpshift[iarps - 1] == comarp_1.ipar1[iarp -
1]) {
-#line 23186 ""
+#line 23180 ""
isarpshift = TRUE_;
/* Writing concatenation */
-#line 23187 ""
+#line 23181 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23187 ""
+#line 23181 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 23187 ""
+#line 23181 ""
i__2[1] = 8, a__1[1] = "loffset{";
-#line 23187 ""
+#line 23181 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23188 ""
+#line 23182 ""
s_wsfi(&io___1633);
-#line 23188 ""
+#line 23182 ""
do_fio(&c__1, (char *)&comarpshift_1.arpshift[iarps - 1], (ftnlen)
sizeof(real));
-#line 23188 ""
+#line 23182 ""
do_fio(&c__1, "}{", (ftnlen)2);
-#line 23188 ""
+#line 23182 ""
e_wsfi();
-#line 23189 ""
+#line 23183 ""
lnote = 14;
-#line 23190 ""
+#line 23184 ""
goto L4;
-#line 23191 ""
+#line 23185 ""
}
-#line 23192 ""
+#line 23186 ""
/* L3: */
-#line 23192 ""
+#line 23186 ""
}
-#line 23193 ""
+#line 23187 ""
isarpshift = FALSE_;
-#line 23194 ""
+#line 23188 ""
lnote = 0;
-#line 23195 ""
+#line 23189 ""
L4:
-#line 23196 ""
+#line 23190 ""
if (*iv == comarp_1.ivar1[iarp - 1]) {
/* Arp is in a single voice. */
/* Computing MIN */
-#line 23200 ""
+#line 23194 ""
i__1 = comarp_1.levar1[iarp - 1];
-#line 23200 ""
+#line 23194 ""
levbot = min(i__1,*nolev) - *ncm + 3;
-#line 23201 ""
+#line 23195 ""
invert = (i__1 = comarp_1.levar1[iarp - 1] - *nolev, abs(i__1)) + 1;
-#line 23202 ""
+#line 23196 ""
} else {
/* Arp covers >1 voice. Lower voice has to be the first, upper is current and */
/* is where the symbol will be written. */
/* Check whether ivx's ivar1(iarp) & iv are in same staff */
-#line 23208 ""
+#line 23202 ""
for (iiv = 1; iiv <= 24; ++iiv) {
-#line 23209 ""
+#line 23203 ""
if (commvl_1.ivmx[iiv - 1] == comarp_1.ivar1[iarp - 1] ||
commvl_1.nvmx[iiv - 1] == 2 && commvl_1.ivmx[iiv + 23] ==
comarp_1.ivar1[iarp - 1]) {
-#line 23211 ""
+#line 23205 ""
iivivx1 = iiv;
-#line 23212 ""
+#line 23206 ""
goto L6;
-#line 23213 ""
+#line 23207 ""
}
-#line 23214 ""
+#line 23208 ""
/* L5: */
-#line 23214 ""
+#line 23208 ""
}
-#line 23215 ""
+#line 23209 ""
s_wsle(&io___1639);
-#line 23215 ""
+#line 23209 ""
do_lio(&c__9, &c__1, "Screwup#1 in putarp", (ftnlen)19);
-#line 23215 ""
+#line 23209 ""
e_wsle();
-#line 23216 ""
+#line 23210 ""
s_stop("", (ftnlen)0);
-#line 23217 ""
+#line 23211 ""
L6:
-#line 23218 ""
+#line 23212 ""
for (iiv = 1; iiv <= 24; ++iiv) {
-#line 23219 ""
+#line 23213 ""
if (commvl_1.ivmx[iiv - 1] == *iv || commvl_1.nvmx[iiv - 1] == 2
&& commvl_1.ivmx[iiv + 23] == *iv) {
-#line 23219 ""
+#line 23213 ""
goto L8;
-#line 23219 ""
+#line 23213 ""
}
/* Found iv for both voices (iivivx1, iiv), done looking */
-#line 23224 ""
+#line 23218 ""
/* L7: */
-#line 23224 ""
+#line 23218 ""
}
-#line 23225 ""
+#line 23219 ""
s_wsle(&io___1640);
-#line 23225 ""
+#line 23219 ""
do_lio(&c__9, &c__1, "Screwup#2 in putarp", (ftnlen)19);
-#line 23225 ""
+#line 23219 ""
e_wsle();
-#line 23226 ""
+#line 23220 ""
s_stop("", (ftnlen)0);
-#line 23227 ""
+#line 23221 ""
L8:
-#line 23228 ""
+#line 23222 ""
if (iivivx1 == iiv) {
-#line 23229 ""
+#line 23223 ""
nstaffshift = 0;
-#line 23230 ""
+#line 23224 ""
} else {
-#line 23231 ""
+#line 23225 ""
r__1 = comarp_1.xinsnow * 2;
-#line 23231 ""
+#line 23225 ""
nstaffshift = -i_nint(&r__1);
-#line 23232 ""
+#line 23226 ""
}
/* levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) */
-#line 23234 ""
+#line 23228 ""
levbot = nstaffshift + 3 + comarp_1.levar1[iarp - 1] -
comarp_1.ncmar1[iarp - 1];
-#line 23235 ""
+#line 23229 ""
invert = -levbot + 4 + *nolev - *ncm;
-#line 23236 ""
+#line 23230 ""
}
/* isym will be (1,2) if invert is (even,odd). If even, raise .5\internote */
-#line 23240 ""
+#line 23234 ""
isym = invert % 2 + 1;
-#line 23241 ""
+#line 23235 ""
ilvert = (invert + 1) / 2;
-#line 23242 ""
+#line 23236 ""
if (levbot >= 0 && levbot <= 9) {
/* Single digit */
-#line 23246 ""
+#line 23240 ""
if (! isarpshift) {
/* Writing concatenation */
-#line 23247 ""
+#line 23241 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23247 ""
+#line 23241 ""
i__3[0] = 1, a__2[0] = ch__1;
-#line 23247 ""
+#line 23241 ""
i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
-#line 23247 ""
+#line 23241 ""
i__1 = levbot + 48;
-#line 23247 ""
+#line 23241 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 23247 ""
+#line 23241 ""
i__3[2] = 1, a__2[2] = ch__2;
-#line 23247 ""
+#line 23241 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 23248 ""
+#line 23242 ""
} else {
/* Writing concatenation */
-#line 23249 ""
+#line 23243 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 23249 ""
+#line 23243 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23249 ""
+#line 23243 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 23249 ""
+#line 23243 ""
i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
-#line 23249 ""
+#line 23243 ""
i__1 = levbot + 48;
-#line 23249 ""
+#line 23243 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 23249 ""
+#line 23243 ""
i__4[3] = 1, a__3[3] = ch__2;
-#line 23249 ""
+#line 23243 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 23251 ""
+#line 23245 ""
}
-#line 23252 ""
+#line 23246 ""
lnote += 10;
-#line 23253 ""
+#line 23247 ""
} else {
-#line 23254 ""
+#line 23248 ""
if (! isarpshift) {
/* Writing concatenation */
-#line 23255 ""
+#line 23249 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23255 ""
+#line 23249 ""
i__3[0] = 1, a__2[0] = ch__1;
-#line 23255 ""
+#line 23249 ""
i__3[1] = 8, a__2[1] = symq + (isym - 1 << 3);
-#line 23255 ""
+#line 23249 ""
i__3[2] = 1, a__2[2] = "{";
-#line 23255 ""
+#line 23249 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)79);
-#line 23256 ""
+#line 23250 ""
} else {
/* Writing concatenation */
-#line 23257 ""
+#line 23251 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 23257 ""
+#line 23251 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23257 ""
+#line 23251 ""
i__4[1] = 1, a__3[1] = ch__1;
-#line 23257 ""
+#line 23251 ""
i__4[2] = 8, a__3[2] = symq + (isym - 1 << 3);
-#line 23257 ""
+#line 23251 ""
i__4[3] = 1, a__3[3] = "{";
-#line 23257 ""
+#line 23251 ""
s_cat(notexq, a__3, i__4, &c__4, (ftnlen)79);
-#line 23258 ""
+#line 23252 ""
}
-#line 23259 ""
+#line 23253 ""
lnote += 10;
-#line 23260 ""
+#line 23254 ""
if (levbot >= -9) {
/* Need two spaces for number */
-#line 23264 ""
+#line 23258 ""
i__1 = lnote;
-#line 23264 ""
+#line 23258 ""
ici__1.icierr = 0;
-#line 23264 ""
+#line 23258 ""
ici__1.icirnum = 1;
-#line 23264 ""
+#line 23258 ""
ici__1.icirlen = lnote + 3 - i__1;
-#line 23264 ""
+#line 23258 ""
ici__1.iciunit = notexq + i__1;
-#line 23264 ""
+#line 23258 ""
ici__1.icifmt = "(i2,a1)";
-#line 23264 ""
+#line 23258 ""
s_wsfi(&ici__1);
-#line 23264 ""
+#line 23258 ""
do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
-#line 23264 ""
+#line 23258 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 23264 ""
+#line 23258 ""
e_wsfi();
-#line 23265 ""
+#line 23259 ""
lnote += 3;
-#line 23266 ""
+#line 23260 ""
} else {
-#line 23267 ""
+#line 23261 ""
i__1 = lnote;
-#line 23267 ""
+#line 23261 ""
ici__1.icierr = 0;
-#line 23267 ""
+#line 23261 ""
ici__1.icirnum = 1;
-#line 23267 ""
+#line 23261 ""
ici__1.icirlen = lnote + 4 - i__1;
-#line 23267 ""
+#line 23261 ""
ici__1.iciunit = notexq + i__1;
-#line 23267 ""
+#line 23261 ""
ici__1.icifmt = "(i3,a1)";
-#line 23267 ""
+#line 23261 ""
s_wsfi(&ici__1);
-#line 23267 ""
+#line 23261 ""
do_fio(&c__1, (char *)&levbot, (ftnlen)sizeof(integer));
-#line 23267 ""
+#line 23261 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 23267 ""
+#line 23261 ""
e_wsfi();
-#line 23268 ""
+#line 23262 ""
lnote += 4;
-#line 23269 ""
+#line 23263 ""
}
-#line 23270 ""
+#line 23264 ""
}
/* if (ilvert .le. 9) then */
/* call addstr(notexq(1:lnote)//chax(48+ilvert),lnote+1, */
@@ -57333,70 +57610,70 @@ L8:
/* write(notexq(lnote+1:lnote+4),'(a1,i2,a1)')'{',ilvert,'}' */
/* call addstr(notexq(1:lnote+4),lnote+4,soutq,lsout) */
/* end if */
-#line 23279 ""
+#line 23273 ""
if (ilvert > 9) {
-#line 23280 ""
+#line 23274 ""
i__1 = lnote;
-#line 23280 ""
+#line 23274 ""
ici__1.icierr = 0;
-#line 23280 ""
+#line 23274 ""
ici__1.icirnum = 1;
-#line 23280 ""
+#line 23274 ""
ici__1.icirlen = lnote + 4 - i__1;
-#line 23280 ""
+#line 23274 ""
ici__1.iciunit = notexq + i__1;
-#line 23280 ""
+#line 23274 ""
ici__1.icifmt = "(a1,i2,a1)";
-#line 23280 ""
+#line 23274 ""
s_wsfi(&ici__1);
-#line 23280 ""
+#line 23274 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 23280 ""
+#line 23274 ""
do_fio(&c__1, (char *)&ilvert, (ftnlen)sizeof(integer));
-#line 23280 ""
+#line 23274 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 23280 ""
+#line 23274 ""
e_wsfi();
-#line 23281 ""
+#line 23275 ""
lnote += 4;
-#line 23282 ""
+#line 23276 ""
} else {
/* Writing concatenation */
-#line 23283 ""
+#line 23277 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 23283 ""
+#line 23277 ""
i__1 = ilvert + 48;
-#line 23283 ""
+#line 23277 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 23283 ""
+#line 23277 ""
i__2[1] = 1, a__1[1] = ch__1;
-#line 23283 ""
+#line 23277 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23284 ""
+#line 23278 ""
++lnote;
-#line 23285 ""
+#line 23279 ""
}
-#line 23286 ""
+#line 23280 ""
if (isarpshift) {
/* Writing concatenation */
-#line 23287 ""
+#line 23281 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 23287 ""
+#line 23281 ""
i__2[1] = 1, a__1[1] = "}";
-#line 23287 ""
+#line 23281 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23288 ""
+#line 23282 ""
++lnote;
-#line 23289 ""
+#line 23283 ""
}
-#line 23290 ""
+#line 23284 ""
addstr_(notexq, &lnote, soutq, lsout, lnote, (ftnlen)80);
/* cancel out the stored time, to permit two arps at same time! */
-#line 23294 ""
+#line 23288 ""
comarp_1.tar[iarp - 1] = -1.f;
-#line 23295 ""
+#line 23289 ""
return 0;
} /* putarp_ */
@@ -57422,39 +57699,39 @@ L8:
static icilist io___1646 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 };
-#line 23300 ""
+#line 23294 ""
if (*elask >= 0.f) {
-#line 23301 ""
+#line 23295 ""
if (*elask < .995f) {
-#line 23302 ""
+#line 23296 ""
lp = 3;
-#line 23303 ""
+#line 23297 ""
} else if (*elask < 9.995f) {
-#line 23304 ""
+#line 23298 ""
lp = 4;
-#line 23305 ""
+#line 23299 ""
} else {
-#line 23306 ""
+#line 23300 ""
lp = 5;
-#line 23307 ""
+#line 23301 ""
}
-#line 23308 ""
+#line 23302 ""
s_wsfi(&io___1646);
-#line 23308 ""
+#line 23302 ""
do_fio(&c__1, "(a2,f", (ftnlen)5);
-#line 23308 ""
+#line 23302 ""
do_fio(&c__1, (char *)&lp, (ftnlen)sizeof(integer));
-#line 23308 ""
+#line 23302 ""
do_fio(&c__1, ".2)", (ftnlen)3);
-#line 23308 ""
+#line 23302 ""
e_wsfi();
-#line 23309 ""
+#line 23303 ""
} else {
-#line 23310 ""
+#line 23304 ""
lp = 5;
-#line 23311 ""
+#line 23305 ""
s_copy(fmtq, "(a2,f5.1)", (ftnlen)9, (ftnlen)9);
-#line 23312 ""
+#line 23306 ""
}
/* Overwrite as follows: ...xyz*ask *lmnop... -> */
@@ -57462,40 +57739,40 @@ L8:
/* ...xyz*ast{n.nn}*lmnop... */
/* ...xyz*ast{nn.nn}*lmnop... */
/* or for negative, ...xyz*ast{-nn.n}*lmnop... */
-#line 23319 ""
+#line 23313 ""
i__1 = *indxask + 8;
-#line 23319 ""
+#line 23313 ""
s_copy(tag, outq + i__1, (ftnlen)129, 129 - i__1);
-#line 23320 ""
+#line 23314 ""
i__1 = *indxask + 2;
-#line 23320 ""
+#line 23314 ""
ici__1.icierr = 0;
-#line 23320 ""
+#line 23314 ""
ici__1.icirnum = 1;
-#line 23320 ""
+#line 23314 ""
ici__1.icirlen = 129 - i__1;
-#line 23320 ""
+#line 23314 ""
ici__1.iciunit = outq + i__1;
-#line 23320 ""
+#line 23314 ""
ici__1.icifmt = fmtq;
-#line 23320 ""
+#line 23314 ""
s_wsfi(&ici__1);
-#line 23320 ""
+#line 23314 ""
do_fio(&c__1, "t{", (ftnlen)2);
-#line 23320 ""
+#line 23314 ""
do_fio(&c__1, (char *)&(*elask), (ftnlen)sizeof(real));
-#line 23320 ""
+#line 23314 ""
e_wsfi();
/* Writing concatenation */
-#line 23321 ""
+#line 23315 ""
i__2[0] = *indxask + 4 + lp, a__1[0] = outq;
-#line 23321 ""
+#line 23315 ""
i__2[1] = 1, a__1[1] = "}";
-#line 23321 ""
+#line 23315 ""
i__2[2] = 129, a__1[2] = tag;
-#line 23321 ""
+#line 23315 ""
s_cat(outq, a__1, i__2, &c__3, (ftnlen)129);
-#line 23322 ""
+#line 23316 ""
return 0;
} /* putast_ */
@@ -57523,247 +57800,247 @@ L8:
extern /* Subroutine */ int printl_(char *, ftnlen);
/* ivxip = ivx+16*ip */
-#line 23329 ""
+#line 23323 ""
i__1 = comcb_1.nbc;
-#line 23329 ""
+#line 23323 ""
for (ibc = 1; ibc <= i__1; ++ibc) {
/* if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 */
/* if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) */
/* * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 */
-#line 23333 ""
+#line 23327 ""
ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[
ibc - 1], &c__1, &c__28) << 4);
-#line 23334 ""
+#line 23328 ""
ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4);
-#line 23335 ""
+#line 23329 ""
if (*ivx == ivxbc && *ip == ipbc) {
-#line 23335 ""
+#line 23329 ""
goto L2;
-#line 23335 ""
+#line 23329 ""
}
-#line 23336 ""
+#line 23330 ""
/* L1: */
-#line 23336 ""
+#line 23330 ""
}
-#line 23337 ""
+#line 23331 ""
printl_("Error in putbc, Call Dr. Don", (ftnlen)28);
-#line 23338 ""
+#line 23332 ""
s_stop("", (ftnlen)0);
-#line 23339 ""
+#line 23333 ""
L2:
-#line 23340 ""
+#line 23334 ""
if (bit_test(comcb_1.ibcdata[ibc - 1],27)) {
-#line 23341 ""
+#line 23335 ""
*lnote = 8;
-#line 23342 ""
+#line 23336 ""
s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8);
-#line 23343 ""
+#line 23337 ""
} else {
-#line 23344 ""
+#line 23338 ""
*lnote = 9;
-#line 23345 ""
+#line 23339 ""
s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9);
-#line 23346 ""
+#line 23340 ""
}
-#line 23347 ""
+#line 23341 ""
ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13);
/* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */
-#line 23349 ""
+#line 23343 ""
if (ivshft > 0) {
-#line 23349 ""
+#line 23343 ""
ivshft += -32;
-#line 23349 ""
+#line 23343 ""
}
-#line 23350 ""
+#line 23344 ""
if (ivshft < 0 || ivshft > 9) {
/* Writing concatenation */
-#line 23351 ""
+#line 23345 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23351 ""
+#line 23345 ""
i__2[1] = 1, a__1[1] = "{";
-#line 23351 ""
+#line 23345 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23352 ""
+#line 23346 ""
++(*lnote);
-#line 23353 ""
+#line 23347 ""
if (ivshft < -9) {
-#line 23354 ""
+#line 23348 ""
i__1 = *lnote;
-#line 23354 ""
+#line 23348 ""
ici__1.icierr = 0;
-#line 23354 ""
+#line 23348 ""
ici__1.icirnum = 1;
-#line 23354 ""
+#line 23348 ""
ici__1.icirlen = *lnote + 3 - i__1;
-#line 23354 ""
+#line 23348 ""
ici__1.iciunit = notexq + i__1;
-#line 23354 ""
+#line 23348 ""
ici__1.icifmt = "(i3)";
-#line 23354 ""
+#line 23348 ""
s_wsfi(&ici__1);
-#line 23354 ""
+#line 23348 ""
do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
-#line 23354 ""
+#line 23348 ""
e_wsfi();
-#line 23355 ""
+#line 23349 ""
*lnote += 3;
-#line 23356 ""
+#line 23350 ""
} else {
-#line 23357 ""
+#line 23351 ""
i__1 = *lnote;
-#line 23357 ""
+#line 23351 ""
ici__1.icierr = 0;
-#line 23357 ""
+#line 23351 ""
ici__1.icirnum = 1;
-#line 23357 ""
+#line 23351 ""
ici__1.icirlen = *lnote + 2 - i__1;
-#line 23357 ""
+#line 23351 ""
ici__1.iciunit = notexq + i__1;
-#line 23357 ""
+#line 23351 ""
ici__1.icifmt = "(i2)";
-#line 23357 ""
+#line 23351 ""
s_wsfi(&ici__1);
-#line 23357 ""
+#line 23351 ""
do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer));
-#line 23357 ""
+#line 23351 ""
e_wsfi();
-#line 23358 ""
+#line 23352 ""
*lnote += 2;
-#line 23359 ""
+#line 23353 ""
}
/* Writing concatenation */
-#line 23360 ""
+#line 23354 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23360 ""
+#line 23354 ""
i__2[1] = 1, a__1[1] = "}";
-#line 23360 ""
+#line 23354 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23361 ""
+#line 23355 ""
++(*lnote);
-#line 23362 ""
+#line 23356 ""
} else {
/* Writing concatenation */
-#line 23363 ""
+#line 23357 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23363 ""
+#line 23357 ""
*(unsigned char *)&ch__1[0] = ivshft + 48;
-#line 23363 ""
+#line 23357 ""
i__2[1] = 1, a__1[1] = ch__1;
-#line 23363 ""
+#line 23357 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23364 ""
+#line 23358 ""
++(*lnote);
-#line 23365 ""
+#line 23359 ""
}
-#line 23366 ""
+#line 23360 ""
ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19);
-#line 23367 ""
+#line 23361 ""
if (ihshft == 0) {
/* Writing concatenation */
-#line 23368 ""
+#line 23362 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23368 ""
+#line 23362 ""
i__2[1] = 1, a__1[1] = "0";
-#line 23368 ""
+#line 23362 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23369 ""
+#line 23363 ""
++(*lnote);
-#line 23370 ""
+#line 23364 ""
} else {
-#line 23371 ""
+#line 23365 ""
hshft = (ihshft - 128) * .1f;
/* -12.8<hshft<12.8 */
/* Writing concatenation */
-#line 23375 ""
+#line 23369 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23375 ""
+#line 23369 ""
i__2[1] = 1, a__1[1] = "{";
-#line 23375 ""
+#line 23369 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23376 ""
+#line 23370 ""
++(*lnote);
-#line 23377 ""
+#line 23371 ""
if (hshft < -9.95f) {
-#line 23378 ""
+#line 23372 ""
i__1 = *lnote;
-#line 23378 ""
+#line 23372 ""
ici__1.icierr = 0;
-#line 23378 ""
+#line 23372 ""
ici__1.icirnum = 1;
-#line 23378 ""
+#line 23372 ""
ici__1.icirlen = *lnote + 5 - i__1;
-#line 23378 ""
+#line 23372 ""
ici__1.iciunit = notexq + i__1;
-#line 23378 ""
+#line 23372 ""
ici__1.icifmt = "(f5.1)";
-#line 23378 ""
+#line 23372 ""
s_wsfi(&ici__1);
-#line 23378 ""
+#line 23372 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
-#line 23378 ""
+#line 23372 ""
e_wsfi();
-#line 23379 ""
+#line 23373 ""
*lnote += 5;
-#line 23380 ""
+#line 23374 ""
} else if (hshft < -.05f || hshft > 9.95f) {
-#line 23381 ""
+#line 23375 ""
i__1 = *lnote;
-#line 23381 ""
+#line 23375 ""
ici__1.icierr = 0;
-#line 23381 ""
+#line 23375 ""
ici__1.icirnum = 1;
-#line 23381 ""
+#line 23375 ""
ici__1.icirlen = *lnote + 4 - i__1;
-#line 23381 ""
+#line 23375 ""
ici__1.iciunit = notexq + i__1;
-#line 23381 ""
+#line 23375 ""
ici__1.icifmt = "(f4.1)";
-#line 23381 ""
+#line 23375 ""
s_wsfi(&ici__1);
-#line 23381 ""
+#line 23375 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
-#line 23381 ""
+#line 23375 ""
e_wsfi();
-#line 23382 ""
+#line 23376 ""
*lnote += 4;
-#line 23383 ""
+#line 23377 ""
} else {
-#line 23384 ""
+#line 23378 ""
i__1 = *lnote;
-#line 23384 ""
+#line 23378 ""
ici__1.icierr = 0;
-#line 23384 ""
+#line 23378 ""
ici__1.icirnum = 1;
-#line 23384 ""
+#line 23378 ""
ici__1.icirlen = *lnote + 3 - i__1;
-#line 23384 ""
+#line 23378 ""
ici__1.iciunit = notexq + i__1;
-#line 23384 ""
+#line 23378 ""
ici__1.icifmt = "(f3.1)";
-#line 23384 ""
+#line 23378 ""
s_wsfi(&ici__1);
-#line 23384 ""
+#line 23378 ""
do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real));
-#line 23384 ""
+#line 23378 ""
e_wsfi();
-#line 23385 ""
+#line 23379 ""
*lnote += 3;
-#line 23386 ""
+#line 23380 ""
}
/* Writing concatenation */
-#line 23387 ""
+#line 23381 ""
i__2[0] = *lnote, a__1[0] = notexq;
-#line 23387 ""
+#line 23381 ""
i__2[1] = 1, a__1[1] = "}";
-#line 23387 ""
+#line 23381 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 23388 ""
+#line 23382 ""
++(*lnote);
-#line 23389 ""
+#line 23383 ""
}
-#line 23390 ""
+#line 23384 ""
return 0;
} /* putcb_ */
@@ -57813,178 +58090,178 @@ L2:
static icilist io___1678 = { 0, notexq+5, 0, "(f3.2)", 3, 1 };
-#line 23402 ""
+#line 23396 ""
if (*ivx == 1) {
-#line 23403 ""
+#line 23397 ""
s_copy(figutq, "Figu", (ftnlen)4, (ftnlen)4);
-#line 23404 ""
+#line 23398 ""
s_copy(conttq, "Cont", (ftnlen)4, (ftnlen)4);
-#line 23405 ""
+#line 23399 ""
} else {
-#line 23406 ""
+#line 23400 ""
s_copy(figutq, "Figt", (ftnlen)4, (ftnlen)4);
-#line 23407 ""
+#line 23401 ""
s_copy(conttq, "Cott", (ftnlen)4, (ftnlen)4);
-#line 23408 ""
+#line 23402 ""
}
-#line 23409 ""
+#line 23403 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23409 ""
+#line 23403 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 23410 ""
+#line 23404 ""
if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] != 0) {
/* Alter figdrop */
/* Writing concatenation */
-#line 23414 ""
+#line 23408 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23414 ""
+#line 23408 ""
i__1[1] = 6, a__1[1] = "global";
-#line 23414 ""
+#line 23408 ""
i__1[2] = 1, a__1[2] = sq;
-#line 23414 ""
+#line 23408 ""
i__1[3] = 7, a__1[3] = "advance";
-#line 23414 ""
+#line 23408 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23414 ""
+#line 23408 ""
i__1[5] = 7, a__1[5] = "figdrop";
-#line 23414 ""
+#line 23408 ""
s_cat(notexq, a__1, i__1, &c__6, (ftnlen)80);
-#line 23415 ""
+#line 23409 ""
lnote = 23;
-#line 23416 ""
+#line 23410 ""
if (comfig_2.ivvfig[*ivx + (*ifig << 1) - 3] < 0) {
/* Writing concatenation */
-#line 23417 ""
+#line 23411 ""
i__2[0] = lnote, a__2[0] = notexq;
-#line 23417 ""
+#line 23411 ""
i__2[1] = 1, a__2[1] = "-";
-#line 23417 ""
+#line 23411 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
-#line 23418 ""
+#line 23412 ""
++lnote;
-#line 23419 ""
+#line 23413 ""
}
/* Writing concatenation */
-#line 23420 ""
+#line 23414 ""
i__2[0] = lnote, a__2[0] = notexq;
-#line 23420 ""
+#line 23414 ""
*(unsigned char *)&ch__1[0] = (i__3 = comfig_2.ivvfig[*ivx + (*ifig <<
1) - 3], abs(i__3)) + 48;
-#line 23420 ""
+#line 23414 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 23420 ""
+#line 23414 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
-#line 23421 ""
+#line 23415 ""
++lnote;
-#line 23422 ""
+#line 23416 ""
addstr_(notexq, &lnote, soutq, lsout, (ftnlen)80, (ftnlen)80);
-#line 23423 ""
+#line 23417 ""
}
-#line 23424 ""
+#line 23418 ""
if (dabs(*offnsk) > 1e-4f) {
/* Write offset for floating figure, to two decimal places */
/* Writing concatenation */
-#line 23428 ""
+#line 23422 ""
i__2[0] = 1, a__2[0] = sq;
-#line 23428 ""
+#line 23422 ""
i__2[1] = 4, a__2[1] = "off{";
-#line 23428 ""
+#line 23422 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
-#line 23429 ""
+#line 23423 ""
if (-(*offnsk) < -9.995f) {
-#line 23430 ""
+#line 23424 ""
s_wsfi(&io___1659);
-#line 23430 ""
+#line 23424 ""
r__1 = -(*offnsk);
-#line 23430 ""
+#line 23424 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 23430 ""
+#line 23424 ""
e_wsfi();
-#line 23431 ""
+#line 23425 ""
lnote = 11;
-#line 23432 ""
+#line 23426 ""
} else if (-(*offnsk) < -.995f || -(*offnsk) > 9.995f) {
-#line 23433 ""
+#line 23427 ""
s_wsfi(&io___1660);
-#line 23433 ""
+#line 23427 ""
r__1 = -(*offnsk);
-#line 23433 ""
+#line 23427 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 23433 ""
+#line 23427 ""
e_wsfi();
-#line 23434 ""
+#line 23428 ""
lnote = 10;
-#line 23435 ""
+#line 23429 ""
} else if (-(*offnsk) < -1e-4f || -(*offnsk) > .995f) {
-#line 23436 ""
+#line 23430 ""
s_wsfi(&io___1661);
-#line 23436 ""
+#line 23430 ""
r__1 = -(*offnsk);
-#line 23436 ""
+#line 23430 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 23436 ""
+#line 23430 ""
e_wsfi();
-#line 23437 ""
+#line 23431 ""
lnote = 9;
-#line 23438 ""
+#line 23432 ""
} else {
-#line 23439 ""
+#line 23433 ""
s_wsfi(&io___1662);
-#line 23439 ""
+#line 23433 ""
r__1 = -(*offnsk);
-#line 23439 ""
+#line 23433 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
-#line 23439 ""
+#line 23433 ""
e_wsfi();
-#line 23440 ""
+#line 23434 ""
lnote = 8;
-#line 23441 ""
+#line 23435 ""
}
/* Writing concatenation */
-#line 23442 ""
+#line 23436 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 23442 ""
+#line 23436 ""
i__4[1] = 1, a__3[1] = sq;
-#line 23442 ""
+#line 23436 ""
i__4[2] = 9, a__3[2] = "noteskip}";
-#line 23442 ""
+#line 23436 ""
s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80);
-#line 23443 ""
+#line 23437 ""
i__3 = lnote + 10;
-#line 23443 ""
+#line 23437 ""
addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
-#line 23444 ""
+#line 23438 ""
}
-#line 23445 ""
+#line 23439 ""
s_copy(figq, comfig_2.figqq + (*ivx + (*ifig << 1) - 3) * 10, (ftnlen)10,
(ftnlen)10);
-#line 23446 ""
+#line 23440 ""
ic = 1;
/* nof = 0 */
/* nofa = -1 */
-#line 23449 ""
+#line 23443 ""
nof = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3];
-#line 23450 ""
+#line 23444 ""
nofa = -comfig_2.ivupfig[*ivx + (*ifig << 1) - 3] - 1;
/* Beginning of manual loop */
-#line 23454 ""
+#line 23448 ""
L1:
-#line 23454 ""
+#line 23448 ""
*(unsigned char *)ch1q = *(unsigned char *)&figq[ic - 1];
/* Exit when first blank is encountered */
-#line 23458 ""
+#line 23452 ""
if (*(unsigned char *)ch1q == ' ') {
-#line 23458 ""
+#line 23452 ""
goto L2;
-#line 23458 ""
+#line 23452 ""
}
/* Starting a level. Set up vertical offset. */
@@ -58005,387 +58282,387 @@ L1:
/* lnofa = 2 */
/* nofaq = '1'//chax(nofa+38) */
/* end if */
-#line 23478 ""
+#line 23472 ""
istring_(&nof, nofq, &lnof, (ftnlen)5);
-#line 23479 ""
+#line 23473 ""
istring_(&nofa, nofaq, &lnofa, (ftnlen)5);
-#line 23480 ""
+#line 23474 ""
if (*(unsigned char *)ch1q == '0') {
/* Continuation figure. Next number is length (in noteskips). The number will */
/* end at the first blank or char that is not digit or decimal point. If */
/* colon, it is a separator and must be skipped */
-#line 23486 ""
+#line 23480 ""
icnum = ic + 1;
-#line 23487 ""
+#line 23481 ""
L3:
-#line 23488 ""
+#line 23482 ""
++ic;
-#line 23489 ""
+#line 23483 ""
if (i_indx("0123456789.", figq + (ic - 1), (ftnlen)11, (ftnlen)1) > 0)
{
-#line 23489 ""
+#line 23483 ""
goto L3;
-#line 23489 ""
+#line 23483 ""
}
-#line 23490 ""
+#line 23484 ""
lnum = ic - icnum;
/* Writing concatenation */
-#line 23491 ""
+#line 23485 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23491 ""
+#line 23485 ""
i__1[1] = 4, a__1[1] = conttq;
-#line 23491 ""
+#line 23485 ""
i__1[2] = lnof, a__1[2] = nofq;
-#line 23491 ""
+#line 23485 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23491 ""
+#line 23485 ""
i__1[4] = ic - 1 - (icnum - 1), a__1[4] = figq + (icnum - 1);
-#line 23491 ""
+#line 23485 ""
i__1[5] = 1, a__1[5] = "}";
-#line 23491 ""
+#line 23485 ""
s_cat(ch__2, a__1, i__1, &c__6, (ftnlen)22);
-#line 23491 ""
+#line 23485 ""
i__3 = ic + 7 - icnum + lnof;
-#line 23491 ""
+#line 23485 ""
addstr_(ch__2, &i__3, soutq, lsout, lnof + 6 + (ic - 1 - (icnum - 1))
+ 1, (ftnlen)80);
-#line 23493 ""
+#line 23487 ""
if (*(unsigned char *)&figq[ic - 1] != ':') {
-#line 23493 ""
+#line 23487 ""
--ic;
-#line 23493 ""
+#line 23487 ""
}
-#line 23494 ""
+#line 23488 ""
} else if (*(unsigned char *)ch1q == '#' || *(unsigned char *)ch1q == '-'
|| *(unsigned char *)ch1q == 'n') {
-#line 23495 ""
+#line 23489 ""
++ic;
-#line 23496 ""
+#line 23490 ""
*(unsigned char *)ch2q = *(unsigned char *)&figq[ic - 1];
-#line 23497 ""
+#line 23491 ""
if (*(unsigned char *)ch2q == ' ') {
/* Figure is a stand-alone accidental, so must be centered */
-#line 23501 ""
+#line 23495 ""
if (*(unsigned char *)ch1q == '#') {
/* Writing concatenation */
-#line 23502 ""
+#line 23496 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23502 ""
+#line 23496 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23502 ""
+#line 23496 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23502 ""
+#line 23496 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23502 ""
+#line 23496 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23502 ""
+#line 23496 ""
i__1[5] = 9, a__1[5] = "sharpfig}";
-#line 23502 ""
+#line 23496 ""
s_cat(ch__3, a__1, i__1, &c__6, (ftnlen)21);
-#line 23502 ""
+#line 23496 ""
i__3 = lnofa + 16;
-#line 23502 ""
+#line 23496 ""
addstr_(ch__3, &i__3, soutq, lsout, lnofa + 16, (ftnlen)80);
-#line 23504 ""
+#line 23498 ""
} else if (*(unsigned char *)ch1q == '-') {
/* Writing concatenation */
-#line 23505 ""
+#line 23499 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23505 ""
+#line 23499 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23505 ""
+#line 23499 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23505 ""
+#line 23499 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23505 ""
+#line 23499 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23505 ""
+#line 23499 ""
i__1[5] = 8, a__1[5] = "flatfig}";
-#line 23505 ""
+#line 23499 ""
s_cat(ch__4, a__1, i__1, &c__6, (ftnlen)20);
-#line 23505 ""
+#line 23499 ""
i__3 = lnofa + 15;
-#line 23505 ""
+#line 23499 ""
addstr_(ch__4, &i__3, soutq, lsout, lnofa + 15, (ftnlen)80);
-#line 23507 ""
+#line 23501 ""
} else if (*(unsigned char *)ch1q == 'n') {
/* Writing concatenation */
-#line 23508 ""
+#line 23502 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23508 ""
+#line 23502 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23508 ""
+#line 23502 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23508 ""
+#line 23502 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23508 ""
+#line 23502 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23508 ""
+#line 23502 ""
i__1[5] = 7, a__1[5] = "natfig}";
-#line 23508 ""
+#line 23502 ""
s_cat(ch__5, a__1, i__1, &c__6, (ftnlen)19);
-#line 23508 ""
+#line 23502 ""
i__3 = lnofa + 14;
-#line 23508 ""
+#line 23502 ""
addstr_(ch__5, &i__3, soutq, lsout, lnofa + 14, (ftnlen)80);
-#line 23510 ""
+#line 23504 ""
}
-#line 23511 ""
+#line 23505 ""
goto L2;
-#line 23512 ""
+#line 23506 ""
} else {
/* Figure is an accidental followed by a number */
/* First put the accidental (offset to the left) */
-#line 23517 ""
+#line 23511 ""
if (*(unsigned char *)ch1q == '#') {
/* Writing concatenation */
-#line 23518 ""
+#line 23512 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23518 ""
+#line 23512 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23518 ""
+#line 23512 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23518 ""
+#line 23512 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23518 ""
+#line 23512 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23518 ""
+#line 23512 ""
i__1[5] = 6, a__1[5] = "fsmsh}";
-#line 23518 ""
+#line 23512 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
-#line 23518 ""
+#line 23512 ""
i__3 = lnofa + 13;
-#line 23518 ""
+#line 23512 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
-#line 23521 ""
+#line 23515 ""
} else if (*(unsigned char *)ch1q == '-') {
/* Writing concatenation */
-#line 23522 ""
+#line 23516 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23522 ""
+#line 23516 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23522 ""
+#line 23516 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23522 ""
+#line 23516 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23522 ""
+#line 23516 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23522 ""
+#line 23516 ""
i__1[5] = 6, a__1[5] = "fsmfl}";
-#line 23522 ""
+#line 23516 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
-#line 23522 ""
+#line 23516 ""
i__3 = lnofa + 13;
-#line 23522 ""
+#line 23516 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
-#line 23525 ""
+#line 23519 ""
} else if (*(unsigned char *)ch1q == 'n') {
/* Writing concatenation */
-#line 23526 ""
+#line 23520 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23526 ""
+#line 23520 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23526 ""
+#line 23520 ""
i__1[2] = lnofa, a__1[2] = nofaq;
-#line 23526 ""
+#line 23520 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23526 ""
+#line 23520 ""
i__1[4] = 1, a__1[4] = sq;
-#line 23526 ""
+#line 23520 ""
i__1[5] = 6, a__1[5] = "fsmna}";
-#line 23526 ""
+#line 23520 ""
s_cat(ch__6, a__1, i__1, &c__6, (ftnlen)18);
-#line 23526 ""
+#line 23520 ""
i__3 = lnofa + 13;
-#line 23526 ""
+#line 23520 ""
addstr_(ch__6, &i__3, soutq, lsout, lnofa + 13, (ftnlen)80);
-#line 23529 ""
+#line 23523 ""
}
/* Now put the number */
/* Writing concatenation */
-#line 23533 ""
+#line 23527 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23533 ""
+#line 23527 ""
i__1[1] = 4, a__1[1] = figutq;
-#line 23533 ""
+#line 23527 ""
i__1[2] = lnof, a__1[2] = nofq;
-#line 23533 ""
+#line 23527 ""
i__1[3] = 1, a__1[3] = "{";
-#line 23533 ""
+#line 23527 ""
i__1[4] = 1, a__1[4] = ch2q;
-#line 23533 ""
+#line 23527 ""
i__1[5] = 1, a__1[5] = "}";
-#line 23533 ""
+#line 23527 ""
s_cat(ch__7, a__1, i__1, &c__6, (ftnlen)13);
-#line 23533 ""
+#line 23527 ""
i__3 = lnof + 8;
-#line 23533 ""
+#line 23527 ""
addstr_(ch__7, &i__3, soutq, lsout, lnof + 8, (ftnlen)80);
-#line 23535 ""
+#line 23529 ""
}
-#line 23536 ""
+#line 23530 ""
} else if (*(unsigned char *)ch1q == '_') {
/* Placeholder only (for lowering a figure). Don't do anything! */
-#line 23541 ""
+#line 23535 ""
} else {
/* Figure is a single number, maybe with s after */
/* Writing concatenation */
-#line 23545 ""
+#line 23539 ""
i__5[0] = 1, a__4[0] = sq;
-#line 23545 ""
+#line 23539 ""
i__5[1] = 4, a__4[1] = figutq;
-#line 23545 ""
+#line 23539 ""
i__5[2] = lnof, a__4[2] = nofq;
-#line 23545 ""
+#line 23539 ""
i__5[3] = 1, a__4[3] = "{";
-#line 23545 ""
+#line 23539 ""
s_cat(ch__8, a__4, i__5, &c__4, (ftnlen)11);
-#line 23545 ""
+#line 23539 ""
i__3 = lnof + 6;
-#line 23545 ""
+#line 23539 ""
addstr_(ch__8, &i__3, soutq, lsout, lnof + 6, (ftnlen)80);
-#line 23547 ""
+#line 23541 ""
i__3 = ic;
-#line 23547 ""
+#line 23541 ""
s_copy(ch2q, figq + i__3, (ftnlen)1, ic + 1 - i__3);
-#line 23548 ""
+#line 23542 ""
if (*(unsigned char *)ch2q == 's') {
/* Use a special character. Insert font call */
-#line 23552 ""
+#line 23546 ""
++ic;
/* Writing concatenation */
-#line 23553 ""
+#line 23547 ""
i__2[0] = 1, a__2[0] = sq;
-#line 23553 ""
+#line 23547 ""
i__2[1] = 7, a__2[1] = "ligfont";
-#line 23553 ""
+#line 23547 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 23553 ""
+#line 23547 ""
addstr_(ch__9, &c__8, soutq, lsout, (ftnlen)8, (ftnlen)80);
-#line 23554 ""
+#line 23548 ""
}
/* Writing concatenation */
-#line 23555 ""
+#line 23549 ""
i__2[0] = 1, a__2[0] = ch1q;
-#line 23555 ""
+#line 23549 ""
i__2[1] = 1, a__2[1] = "}";
-#line 23555 ""
+#line 23549 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)2);
-#line 23555 ""
+#line 23549 ""
addstr_(ch__10, &c__2, soutq, lsout, (ftnlen)2, (ftnlen)80);
/* call addstr(sq//Figutq//nofq(1:lnof)//'{'//ch1q//'}', */
/* * 8+lnof,soutq,lsout) */
-#line 23558 ""
+#line 23552 ""
}
-#line 23559 ""
+#line 23553 ""
if (ic >= 10) {
-#line 23559 ""
+#line 23553 ""
goto L2;
-#line 23559 ""
+#line 23553 ""
}
-#line 23560 ""
+#line 23554 ""
++ic;
-#line 23561 ""
+#line 23555 ""
nof += 4;
-#line 23562 ""
+#line 23556 ""
nofa += 4;
-#line 23563 ""
+#line 23557 ""
goto L1;
-#line 23564 ""
+#line 23558 ""
L2:
-#line 23565 ""
+#line 23559 ""
if (dabs(*offnsk) > 1e-4f) {
/* Writing concatenation */
-#line 23566 ""
+#line 23560 ""
i__2[0] = 1, a__2[0] = sq;
-#line 23566 ""
+#line 23560 ""
i__2[1] = 4, a__2[1] = "off{";
-#line 23566 ""
+#line 23560 ""
s_cat(notexq, a__2, i__2, &c__2, (ftnlen)80);
-#line 23567 ""
+#line 23561 ""
if (*offnsk < -9.995f) {
-#line 23568 ""
+#line 23562 ""
s_wsfi(&io___1675);
-#line 23568 ""
+#line 23562 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
-#line 23568 ""
+#line 23562 ""
e_wsfi();
-#line 23569 ""
+#line 23563 ""
lnote = 11;
-#line 23570 ""
+#line 23564 ""
} else if (*offnsk < -.995f || *offnsk > 9.995f) {
-#line 23571 ""
+#line 23565 ""
s_wsfi(&io___1676);
-#line 23571 ""
+#line 23565 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
-#line 23571 ""
+#line 23565 ""
e_wsfi();
-#line 23572 ""
+#line 23566 ""
lnote = 10;
-#line 23573 ""
+#line 23567 ""
} else if (*offnsk < -1e-4f || *offnsk > .995f) {
-#line 23574 ""
+#line 23568 ""
s_wsfi(&io___1677);
-#line 23574 ""
+#line 23568 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
-#line 23574 ""
+#line 23568 ""
e_wsfi();
-#line 23575 ""
+#line 23569 ""
lnote = 9;
-#line 23576 ""
+#line 23570 ""
} else {
-#line 23577 ""
+#line 23571 ""
s_wsfi(&io___1678);
-#line 23577 ""
+#line 23571 ""
do_fio(&c__1, (char *)&(*offnsk), (ftnlen)sizeof(real));
-#line 23577 ""
+#line 23571 ""
e_wsfi();
-#line 23578 ""
+#line 23572 ""
lnote = 8;
-#line 23579 ""
+#line 23573 ""
}
/* Writing concatenation */
-#line 23580 ""
+#line 23574 ""
i__4[0] = lnote, a__3[0] = notexq;
-#line 23580 ""
+#line 23574 ""
i__4[1] = 1, a__3[1] = sq;
-#line 23580 ""
+#line 23574 ""
i__4[2] = 9, a__3[2] = "noteskip}";
-#line 23580 ""
+#line 23574 ""
s_cat(notexq, a__3, i__4, &c__3, (ftnlen)80);
-#line 23581 ""
+#line 23575 ""
i__3 = lnote + 10;
-#line 23581 ""
+#line 23575 ""
addstr_(notexq, &i__3, soutq, lsout, (ftnlen)80, (ftnlen)80);
-#line 23582 ""
+#line 23576 ""
}
-#line 23583 ""
+#line 23577 ""
if (*ifig < comfig_2.nfigs[*ivx - 1]) {
-#line 23584 ""
+#line 23578 ""
++(*ifig);
-#line 23585 ""
+#line 23579 ""
} else {
-#line 23586 ""
+#line 23580 ""
comfig_2.nfigs[*ivx - 1] = 0;
-#line 23587 ""
+#line 23581 ""
*figcheck = FALSE_;
-#line 23588 ""
+#line 23582 ""
}
-#line 23589 ""
+#line 23583 ""
return 0;
} /* putfig_ */
@@ -58438,95 +58715,95 @@ L2:
/* notcrd = .true. if ornament is on main note. */
/* nolevm is level of main note (for chords) */
-#line 23609 ""
+#line 23603 ""
/* Parameter adjustments */
-#line 23609 ""
+#line 23603 ""
ihornb -= 25;
-#line 23609 ""
+#line 23603 ""
ulq -= 25;
-#line 23609 ""
+#line 23603 ""
--nornb;
-#line 23609 ""
+#line 23603 ""
-#line 23609 ""
+#line 23603 ""
/* Function Body */
-#line 23609 ""
+#line 23603 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23609 ""
+#line 23603 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 23610 ""
+#line 23604 ""
*lout = 0;
-#line 23611 ""
+#line 23605 ""
usehornb = FALSE_;
-#line 23612 ""
+#line 23606 ""
if (*nodur < 64) {
-#line 23613 ""
+#line 23607 ""
stemlen = *stemlin;
-#line 23614 ""
+#line 23608 ""
} else {
-#line 23615 ""
+#line 23609 ""
stemlen = 0.f;
-#line 23616 ""
+#line 23610 ""
}
/* Get up-downness. ulpzq is opposite from stem direction for both beams and */
/* non beams. Can use in name of ornament [ . or _ ] */
-#line 23621 ""
+#line 23615 ""
if (*beamon) {
-#line 23622 ""
+#line 23616 ""
if (*(unsigned char *)&ulq[*ivx + *ibmcnt * 24] == 'u') {
-#line 23623 ""
+#line 23617 ""
*(unsigned char *)ulpzq = 'l';
-#line 23624 ""
+#line 23618 ""
} else {
-#line 23625 ""
+#line 23619 ""
*(unsigned char *)ulpzq = 'u';
-#line 23626 ""
+#line 23620 ""
}
-#line 23627 ""
+#line 23621 ""
} else {
-#line 23628 ""
+#line 23622 ""
udqq_(ch__1, (ftnlen)1, nolevm, ncm, islur, nvmx, ivx, nv);
-#line 23628 ""
+#line 23622 ""
if (*(unsigned char *)&ch__1[0] == 'l') {
-#line 23629 ""
+#line 23623 ""
*(unsigned char *)ulpzq = 'u';
-#line 23630 ""
+#line 23624 ""
} else {
-#line 23631 ""
+#line 23625 ""
*(unsigned char *)ulpzq = 'l';
-#line 23632 ""
+#line 23626 ""
}
-#line 23633 ""
+#line 23627 ""
}
/* To enable >1 ornament on a note, next line is top of manual loop. */
-#line 23637 ""
+#line 23631 ""
L2:
/* c Bit # of last ornament (last of bits 0-21) */
/* c Bit # of last ornament (last of bits 0-24) */
/* Bit # of last ornament (last of bits 0-24,29-30) */
-#line 23642 ""
+#line 23636 ""
if (bit_test(*iornq,29)) {
-#line 23643 ""
+#line 23637 ""
ibit = 29;
-#line 23644 ""
+#line 23638 ""
} else if (bit_test(*iornq,30)) {
-#line 23645 ""
+#line 23639 ""
ibit = 30;
-#line 23646 ""
+#line 23640 ""
} else {
-#line 23647 ""
+#line 23641 ""
i__1 = *iornq & 4194303;
-#line 23647 ""
+#line 23641 ""
ibit = log2_(&i__1);
/* ibit = log2(iand(iornq,33554431)) */
-#line 23649 ""
+#line 23643 ""
}
-#line 23650 ""
+#line 23644 ""
iornt = pow_ii(&c__2, &ibit);
/* Begin routine to set height. Bits 0-13: (stmgx+Tupf._) */
@@ -58536,568 +58813,568 @@ L2:
/* Do not use beam height for . or _ */
-#line 23659 ""
+#line 23653 ""
if (bit_test(*iornq,22) && (iornt & 6144) == 0) {
/* Height is set by special beam stuff. */
/* Do not leave ihorn set, do separately for every ornament */
-#line 23664 ""
+#line 23658 ""
ihorn = ihornb[*ivx + nornb[*ivx] * 24];
-#line 23665 ""
+#line 23659 ""
if (*(unsigned char *)ulpzq == 'u') {
-#line 23665 ""
+#line 23659 ""
ihorn += -2;
-#line 23665 ""
+#line 23659 ""
}
/* Following flag tells whether to increment nornb when exiting the subroutine. */
-#line 23669 ""
+#line 23663 ""
usehornb = TRUE_;
-#line 23670 ""
+#line 23664 ""
} else if (ibit == 14) {
/* Down fermata. Don't worry about upper chord notes. */
-#line 23674 ""
+#line 23668 ""
if (*(unsigned char *)ulpzq == 'l') {
/* Computing MIN */
-#line 23675 ""
+#line 23669 ""
i__1 = *nolev, i__2 = *ncm - 3;
-#line 23675 ""
+#line 23669 ""
ihorn = min(i__1,i__2);
-#line 23676 ""
+#line 23670 ""
} else {
/* Computing MIN */
-#line 23677 ""
+#line 23671 ""
r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
-#line 23677 ""
+#line 23671 ""
ihorn = dmin(r__1,r__2);
-#line 23678 ""
+#line 23672 ""
}
-#line 23679 ""
+#line 23673 ""
} else if (bit_test(iornt,13) || bit_test(iornt,0)) {
/* ( or ) */
-#line 23683 ""
+#line 23677 ""
ihorn = *nolev;
-#line 23684 ""
+#line 23678 ""
} else if ((iornt & 6144) > 0) {
/* c Staccato . or tenuto _ , but not special beam stuff. Need up-down info */
/* NOTE: removed .&_ from special beam treatment. */
/* Staccato . or tenuto _ Need up-down info */
-#line 23690 ""
+#line 23684 ""
if (! (*iscrd) || comtrill_1.maxlev != *nolev && *(unsigned char *)
ulpzq == 'l' || comtrill_1.minlev != *nolev && *(unsigned
char *)ulpzq == 'u') {
-#line 23692 ""
+#line 23686 ""
ihorn = *nolev;
-#line 23693 ""
+#line 23687 ""
} else if (comtrill_1.maxlev == *nolev) {
-#line 23694 ""
+#line 23688 ""
*(unsigned char *)ulpzq = 'u';
/* Computing MAX */
-#line 23695 ""
+#line 23689 ""
r__1 = *nolev + stemlen, r__2 = *ncm + 3.f;
-#line 23695 ""
+#line 23689 ""
ihorn = dmax(r__1,r__2);
-#line 23696 ""
+#line 23690 ""
} else {
-#line 23697 ""
+#line 23691 ""
*(unsigned char *)ulpzq = 'l';
/* Computing MIN */
-#line 23698 ""
+#line 23692 ""
r__1 = *nolev - stemlen, r__2 = *ncm - 3.f;
-#line 23698 ""
+#line 23692 ""
ihorn = dmin(r__1,r__2);
-#line 23699 ""
+#line 23693 ""
}
-#line 23700 ""
+#line 23694 ""
} else if (*iscrd && *nolev == comtrill_1.minlev) {
-#line 23701 ""
+#line 23695 ""
if (*(unsigned char *)ulpzq == 'l') {
/* Computing MIN */
-#line 23702 ""
+#line 23696 ""
i__1 = *nolev - 3, i__2 = *ncm - 6;
-#line 23702 ""
+#line 23696 ""
ihorn = min(i__1,i__2);
-#line 23703 ""
+#line 23697 ""
} else {
/* Computing MIN */
-#line 23704 ""
+#line 23698 ""
i__1 = *nolev - i_nint(&stemlen) - 3, i__2 = *ncm - 6;
-#line 23704 ""
+#line 23698 ""
ihorn = min(i__1,i__2);
-#line 23705 ""
+#line 23699 ""
}
-#line 23706 ""
+#line 23700 ""
} else if (ibit == 10 && *nolev > 90) {
/* Special treatment for fermata on a shifted rest */
-#line 23710 ""
+#line 23704 ""
ihorn = *ncm + 5;
-#line 23711 ""
+#line 23705 ""
} else if (*(unsigned char *)ulpzq == 'l') {
/* (iscrd and nolev=maxlev) or (.not.iscrd) */
/* Computing MAX */
-#line 23715 ""
+#line 23709 ""
r__1 = *nolev + stemlen + 2, r__2 = *ncm + 5.f;
-#line 23715 ""
+#line 23709 ""
ihorn = dmax(r__1,r__2);
-#line 23716 ""
+#line 23710 ""
} else if (ibit == 29 || ibit == 30) {
/* coda or new segno, no height tweak */
-#line 23720 ""
+#line 23714 ""
ihorn = *ncm + 5;
-#line 23721 ""
+#line 23715 ""
} else {
/* Computing MAX */
-#line 23722 ""
+#line 23716 ""
i__1 = *nolev + 2, i__2 = *ncm + 5;
-#line 23722 ""
+#line 23716 ""
ihorn = max(i__1,i__2);
-#line 23723 ""
+#line 23717 ""
}
-#line 23724 ""
+#line 23718 ""
ioff = 0;
-#line 23725 ""
+#line 23719 ""
iclracc = 0;
/* Begin routine to set name. Bits 0-13: (stmgx+Tupf._) */
/* 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n */
-#line 23730 ""
+#line 23724 ""
if (bit_test(iornt,2)) {
/* Writing concatenation */
+#line 23725 ""
+ i__3[0] = 1, a__1[0] = sq;
+#line 23725 ""
+ i__3[1] = 5, a__1[1] = "shake";
+#line 23725 ""
+ s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23726 ""
+ lnote = 6;
+#line 23727 ""
+ } else if (bit_test(iornt,3)) {
+/* Writing concatenation */
+#line 23728 ""
+ i__3[0] = 1, a__1[0] = sq;
+#line 23728 ""
+ i__3[1] = 7, a__1[1] = "mordent";
+#line 23728 ""
+ s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+#line 23729 ""
+ lnote = 8;
+#line 23730 ""
+ } else if (bit_test(iornt,1)) {
+/* Writing concatenation */
#line 23731 ""
i__3[0] = 1, a__1[0] = sq;
#line 23731 ""
- i__3[1] = 5, a__1[1] = "shake";
+ i__3[1] = 3, a__1[1] = "mtr";
#line 23731 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23732 ""
- lnote = 6;
+ lnote = 4;
#line 23733 ""
- } else if (bit_test(iornt,3)) {
+ } else if (bit_test(iornt,5)) {
/* Writing concatenation */
#line 23734 ""
i__3[0] = 1, a__1[0] = sq;
#line 23734 ""
- i__3[1] = 7, a__1[1] = "mordent";
+ i__3[1] = 3, a__1[1] = "xtr";
#line 23734 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23735 ""
- lnote = 8;
+ lnote = 4;
#line 23736 ""
- } else if (bit_test(iornt,1)) {
+ } else if (bit_test(iornt,6)) {
/* Writing concatenation */
#line 23737 ""
i__3[0] = 1, a__1[0] = sq;
#line 23737 ""
- i__3[1] = 3, a__1[1] = "mtr";
+ i__3[1] = 3, a__1[1] = "ptr";
#line 23737 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23738 ""
lnote = 4;
#line 23739 ""
- } else if (bit_test(iornt,5)) {
+ } else if (bit_test(iornt,13)) {
/* Writing concatenation */
#line 23740 ""
i__3[0] = 1, a__1[0] = sq;
#line 23740 ""
- i__3[1] = 3, a__1[1] = "xtr";
+ i__3[1] = 3, a__1[1] = "rpn";
#line 23740 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23741 ""
lnote = 4;
#line 23742 ""
- } else if (bit_test(iornt,6)) {
+ } else if (bit_test(iornt,0)) {
/* Writing concatenation */
#line 23743 ""
i__3[0] = 1, a__1[0] = sq;
#line 23743 ""
- i__3[1] = 3, a__1[1] = "ptr";
+ i__3[1] = 3, a__1[1] = "lpn";
#line 23743 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23744 ""
lnote = 4;
#line 23745 ""
- } else if (bit_test(iornt,13)) {
+ } else if (bit_test(iornt,12)) {
/* Writing concatenation */
#line 23746 ""
- i__3[0] = 1, a__1[0] = sq;
+ i__4[0] = 1, a__2[0] = sq;
#line 23746 ""
- i__3[1] = 3, a__1[1] = "rpn";
+ i__4[1] = 1, a__2[1] = ulpzq;
#line 23746 ""
- s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+ i__4[2] = 2, a__2[2] = "st";
+#line 23746 ""
+ s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
#line 23747 ""
lnote = 4;
#line 23748 ""
- } else if (bit_test(iornt,0)) {
+ } else if (bit_test(iornt,11)) {
/* Writing concatenation */
#line 23749 ""
- i__3[0] = 1, a__1[0] = sq;
+ i__4[0] = 1, a__2[0] = sq;
#line 23749 ""
- i__3[1] = 3, a__1[1] = "lpn";
+ i__4[1] = 1, a__2[1] = ulpzq;
#line 23749 ""
- s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
+ i__4[2] = 2, a__2[2] = "pz";
+#line 23749 ""
+ s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
#line 23750 ""
lnote = 4;
#line 23751 ""
- } else if (bit_test(iornt,12)) {
+ } else if (bit_test(iornt,8)) {
/* Writing concatenation */
#line 23752 ""
- i__4[0] = 1, a__2[0] = sq;
-#line 23752 ""
- i__4[1] = 1, a__2[1] = ulpzq;
+ i__3[0] = 1, a__1[0] = sq;
#line 23752 ""
- i__4[2] = 2, a__2[2] = "st";
+ i__3[1] = 3, a__1[1] = "upz";
#line 23752 ""
- s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
+ s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
#line 23753 ""
lnote = 4;
#line 23754 ""
- } else if (bit_test(iornt,11)) {
-/* Writing concatenation */
-#line 23755 ""
- i__4[0] = 1, a__2[0] = sq;
-#line 23755 ""
- i__4[1] = 1, a__2[1] = ulpzq;
-#line 23755 ""
- i__4[2] = 2, a__2[2] = "pz";
-#line 23755 ""
- s_cat(notexq, a__2, i__4, &c__3, (ftnlen)79);
-#line 23756 ""
- lnote = 4;
-#line 23757 ""
- } else if (bit_test(iornt,8)) {
-/* Writing concatenation */
-#line 23758 ""
- i__3[0] = 1, a__1[0] = sq;
-#line 23758 ""
- i__3[1] = 3, a__1[1] = "upz";
-#line 23758 ""
- s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23759 ""
- lnote = 4;
-#line 23760 ""
ioff = -2;
-#line 23761 ""
+#line 23755 ""
} else if (bit_test(iornt,9)) {
/* Writing concatenation */
-#line 23762 ""
+#line 23756 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23762 ""
+#line 23756 ""
i__3[1] = 4, a__1[1] = "uppz";
-#line 23762 ""
+#line 23756 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23763 ""
+#line 23757 ""
lnote = 5;
-#line 23764 ""
+#line 23758 ""
ioff = -2;
-#line 23765 ""
+#line 23759 ""
} else if (bit_test(iornt,10)) {
-#line 23766 ""
+#line 23760 ""
if (*nodur < 48) {
/* Writing concatenation */
-#line 23767 ""
+#line 23761 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23767 ""
+#line 23761 ""
i__3[1] = 9, a__1[1] = "fermataup";
-#line 23767 ""
+#line 23761 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23768 ""
+#line 23762 ""
} else {
/* Writing concatenation */
-#line 23769 ""
+#line 23763 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23769 ""
+#line 23763 ""
i__3[1] = 9, a__1[1] = "Fermataup";
-#line 23769 ""
+#line 23763 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23770 ""
+#line 23764 ""
}
-#line 23771 ""
+#line 23765 ""
lnote = 10;
-#line 23772 ""
+#line 23766 ""
ioff = -2;
-#line 23773 ""
+#line 23767 ""
} else if (bit_test(iornt,14)) {
-#line 23774 ""
+#line 23768 ""
if (*nodur < 48) {
/* Writing concatenation */
-#line 23775 ""
+#line 23769 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23775 ""
+#line 23769 ""
i__3[1] = 11, a__1[1] = "fermatadown";
-#line 23775 ""
+#line 23769 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23776 ""
+#line 23770 ""
} else {
/* Writing concatenation */
-#line 23777 ""
+#line 23771 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23777 ""
+#line 23771 ""
i__3[1] = 11, a__1[1] = "Fermatadown";
-#line 23777 ""
+#line 23771 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23778 ""
+#line 23772 ""
}
-#line 23779 ""
+#line 23773 ""
lnote = 12;
-#line 23780 ""
+#line 23774 ""
} else if (bit_test(iornt,21)) {
/* "?" in editorial ornament. Clear bit 16-18 after use, since ibit=21 */
-#line 23784 ""
+#line 23778 ""
if (bit_test(*iornq,16)) {
/* Writing concatenation */
-#line 23785 ""
+#line 23779 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23785 ""
+#line 23779 ""
i__3[1] = 6, a__1[1] = "qsharp";
-#line 23785 ""
+#line 23779 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23786 ""
+#line 23780 ""
lnote = 7;
-#line 23787 ""
+#line 23781 ""
ioff = 2;
-#line 23788 ""
+#line 23782 ""
*iornq = bit_clear(*iornq,16);
-#line 23789 ""
+#line 23783 ""
iclracc = 16;
-#line 23790 ""
+#line 23784 ""
} else if (bit_test(*iornq,17)) {
/* Writing concatenation */
-#line 23791 ""
+#line 23785 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23791 ""
+#line 23785 ""
i__3[1] = 5, a__1[1] = "qflat";
-#line 23791 ""
+#line 23785 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23792 ""
+#line 23786 ""
lnote = 6;
-#line 23793 ""
+#line 23787 ""
ioff = 1;
-#line 23794 ""
+#line 23788 ""
*iornq = bit_clear(*iornq,17);
-#line 23795 ""
+#line 23789 ""
iclracc = 17;
-#line 23796 ""
+#line 23790 ""
} else if (bit_test(*iornq,18)) {
/* Writing concatenation */
-#line 23797 ""
+#line 23791 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23797 ""
+#line 23791 ""
i__3[1] = 4, a__1[1] = "qnat";
-#line 23797 ""
+#line 23791 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23798 ""
+#line 23792 ""
lnote = 5;
-#line 23799 ""
+#line 23793 ""
ioff = 2;
-#line 23800 ""
+#line 23794 ""
*iornq = bit_clear(*iornq,18);
-#line 23801 ""
+#line 23795 ""
iclracc = 18;
-#line 23802 ""
+#line 23796 ""
} else {
/* Writing concatenation */
-#line 23803 ""
+#line 23797 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23803 ""
+#line 23797 ""
i__3[1] = 5, a__1[1] = "qedit";
-#line 23803 ""
+#line 23797 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23804 ""
+#line 23798 ""
lnote = 6;
-#line 23805 ""
+#line 23799 ""
ioff = 0;
-#line 23806 ""
+#line 23800 ""
}
-#line 23807 ""
+#line 23801 ""
} else if (bit_test(iornt,16)) {
/* Writing concatenation */
-#line 23808 ""
+#line 23802 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23808 ""
+#line 23802 ""
i__3[1] = 6, a__1[1] = "esharp";
-#line 23808 ""
+#line 23802 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23809 ""
+#line 23803 ""
lnote = 7;
-#line 23810 ""
+#line 23804 ""
ioff = 2;
-#line 23811 ""
+#line 23805 ""
} else if (bit_test(iornt,17)) {
/* Writing concatenation */
-#line 23812 ""
+#line 23806 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23812 ""
+#line 23806 ""
i__3[1] = 5, a__1[1] = "eflat";
-#line 23812 ""
+#line 23806 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23813 ""
+#line 23807 ""
lnote = 6;
-#line 23814 ""
+#line 23808 ""
ioff = 1;
-#line 23815 ""
+#line 23809 ""
} else if (bit_test(iornt,18)) {
/* Writing concatenation */
-#line 23816 ""
+#line 23810 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23816 ""
+#line 23810 ""
i__3[1] = 4, a__1[1] = "enat";
-#line 23816 ""
+#line 23810 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23817 ""
+#line 23811 ""
lnote = 5;
-#line 23818 ""
+#line 23812 ""
ioff = 2;
-#line 23819 ""
+#line 23813 ""
} else if (bit_test(iornt,19)) {
/* Writing concatenation */
-#line 23820 ""
+#line 23814 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23820 ""
+#line 23814 ""
i__3[1] = 3, a__1[1] = "usf";
-#line 23820 ""
+#line 23814 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23821 ""
+#line 23815 ""
lnote = 4;
-#line 23822 ""
+#line 23816 ""
ioff = -2;
-#line 23823 ""
+#line 23817 ""
} else if (bit_test(iornt,20)) {
/* Writing concatenation */
-#line 23824 ""
+#line 23818 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23824 ""
+#line 23818 ""
i__3[1] = 4, a__1[1] = "usfz";
-#line 23824 ""
+#line 23818 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23825 ""
+#line 23819 ""
lnote = 5;
-#line 23826 ""
+#line 23820 ""
ioff = -2;
-#line 23827 ""
+#line 23821 ""
} else if (bit_test(iornt,29)) {
/* Writing concatenation */
-#line 23828 ""
+#line 23822 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23828 ""
+#line 23822 ""
i__3[1] = 5, a__1[1] = "ccoda";
-#line 23828 ""
+#line 23822 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23829 ""
+#line 23823 ""
lnote = 6;
-#line 23830 ""
+#line 23824 ""
} else if (bit_test(iornt,30)) {
/* Writing concatenation */
-#line 23831 ""
+#line 23825 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23831 ""
+#line 23825 ""
i__3[1] = 6, a__1[1] = "ssegno";
-#line 23831 ""
+#line 23825 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23832 ""
+#line 23826 ""
lnote = 7;
-#line 23833 ""
+#line 23827 ""
}
-#line 23834 ""
+#line 23828 ""
iudorn = 0;
/* User-defined level shift of ornament from default? */
-#line 23838 ""
+#line 23832 ""
if (bit_test(*iornq,25)) {
/* Find which (if any) element of kudorn has the shift. */
-#line 23842 ""
+#line 23836 ""
i__1 = comtrill_1.nudorn;
-#line 23842 ""
+#line 23836 ""
for (iudorn = 1; iudorn <= i__1; ++iudorn) {
/* if (ibit .lt. 21) then */
/* if (ibit.lt.21 .or. ibit.eq.29) then */
-#line 23845 ""
+#line 23839 ""
if (ibit < 21 || ibit == 29 || ibit == 30) {
-#line 23846 ""
+#line 23840 ""
ibitt = ibit;
/* Could have oes, but not oe? or oes? */
-#line 23850 ""
+#line 23844 ""
} else if (iclracc > 0) {
/* Earlier cleared edit. accid, meaning it was oes? */
-#line 23854 ""
+#line 23848 ""
ibitt = iclracc + 6;
-#line 23855 ""
+#line 23849 ""
} else {
-#line 23856 ""
+#line 23850 ""
ibitt = 21;
-#line 23857 ""
+#line 23851 ""
}
-#line 23858 ""
+#line 23852 ""
ibitt = *ip + (*ivx % 16 << 8) + (*nolev << 12) + (ibitt << 19);
/* if (ibitt .eq. iand(33554431,kudorn(iudorn))) go to 4 */
-#line 23860 ""
+#line 23854 ""
if (ibitt == (33554431 & comtrill_1.kudorn[iudorn - 1]) && *ivx ==
comivxudorn_1.ivxudorn[iudorn - 1]) {
-#line 23860 ""
+#line 23854 ""
goto L4;
-#line 23860 ""
+#line 23854 ""
}
-#line 23862 ""
+#line 23856 ""
/* L3: */
-#line 23862 ""
+#line 23856 ""
}
/* Nothing shifted on this note; exit this if block */
-#line 23866 ""
+#line 23860 ""
iudorn = 0;
-#line 23867 ""
+#line 23861 ""
goto L5;
-#line 23868 ""
+#line 23862 ""
L4:
-#line 23869 ""
+#line 23863 ""
ioffinc = (63 & lbit_shift(comtrill_1.kudorn[iudorn - 1], (ftnlen)-25)
) - 32;
-#line 23870 ""
+#line 23864 ""
if (ibit == 19 && ioffinc < -7) {
/* Convert usf to lsf. The reason has to do with positioning being impossile */
/* for some mysterious reason when you drop \usf below the staff */
/* Writing concatenation */
-#line 23875 ""
+#line 23869 ""
i__3[0] = 1, a__1[0] = sq;
-#line 23875 ""
+#line 23869 ""
i__3[1] = 3, a__1[1] = "lsf";
-#line 23875 ""
+#line 23869 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23876 ""
+#line 23870 ""
ioffinc += 6;
-#line 23877 ""
+#line 23871 ""
}
-#line 23878 ""
+#line 23872 ""
ioff += ioffinc;
-#line 23879 ""
+#line 23873 ""
}
-#line 23880 ""
+#line 23874 ""
L5:
/* Shift level to avoid slur. Conditions are */
@@ -59107,149 +59384,149 @@ L5:
/* 4. ornament is not segno(4), ._)(11-13), down ferm(14) or "(" (0) Bin=30737 */
/* 5. islhgt+3 >= height already computed. */
-#line 23889 ""
+#line 23883 ""
if (! bit_test(*iornq,25) && *islhgt > 0 && (iornt & 30737) == 0) {
-#line 23889 ""
+#line 23883 ""
i__1 = *islhgt + 3;
-#line 23889 ""
+#line 23883 ""
ioff += i_dim(&i__1, &ihorn);
-#line 23889 ""
+#line 23883 ""
}
-#line 23892 ""
+#line 23886 ""
i__1 = ihorn + ioff;
-#line 23892 ""
+#line 23886 ""
notefq_(noteq, &lnoten, &i__1, ncm, (ftnlen)8);
-#line 23893 ""
+#line 23887 ""
if (lnoten == 1) {
-#line 23893 ""
+#line 23887 ""
addblank_(noteq, &lnoten, (ftnlen)8);
-#line 23893 ""
+#line 23887 ""
}
-#line 23894 ""
+#line 23888 ""
if ((iornt & 32896) > 0) {
/* T-trill or trill w/o "tr" */
-#line 23898 ""
+#line 23892 ""
dotrill_(ivx, ip, &iornt, noteq, &lnoten, notexq, &lnote, (ftnlen)8, (
ftnlen)79);
-#line 23899 ""
+#line 23893 ""
} else {
/* Writing concatenation */
-#line 23900 ""
+#line 23894 ""
i__3[0] = lnote, a__1[0] = notexq;
-#line 23900 ""
+#line 23894 ""
i__3[1] = lnoten, a__1[1] = noteq;
-#line 23900 ""
+#line 23894 ""
s_cat(notexq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23901 ""
+#line 23895 ""
lnote += lnoten;
-#line 23902 ""
+#line 23896 ""
}
-#line 23903 ""
+#line 23897 ""
if (iudorn > 0) {
-#line 23904 ""
+#line 23898 ""
if (bit_test(comtrill_1.kudorn[iudorn - 1],31)) {
/* Horizontal shift */
-#line 23908 ""
+#line 23902 ""
lform = lfmt1_(&comtrill_1.ornhshft[iudorn - 1]);
-#line 23909 ""
+#line 23903 ""
ici__1.icierr = 0;
-#line 23909 ""
+#line 23903 ""
ici__1.icirnum = 1;
-#line 23909 ""
+#line 23903 ""
ici__1.icirlen = lform;
-#line 23909 ""
+#line 23903 ""
ici__1.iciunit = noteq;
/* Writing concatenation */
-#line 23909 ""
+#line 23903 ""
i__4[0] = 2, a__2[0] = "(f";
-#line 23909 ""
+#line 23903 ""
i__1 = lform + 48;
-#line 23909 ""
+#line 23903 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 23909 ""
+#line 23903 ""
i__4[1] = 1, a__2[1] = ch__1;
-#line 23909 ""
+#line 23903 ""
i__4[2] = 3, a__2[2] = ".1)";
-#line 23909 ""
+#line 23903 ""
ici__1.icifmt = (s_cat(ch__2, a__2, i__4, &c__3, (ftnlen)6),
ch__2);
-#line 23909 ""
+#line 23903 ""
s_wsfi(&ici__1);
-#line 23909 ""
+#line 23903 ""
do_fio(&c__1, (char *)&comtrill_1.ornhshft[iudorn - 1], (ftnlen)
sizeof(real));
-#line 23909 ""
+#line 23903 ""
e_wsfi();
/* Writing concatenation */
-#line 23911 ""
+#line 23905 ""
i__5[0] = 1, a__3[0] = sq;
-#line 23911 ""
+#line 23905 ""
i__5[1] = 8, a__3[1] = "roffset{";
-#line 23911 ""
+#line 23905 ""
i__5[2] = lform, a__3[2] = noteq;
-#line 23911 ""
+#line 23905 ""
i__5[3] = 2, a__3[3] = "}{";
-#line 23911 ""
+#line 23905 ""
i__5[4] = lnote, a__3[4] = notexq;
-#line 23911 ""
+#line 23905 ""
i__5[5] = 1, a__3[5] = "}";
-#line 23911 ""
+#line 23905 ""
s_cat(notexq, a__3, i__5, &c__6, (ftnlen)79);
-#line 23913 ""
+#line 23907 ""
lnote = lnote + lform + 12;
-#line 23914 ""
+#line 23908 ""
comtrill_1.ornhshft[iudorn - 1] = 0.f;
-#line 23915 ""
+#line 23909 ""
comtrill_1.kudorn[iudorn - 1] = bit_clear(comtrill_1.kudorn[
iudorn - 1],31);
-#line 23916 ""
+#line 23910 ""
}
-#line 23917 ""
+#line 23911 ""
}
/* Zero out the bit for ornament just dealt with. */
-#line 23921 ""
+#line 23915 ""
*iornq = bit_clear(*iornq,ibit);
-#line 23922 ""
+#line 23916 ""
if (*lout == 0) {
-#line 23923 ""
+#line 23917 ""
s_copy(outq, notexq, (ftnlen)79, lnote);
-#line 23924 ""
+#line 23918 ""
} else {
/* Writing concatenation */
-#line 23925 ""
+#line 23919 ""
i__3[0] = *lout, a__1[0] = outq;
-#line 23925 ""
+#line 23919 ""
i__3[1] = lnote, a__1[1] = notexq;
-#line 23925 ""
+#line 23919 ""
s_cat(outq, a__1, i__3, &c__2, (ftnlen)79);
-#line 23926 ""
+#line 23920 ""
}
-#line 23927 ""
+#line 23921 ""
*lout += lnote;
/* Check bits 0-21, go back if any are still set */
/* If bit 29 or 30 had been set, would have been used first time thru, */
/* and you wouldn't use both coda and segno on same note */
-#line 23933 ""
+#line 23927 ""
if ((*iornq & 4194303) > 0) {
-#line 23933 ""
+#line 23927 ""
goto L2;
-#line 23933 ""
+#line 23927 ""
}
-#line 23934 ""
+#line 23928 ""
if (usehornb) {
-#line 23934 ""
+#line 23928 ""
++nornb[*ivx];
-#line 23934 ""
+#line 23928 ""
}
-#line 23935 ""
+#line 23929 ""
return 0;
} /* putorn_ */
@@ -59278,91 +59555,91 @@ L5:
ftnlen, ftnlen);
static char notexq[80];
-#line 23943 ""
+#line 23937 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 23943 ""
+#line 23937 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
/* Start user-defined offsets X(...): or X(...)S */
-#line 23947 ""
+#line 23941 ""
if (*onoff) {
-#line 23947 ""
+#line 23941 ""
++comudsp_1.nudoff[*ivx - 1];
-#line 23947 ""
+#line 23941 ""
}
/* Xoff is in pts. Round off to nearest .1. Will use at end of shift. */
-#line 23951 ""
+#line 23945 ""
xoff = comudsp_1.udoff[*ivx + comudsp_1.nudoff[*ivx - 1] * 24 - 25];
-#line 23952 ""
+#line 23946 ""
r__1 = (integer) (dabs(xoff) * 10.f + .5f) / 10.f;
-#line 23952 ""
+#line 23946 ""
xoff = r_sign(&r__1, &xoff);
-#line 23953 ""
+#line 23947 ""
if (! (*onoff)) {
-#line 23953 ""
+#line 23947 ""
xoff = -xoff;
-#line 23953 ""
+#line 23947 ""
}
-#line 23954 ""
+#line 23948 ""
if (xoff < -9.95f) {
-#line 23955 ""
+#line 23949 ""
ifmt = 5;
-#line 23956 ""
+#line 23950 ""
} else if (xoff < -.95f || xoff > 9.95f) {
-#line 23957 ""
+#line 23951 ""
ifmt = 4;
-#line 23958 ""
+#line 23952 ""
} else {
-#line 23959 ""
+#line 23953 ""
ifmt = 3;
-#line 23960 ""
+#line 23954 ""
}
-#line 23961 ""
+#line 23955 ""
ici__1.icierr = 0;
-#line 23961 ""
+#line 23955 ""
ici__1.icirnum = 1;
-#line 23961 ""
+#line 23955 ""
ici__1.icirlen = 80;
-#line 23961 ""
+#line 23955 ""
ici__1.iciunit = notexq;
/* Writing concatenation */
-#line 23961 ""
+#line 23955 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 23961 ""
+#line 23955 ""
i__2 = ifmt + 48;
-#line 23961 ""
+#line 23955 ""
chax_(ch__1, (ftnlen)1, &i__2);
-#line 23961 ""
+#line 23955 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 23961 ""
+#line 23955 ""
i__1[2] = 3, a__1[2] = ".1)";
-#line 23961 ""
+#line 23955 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 23961 ""
+#line 23955 ""
s_wsfi(&ici__1);
-#line 23961 ""
+#line 23955 ""
do_fio(&c__1, (char *)&xoff, (ftnlen)sizeof(real));
-#line 23961 ""
+#line 23955 ""
e_wsfi();
/* Writing concatenation */
-#line 23962 ""
+#line 23956 ""
i__3[0] = 1, a__2[0] = sq;
-#line 23962 ""
+#line 23956 ""
i__3[1] = 4, a__2[1] = "off{";
-#line 23962 ""
+#line 23956 ""
i__3[2] = ifmt, a__2[2] = notexq;
-#line 23962 ""
+#line 23956 ""
i__3[3] = 3, a__2[3] = "pt}";
-#line 23962 ""
+#line 23956 ""
s_cat(ch__3, a__2, i__3, &c__4, (ftnlen)88);
-#line 23962 ""
+#line 23956 ""
i__2 = ifmt + 8;
-#line 23962 ""
+#line 23956 ""
addstr_(ch__3, &i__2, soutq, lsout, ifmt + 8, (ftnlen)80);
-#line 23964 ""
+#line 23958 ""
return 0;
} /* putshft_ */
@@ -59405,352 +59682,352 @@ L5:
/* Actual titles only allowed on p.1. (set by headlog). */
/* 3/18/01: The above comment is probably bogus...can use Tt on later pages. */
-#line 23983 ""
+#line 23977 ""
/* Parameter adjustments */
-#line 23983 ""
+#line 23977 ""
--sepsymq;
-#line 23983 ""
+#line 23977 ""
-#line 23983 ""
+#line 23977 ""
/* Function Body */
/* Writing concatenation */
-#line 23983 ""
+#line 23977 ""
i__1[0] = 1, a__1[0] = sq;
-#line 23983 ""
+#line 23977 ""
i__1[1] = 6, a__1[1] = "znotes";
-#line 23983 ""
+#line 23977 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 23984 ""
+#line 23978 ""
lenline = 7;
-#line 23985 ""
+#line 23979 ""
i__2 = *nv - 1;
-#line 23985 ""
+#line 23979 ""
for (iv = 1; iv <= i__2; ++iv) {
/* Writing concatenation */
-#line 23986 ""
+#line 23980 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 23986 ""
+#line 23980 ""
i__1[1] = 1, a__1[1] = sepsymq + iv;
-#line 23986 ""
+#line 23980 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 23987 ""
+#line 23981 ""
++lenline;
-#line 23988 ""
+#line 23982 ""
/* L22: */
-#line 23988 ""
+#line 23982 ""
}
/* Writing concatenation */
-#line 23989 ""
+#line 23983 ""
i__3[0] = lenline, a__2[0] = notexq;
-#line 23989 ""
+#line 23983 ""
i__3[1] = 1, a__2[1] = sq;
-#line 23989 ""
+#line 23983 ""
i__3[2] = 10, a__2[2] = "zcharnote{";
-#line 23989 ""
+#line 23983 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
-#line 23990 ""
+#line 23984 ""
lenline += 11;
-#line 23991 ""
+#line 23985 ""
if (! comtitl_1.headlog) {
-#line 23992 ""
+#line 23986 ""
comtitl_1.inhead = *inhnoh;
-#line 23993 ""
+#line 23987 ""
}
-#line 23994 ""
+#line 23988 ""
if (*vshrink && comlast_1.usevshrink) {
-#line 23995 ""
+#line 23989 ""
comtitl_1.inhead = 16;
-#line 23996 ""
+#line 23990 ""
}
-#line 23997 ""
+#line 23991 ""
r__1 = comtitl_1.inhead + .01f;
-#line 23997 ""
+#line 23991 ""
ndig = (integer) r_lg10(&r__1) + 1;
-#line 23998 ""
+#line 23992 ""
i__2 = lenline;
-#line 23998 ""
+#line 23992 ""
ici__1.icierr = 0;
-#line 23998 ""
+#line 23992 ""
ici__1.icirnum = 1;
-#line 23998 ""
+#line 23992 ""
ici__1.icirlen = lenline + ndig + 10 - i__2;
-#line 23998 ""
+#line 23992 ""
ici__1.iciunit = notexq + i__2;
/* Writing concatenation */
-#line 23998 ""
+#line 23992 ""
i__3[0] = 2, a__2[0] = "(i";
-#line 23998 ""
+#line 23992 ""
i__4 = ndig + 48;
-#line 23998 ""
+#line 23992 ""
chax_(ch__2, (ftnlen)1, &i__4);
-#line 23998 ""
+#line 23992 ""
i__3[1] = 1, a__2[1] = ch__2;
-#line 23998 ""
+#line 23992 ""
i__3[2] = 5, a__2[2] = ",a10)";
-#line 23998 ""
+#line 23992 ""
ici__1.icifmt = (s_cat(ch__1, a__2, i__3, &c__3, (ftnlen)8), ch__1);
-#line 23998 ""
+#line 23992 ""
s_wsfi(&ici__1);
-#line 23998 ""
+#line 23992 ""
do_fio(&c__1, (char *)&comtitl_1.inhead, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 23998 ""
+#line 23992 ""
i__5[0] = 2, a__3[0] = "}{";
-#line 23998 ""
+#line 23992 ""
i__5[1] = 1, a__3[1] = sq;
-#line 23998 ""
+#line 23992 ""
i__5[2] = 7, a__3[2] = "titles{";
-#line 23998 ""
+#line 23992 ""
s_cat(ch__3, a__3, i__5, &c__3, (ftnlen)10);
-#line 23998 ""
+#line 23992 ""
do_fio(&c__1, ch__3, (ftnlen)10);
-#line 23998 ""
+#line 23992 ""
e_wsfi();
-#line 24000 ""
+#line 23994 ""
lenline = lenline + ndig + 10;
/* Vertical skip at top of page (\Il) = etatop*glueil. Needed whether */
/* headers are present or not. */
-#line 24005 ""
+#line 23999 ""
glueil = *xnsttop / *etatop;
-#line 24006 ""
+#line 24000 ""
vskil = *etatop * glueil;
-#line 24007 ""
+#line 24001 ""
if (*vshrink && comlast_1.usevshrink) {
-#line 24007 ""
+#line 24001 ""
vskil = 2.f;
-#line 24007 ""
+#line 24001 ""
}
-#line 24008 ""
+#line 24002 ""
writflot_(&vskil, notexq, &lenline, (ftnlen)127);
-#line 24009 ""
+#line 24003 ""
if (! comtitl_1.headlog) {
-#line 24010 ""
+#line 24004 ""
if (comlast_1.islast) {
-#line 24010 ""
+#line 24004 ""
s_wsfe(&io___1706);
/* Writing concatenation */
-#line 24010 ""
+#line 24004 ""
i__6[0] = lenline, a__4[0] = notexq;
-#line 24010 ""
+#line 24004 ""
i__6[1] = 17, a__4[1] = "}{}{0}{}{0}{}{0}}";
-#line 24010 ""
+#line 24004 ""
i__6[2] = 1, a__4[2] = sq;
-#line 24010 ""
+#line 24004 ""
i__6[3] = 3, a__4[3] = "en%";
-#line 24010 ""
+#line 24004 ""
s_cat(ch__4, a__4, i__6, &c__4, (ftnlen)148);
-#line 24010 ""
+#line 24004 ""
do_fio(&c__1, ch__4, lenline + 21);
-#line 24010 ""
+#line 24004 ""
e_wsfe();
-#line 24010 ""
+#line 24004 ""
}
-#line 24012 ""
+#line 24006 ""
} else {
/* Writing concatenation */
-#line 24013 ""
+#line 24007 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24013 ""
+#line 24007 ""
i__1[1] = 2, a__1[1] = "}{";
-#line 24013 ""
+#line 24007 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24014 ""
+#line 24008 ""
lenline += 2;
-#line 24015 ""
+#line 24009 ""
lcq = lenstr_(comtitl_1.instrq, &c__120, (ftnlen)120);
-#line 24016 ""
+#line 24010 ""
if (lcq > 0) {
-#line 24017 ""
+#line 24011 ""
xitil = *etait * glueil;
-#line 24018 ""
+#line 24012 ""
if (*vshrink && comlast_1.usevshrink) {
-#line 24018 ""
+#line 24012 ""
xitil = 2.f;
-#line 24018 ""
+#line 24012 ""
}
/* Writing concatenation */
-#line 24019 ""
+#line 24013 ""
i__3[0] = lenline, a__2[0] = notexq;
-#line 24019 ""
+#line 24013 ""
i__3[1] = lcq, a__2[1] = comtitl_1.instrq;
-#line 24019 ""
+#line 24013 ""
i__3[2] = 2, a__2[2] = "}{";
-#line 24019 ""
+#line 24013 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
/* Null out instrument once used */
-#line 24023 ""
+#line 24017 ""
s_copy(comtitl_1.instrq, " ", (ftnlen)120, (ftnlen)1);
-#line 24024 ""
+#line 24018 ""
lenline = lenline + lcq + 2;
-#line 24025 ""
+#line 24019 ""
writflot_(&xitil, notexq, &lenline, (ftnlen)127);
-#line 24026 ""
+#line 24020 ""
} else {
/* Writing concatenation */
-#line 24027 ""
+#line 24021 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24027 ""
+#line 24021 ""
i__1[1] = 3, a__1[1] = "}{0";
-#line 24027 ""
+#line 24021 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24028 ""
+#line 24022 ""
lenline += 3;
-#line 24029 ""
+#line 24023 ""
}
-#line 24030 ""
+#line 24024 ""
if (comlast_1.islast) {
-#line 24030 ""
+#line 24024 ""
s_wsfe(&io___1709);
/* Writing concatenation */
-#line 24030 ""
+#line 24024 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24030 ""
+#line 24024 ""
i__1[1] = 2, a__1[1] = "}%";
-#line 24030 ""
+#line 24024 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)129);
-#line 24030 ""
+#line 24024 ""
do_fio(&c__1, ch__5, lenline + 2);
-#line 24030 ""
+#line 24024 ""
e_wsfe();
-#line 24030 ""
+#line 24024 ""
}
-#line 24031 ""
+#line 24025 ""
s_copy(notexq, "{", (ftnlen)127, (ftnlen)1);
-#line 24032 ""
+#line 24026 ""
lenline = 1;
-#line 24033 ""
+#line 24027 ""
lcq = lenstr_(comtitl_1.titleq, &c__120, (ftnlen)120);
-#line 24034 ""
+#line 24028 ""
if (lcq > 0) {
/* Writing concatenation */
-#line 24035 ""
+#line 24029 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24035 ""
+#line 24029 ""
i__1[1] = lcq, a__1[1] = comtitl_1.titleq;
-#line 24035 ""
+#line 24029 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24036 ""
+#line 24030 ""
lenline += lcq;
-#line 24037 ""
+#line 24031 ""
} else {
-#line 24038 ""
+#line 24032 ""
printl_(" ", (ftnlen)1);
-#line 24039 ""
+#line 24033 ""
printl_("WARNING", (ftnlen)7);
-#line 24040 ""
+#line 24034 ""
printl_(" In a title block, you have specified instrument and/or"
, (ftnlen)56);
-#line 24042 ""
+#line 24036 ""
printl_(" composer but no title for the piece.", (ftnlen)38);
-#line 24044 ""
+#line 24038 ""
}
/* Writing concatenation */
-#line 24045 ""
+#line 24039 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24045 ""
+#line 24039 ""
i__1[1] = 2, a__1[1] = "}{";
-#line 24045 ""
+#line 24039 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24046 ""
+#line 24040 ""
lenline += 2;
-#line 24047 ""
+#line 24041 ""
xtcil = *etatc * glueil;
-#line 24048 ""
+#line 24042 ""
lcq = lenstr_(comtitl_1.compoq, &c__120, (ftnlen)120);
-#line 24049 ""
+#line 24043 ""
if (lcq == 0) {
-#line 24049 ""
+#line 24043 ""
xtcil *= 2;
-#line 24049 ""
+#line 24043 ""
}
-#line 24050 ""
+#line 24044 ""
if (*vshrink && comlast_1.usevshrink) {
-#line 24050 ""
+#line 24044 ""
xtcil = 2.f;
-#line 24050 ""
+#line 24044 ""
}
-#line 24051 ""
+#line 24045 ""
writflot_(&xtcil, notexq, &lenline, (ftnlen)127);
/* Writing concatenation */
-#line 24052 ""
+#line 24046 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24052 ""
+#line 24046 ""
i__1[1] = 2, a__1[1] = "}{";
-#line 24052 ""
+#line 24046 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24053 ""
+#line 24047 ""
lenline += 2;
-#line 24054 ""
+#line 24048 ""
if (lcq > 0) {
/* Writing concatenation */
-#line 24055 ""
+#line 24049 ""
i__3[0] = lenline, a__2[0] = notexq;
-#line 24055 ""
+#line 24049 ""
i__3[1] = lcq, a__2[1] = comtitl_1.compoq;
-#line 24055 ""
+#line 24049 ""
i__3[2] = 2, a__2[2] = "}{";
-#line 24055 ""
+#line 24049 ""
s_cat(notexq, a__2, i__3, &c__3, (ftnlen)127);
-#line 24056 ""
+#line 24050 ""
lenline = lenline + 2 + lcq;
/* Null out compoq so it does not get written later */
-#line 24060 ""
+#line 24054 ""
s_copy(comtitl_1.compoq, " ", (ftnlen)120, (ftnlen)1);
-#line 24061 ""
+#line 24055 ""
xcsil = *etacs1 * glueil;
-#line 24062 ""
+#line 24056 ""
if (*vshrink && comlast_1.usevshrink) {
-#line 24062 ""
+#line 24056 ""
xcsil = 2.f;
-#line 24062 ""
+#line 24056 ""
}
-#line 24063 ""
+#line 24057 ""
writflot_(&xcsil, notexq, &lenline, (ftnlen)127);
-#line 24064 ""
+#line 24058 ""
} else {
/* Writing concatenation */
-#line 24065 ""
+#line 24059 ""
i__1[0] = lenline, a__1[0] = notexq;
-#line 24065 ""
+#line 24059 ""
i__1[1] = 3, a__1[1] = "}{0";
-#line 24065 ""
+#line 24059 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)127);
-#line 24066 ""
+#line 24060 ""
lenline += 3;
-#line 24067 ""
+#line 24061 ""
}
-#line 24068 ""
+#line 24062 ""
if (comlast_1.islast) {
-#line 24068 ""
+#line 24062 ""
s_wsfe(&io___1712);
/* Writing concatenation */
-#line 24068 ""
+#line 24062 ""
i__6[0] = lenline, a__4[0] = notexq;
-#line 24068 ""
+#line 24062 ""
i__6[1] = 2, a__4[1] = "}}";
-#line 24068 ""
+#line 24062 ""
i__6[2] = 1, a__4[2] = sq;
-#line 24068 ""
+#line 24062 ""
i__6[3] = 3, a__4[3] = "en%";
-#line 24068 ""
+#line 24062 ""
s_cat(ch__6, a__4, i__6, &c__4, (ftnlen)133);
-#line 24068 ""
+#line 24062 ""
do_fio(&c__1, ch__6, lenline + 6);
-#line 24068 ""
+#line 24062 ""
e_wsfe();
-#line 24068 ""
+#line 24062 ""
}
-#line 24069 ""
+#line 24063 ""
comtitl_1.headlog = FALSE_;
-#line 24070 ""
+#line 24064 ""
}
-#line 24071 ""
+#line 24065 ""
return 0;
} /* puttitle_ */
@@ -59786,218 +60063,218 @@ L5:
/* Places digit for xtuplet. */
-#line 24084 ""
+#line 24078 ""
if (*iflop != 0 && *multb > 0) {
/* Number goes on beam side, move R/L by .5 wheadpt for upper/lower */
-#line 24088 ""
+#line 24082 ""
*eloff -= *iud * .5f * *wheadpt / *poenom;
/* Number goes on beam side, must use beam parameters to set pos'n */
-#line 24092 ""
+#line 24086 ""
*nlnum = *nolev1 + *islope / *slfac * *eloff + *iup * (*multb + 8);
-#line 24093 ""
+#line 24087 ""
if (*multb >= 2) {
-#line 24093 ""
+#line 24087 ""
*nlnum += *iup;
-#line 24093 ""
+#line 24087 ""
}
-#line 24094 ""
+#line 24088 ""
} else {
-#line 24095 ""
+#line 24089 ""
r__1 = *xnlmid - 1 + *iud * 3 + *iflop * 11;
-#line 24095 ""
+#line 24089 ""
*nlnum = i_nint(&r__1);
-#line 24096 ""
+#line 24090 ""
}
-#line 24097 ""
+#line 24091 ""
if (! bit_test(*islur,31)) {
/* Only print number when wanted. First check vert, horiz offset */
-#line 24101 ""
+#line 24095 ""
if (bit_test(*irest,1)) {
-#line 24101 ""
+#line 24095 ""
*nlnum = *nlnum + igetbits_(mult, &c__8, &c__16) - 64;
-#line 24101 ""
+#line 24095 ""
}
-#line 24102 ""
+#line 24096 ""
if (bit_test(*irest,7)) {
-#line 24102 ""
+#line 24096 ""
*eloff += ((31 & lbit_shift(*irest, (ftnlen)-9)) * .1f - 1.6f) * *
wheadpt / *poenom;
-#line 24102 ""
+#line 24096 ""
}
-#line 24104 ""
+#line 24098 ""
if (! (*usexnumt)) {
/* Writing concatenation */
-#line 24105 ""
+#line 24099 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 24105 ""
+#line 24099 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 24105 ""
+#line 24099 ""
i__1[1] = 5, a__1[1] = "xnum{";
-#line 24105 ""
+#line 24099 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 24106 ""
+#line 24100 ""
*lnote = 10;
-#line 24107 ""
+#line 24101 ""
istrtn = 7;
-#line 24108 ""
+#line 24102 ""
} else {
/* Writing concatenation */
-#line 24109 ""
+#line 24103 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 24109 ""
+#line 24103 ""
i__1[0] = 1, a__1[0] = ch__1;
-#line 24109 ""
+#line 24103 ""
i__1[1] = 6, a__1[1] = "xnumt{";
-#line 24109 ""
+#line 24103 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 24110 ""
+#line 24104 ""
*lnote = 11;
-#line 24111 ""
+#line 24105 ""
istrtn = 8;
-#line 24112 ""
+#line 24106 ""
}
-#line 24113 ""
+#line 24107 ""
if (*eloff < .995f) {
-#line 24114 ""
+#line 24108 ""
ici__1.icierr = 0;
-#line 24114 ""
+#line 24108 ""
ici__1.icirnum = 1;
-#line 24114 ""
+#line 24108 ""
ici__1.icirlen = 4;
-#line 24114 ""
+#line 24108 ""
ici__1.iciunit = notexq + (istrtn - 1);
-#line 24114 ""
+#line 24108 ""
ici__1.icifmt = "(i1,f3.2)";
-#line 24114 ""
+#line 24108 ""
s_wsfi(&ici__1);
-#line 24114 ""
+#line 24108 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 24114 ""
+#line 24108 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
-#line 24114 ""
+#line 24108 ""
e_wsfi();
-#line 24115 ""
+#line 24109 ""
} else if (*eloff < 9.995f) {
-#line 24116 ""
+#line 24110 ""
ici__1.icierr = 0;
-#line 24116 ""
+#line 24110 ""
ici__1.icirnum = 1;
-#line 24116 ""
+#line 24110 ""
ici__1.icirlen = 4;
-#line 24116 ""
+#line 24110 ""
ici__1.iciunit = notexq + (istrtn - 1);
-#line 24116 ""
+#line 24110 ""
ici__1.icifmt = "(f4.2)";
-#line 24116 ""
+#line 24110 ""
s_wsfi(&ici__1);
-#line 24116 ""
+#line 24110 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
-#line 24116 ""
+#line 24110 ""
e_wsfi();
-#line 24117 ""
+#line 24111 ""
} else {
-#line 24118 ""
+#line 24112 ""
ici__1.icierr = 0;
-#line 24118 ""
+#line 24112 ""
ici__1.icirnum = 1;
-#line 24118 ""
+#line 24112 ""
ici__1.icirlen = 5;
-#line 24118 ""
+#line 24112 ""
ici__1.iciunit = notexq + (istrtn - 1);
-#line 24118 ""
+#line 24112 ""
ici__1.icifmt = "(f5.2)";
-#line 24118 ""
+#line 24112 ""
s_wsfi(&ici__1);
-#line 24118 ""
+#line 24112 ""
do_fio(&c__1, (char *)&(*eloff), (ftnlen)sizeof(real));
-#line 24118 ""
+#line 24112 ""
e_wsfi();
-#line 24119 ""
+#line 24113 ""
++(*lnote);
-#line 24120 ""
+#line 24114 ""
}
-#line 24121 ""
+#line 24115 ""
notefq_(noteq, &lnoten, nlnum, ncmid, (ftnlen)8);
/* Writing concatenation */
-#line 24122 ""
+#line 24116 ""
i__2[0] = *lnote, a__2[0] = notexq;
-#line 24122 ""
+#line 24116 ""
i__2[1] = 1, a__2[1] = "}";
-#line 24122 ""
+#line 24116 ""
i__2[2] = lnoten, a__2[2] = noteq;
-#line 24122 ""
+#line 24116 ""
s_cat(notexq, a__2, i__2, &c__3, (ftnlen)79);
-#line 24123 ""
+#line 24117 ""
*lnote = *lnote + 1 + lnoten;
-#line 24124 ""
+#line 24118 ""
if (*ntupv < 10) {
-#line 24125 ""
+#line 24119 ""
i__3 = *lnote;
-#line 24125 ""
+#line 24119 ""
ici__1.icierr = 0;
-#line 24125 ""
+#line 24119 ""
ici__1.icirnum = 1;
-#line 24125 ""
+#line 24119 ""
ici__1.icirlen = *lnote + 1 - i__3;
-#line 24125 ""
+#line 24119 ""
ici__1.iciunit = notexq + i__3;
-#line 24125 ""
+#line 24119 ""
ici__1.icifmt = "(i1)";
-#line 24125 ""
+#line 24119 ""
s_wsfi(&ici__1);
-#line 24125 ""
+#line 24119 ""
do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
-#line 24125 ""
+#line 24119 ""
e_wsfi();
-#line 24126 ""
+#line 24120 ""
++(*lnote);
-#line 24127 ""
+#line 24121 ""
} else {
/* Writing concatenation */
-#line 24128 ""
+#line 24122 ""
i__1[0] = *lnote, a__1[0] = notexq;
-#line 24128 ""
+#line 24122 ""
i__1[1] = 1, a__1[1] = "{";
-#line 24128 ""
+#line 24122 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 24129 ""
+#line 24123 ""
i__3 = *lnote + 1;
-#line 24129 ""
+#line 24123 ""
ici__1.icierr = 0;
-#line 24129 ""
+#line 24123 ""
ici__1.icirnum = 1;
-#line 24129 ""
+#line 24123 ""
ici__1.icirlen = *lnote + 3 - i__3;
-#line 24129 ""
+#line 24123 ""
ici__1.iciunit = notexq + i__3;
-#line 24129 ""
+#line 24123 ""
ici__1.icifmt = "(i2)";
-#line 24129 ""
+#line 24123 ""
s_wsfi(&ici__1);
-#line 24129 ""
+#line 24123 ""
do_fio(&c__1, (char *)&(*ntupv), (ftnlen)sizeof(integer));
-#line 24129 ""
+#line 24123 ""
e_wsfi();
/* Writing concatenation */
-#line 24130 ""
+#line 24124 ""
i__1[0] = *lnote + 3, a__1[0] = notexq;
-#line 24130 ""
+#line 24124 ""
i__1[1] = 1, a__1[1] = "}";
-#line 24130 ""
+#line 24124 ""
s_cat(notexq, a__1, i__1, &c__2, (ftnlen)79);
-#line 24131 ""
+#line 24125 ""
*lnote += 4;
-#line 24132 ""
+#line 24126 ""
}
-#line 24133 ""
+#line 24127 ""
}
-#line 24134 ""
+#line 24128 ""
return 0;
} /* putxtn_ */
@@ -60011,97 +60288,97 @@ L5:
static integer ip1, ip2;
extern /* Subroutine */ int getbuf_(char *, ftnlen);
-#line 24148 ""
+#line 24142 ""
if (! commac_1.mplay) {
-#line 24149 ""
+#line 24143 ""
if (inbuff_1.ilbuf > inbuff_1.nlbuf) {
-#line 24149 ""
+#line 24143 ""
goto L999;
-#line 24149 ""
+#line 24143 ""
}
-#line 24150 ""
+#line 24144 ""
getbuf_(string, string_len);
-#line 24151 ""
+#line 24145 ""
return 0;
-#line 24152 ""
+#line 24146 ""
L999:
-#line 24152 ""
+#line 24146 ""
*lastchar = TRUE_;
-#line 24153 ""
+#line 24147 ""
return 0;
-#line 24154 ""
+#line 24148 ""
} else {
/* Play a macro. Set pointer to first character needed in buffer */
-#line 24158 ""
+#line 24152 ""
if (c1ommac_1.ilmac == c1ommac_1.il1mac[commac_1.macnum - 1]) {
/* Getting first line of macro */
-#line 24162 ""
+#line 24156 ""
ip1 = c1ommac_1.ip1mac[commac_1.macnum - 1];
-#line 24163 ""
+#line 24157 ""
c1ommac_1.iplmac = ip1 - c1ommac_1.ic1mac[commac_1.macnum - 1];
-#line 24164 ""
+#line 24158 ""
} else if (c1ommac_1.ilmac <= c1ommac_1.il2mac[commac_1.macnum - 1]) {
/* Beyond first line of macro. Advance line-start pointer. */
-#line 24168 ""
+#line 24162 ""
c1ommac_1.iplmac += inbuff_1.lbuf[c1ommac_1.ilmac - 2];
-#line 24169 ""
+#line 24163 ""
ip1 = c1ommac_1.iplmac + 1;
-#line 24170 ""
+#line 24164 ""
} else {
/* Beyond last line of macro. Terminate it! */
-#line 24174 ""
+#line 24168 ""
commac_1.mplay = FALSE_;
-#line 24175 ""
+#line 24169 ""
commac_1.endmac = TRUE_;
-#line 24176 ""
+#line 24170 ""
return 0;
-#line 24177 ""
+#line 24171 ""
}
-#line 24178 ""
+#line 24172 ""
if (c1ommac_1.ilmac == c1ommac_1.il2mac[commac_1.macnum - 1]) {
/* Getting last line of macro. */
-#line 24182 ""
+#line 24176 ""
ip2 = c1ommac_1.ip2mac[commac_1.macnum - 1];
-#line 24183 ""
+#line 24177 ""
} else {
/* Getting line before last line of macro. */
-#line 24187 ""
+#line 24181 ""
ip2 = c1ommac_1.iplmac + inbuff_1.lbuf[c1ommac_1.ilmac - 1];
-#line 24188 ""
+#line 24182 ""
}
-#line 24189 ""
+#line 24183 ""
if (ip2 >= ip1) {
-#line 24190 ""
+#line 24184 ""
s_copy(string, inbuff_1.bufq + (ip1 - 1), string_len, ip2 - (ip1
- 1));
-#line 24191 ""
+#line 24185 ""
} else {
/* Kluge for when macro start is on a line by itself */
-#line 24195 ""
+#line 24189 ""
s_copy(string, " ", string_len, (ftnlen)1);
-#line 24196 ""
+#line 24190 ""
}
-#line 24197 ""
+#line 24191 ""
++c1ommac_1.ilmac;
-#line 24198 ""
+#line 24192 ""
return 0;
-#line 24199 ""
+#line 24193 ""
}
-#line 24200 ""
+#line 24194 ""
return 0;
} /* read10_ */
@@ -60138,123 +60415,123 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen
/* file 10 (jobname.pmx) and increments nline if needed, passes over */
/* comment lines */
-#line 24209 ""
+#line 24203 ""
L4:
-#line 24209 ""
+#line 24203 ""
if (*iccount == 128) {
-#line 24210 ""
+#line 24204 ""
L1:
-#line 24210 ""
+#line 24204 ""
getbuf_(lineq, (ftnlen)128);
-#line 24211 ""
+#line 24205 ""
++(*nline);
-#line 24212 ""
+#line 24206 ""
if (*(unsigned char *)lineq == '%') {
-#line 24212 ""
+#line 24206 ""
goto L1;
-#line 24212 ""
+#line 24206 ""
}
-#line 24213 ""
+#line 24207 ""
*iccount = 0;
-#line 24214 ""
+#line 24208 ""
}
-#line 24215 ""
+#line 24209 ""
++(*iccount);
/* Find next non-blank or end of line */
-#line 24219 ""
+#line 24213 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
-#line 24220 ""
+#line 24214 ""
if (*(unsigned char *)&lineq[*iccount - 1] != ' ') {
-#line 24220 ""
+#line 24214 ""
goto L3;
-#line 24220 ""
+#line 24214 ""
}
-#line 24221 ""
+#line 24215 ""
/* L2: */
-#line 24221 ""
+#line 24215 ""
}
/* If here, need to get a new line */
-#line 24225 ""
+#line 24219 ""
*iccount = 128;
-#line 24226 ""
+#line 24220 ""
goto L4;
-#line 24227 ""
+#line 24221 ""
L3:
/* iccount now points to start of number to read */
-#line 24231 ""
+#line 24225 ""
i1 = *iccount;
-#line 24232 ""
+#line 24226 ""
L5:
-#line 24232 ""
+#line 24226 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar increments iccount, then reads a character. */
-#line 24236 ""
+#line 24230 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 24236 ""
+#line 24230 ""
goto L5;
-#line 24236 ""
+#line 24230 ""
}
-#line 24237 ""
+#line 24231 ""
i2 = *iccount - 1;
-#line 24238 ""
+#line 24232 ""
if (i2 < i1) {
-#line 24239 ""
+#line 24233 ""
s_wsle(&io___1721);
/* Writing concatenation */
-#line 24239 ""
+#line 24233 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 24239 ""
+#line 24233 ""
i__1[1] = 1, a__1[1] = durq;
-#line 24239 ""
+#line 24233 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 24239 ""
+#line 24233 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 24239 ""
+#line 24233 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 24239 ""
+#line 24233 ""
e_wsle();
-#line 24240 ""
+#line 24234 ""
stop1_();
-#line 24241 ""
+#line 24235 ""
}
-#line 24242 ""
+#line 24236 ""
icf = i2 - i1 + 49;
-#line 24243 ""
+#line 24237 ""
ici__1.icierr = 0;
-#line 24243 ""
+#line 24237 ""
ici__1.iciend = 0;
-#line 24243 ""
+#line 24237 ""
ici__1.icirnum = 1;
-#line 24243 ""
+#line 24237 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 24243 ""
+#line 24237 ""
ici__1.iciunit = lineq + (i1 - 1);
/* Writing concatenation */
-#line 24243 ""
+#line 24237 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 24243 ""
+#line 24237 ""
chax_(ch__3, (ftnlen)1, &icf);
-#line 24243 ""
+#line 24237 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 24243 ""
+#line 24237 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 24243 ""
+#line 24237 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 24243 ""
+#line 24237 ""
s_rsfi(&ici__1);
-#line 24243 ""
+#line 24237 ""
do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
-#line 24243 ""
+#line 24237 ""
e_rsfi();
-#line 24244 ""
+#line 24238 ""
return ret_val;
} /* readin_ */
@@ -60264,7 +60541,7 @@ L5:
/* System generated locals */
address a__1[3];
integer i__1, i__2[3];
- char ch__1[4], ch__2[1];
+ char ch__1[1], ch__2[4];
icilist ici__1;
/* Builtin functions */
@@ -60280,160 +60557,166 @@ L5:
extern /* Subroutine */ int getchar_(char *, integer *, char *, ftnlen,
ftnlen);
-#line 24249 ""
+#line 24243 ""
i__1 = *iccount;
-#line 24249 ""
- if (i_indx(lineq + i__1, "/", *iccount + 3 - i__1, (ftnlen)1) == 0) {
+#line 24243 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 24243 ""
+ if (i_indx(lineq + i__1, ch__1, *iccount + 3 - i__1, (ftnlen)1) == 0) {
/* No slashes, so use old method */
-#line 24253 ""
+#line 24247 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24254 ""
+#line 24248 ""
if (*(unsigned char *)durq == '-') {
/* Negative numerator is used only to printed; signals vertical slash */
-#line 24258 ""
+#line 24252 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24259 ""
+#line 24253 ""
*mtrnum = -(*(unsigned char *)durq - 48);
-#line 24260 ""
+#line 24254 ""
} else if (*(unsigned char *)durq == 'o') {
/* Numerator is EXACTLY 1 */
-#line 24264 ""
+#line 24258 ""
*mtrnum = 1;
-#line 24265 ""
+#line 24259 ""
} else {
-#line 24266 ""
+#line 24260 ""
*mtrnum = *(unsigned char *)durq - 48;
-#line 24267 ""
+#line 24261 ""
if (*mtrnum == 1) {
/* Numerator is >9 */
-#line 24271 ""
+#line 24265 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24272 ""
+#line 24266 ""
*mtrnum = *(unsigned char *)durq - 38;
-#line 24273 ""
+#line 24267 ""
}
-#line 24274 ""
+#line 24268 ""
}
-#line 24275 ""
+#line 24269 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24276 ""
+#line 24270 ""
if (*(unsigned char *)durq == 'o') {
-#line 24277 ""
+#line 24271 ""
*mtrden = 1;
-#line 24278 ""
+#line 24272 ""
} else {
-#line 24279 ""
+#line 24273 ""
*mtrden = *(unsigned char *)durq - 48;
-#line 24280 ""
+#line 24274 ""
if (*mtrden == 1) {
-#line 24281 ""
+#line 24275 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24282 ""
+#line 24276 ""
*mtrden = *(unsigned char *)durq - 38;
-#line 24283 ""
+#line 24277 ""
}
-#line 24284 ""
+#line 24278 ""
}
-#line 24285 ""
+#line 24279 ""
} else {
/* Expect the form m[n1]/[n2]/[n3]/[n4] . Advance iccount by one from '/' or 'm' */
-#line 24289 ""
+#line 24283 ""
++(*iccount);
-#line 24290 ""
- ns = i_indx(lineq + (*iccount - 1), "/", 128 - (*iccount - 1), (
+#line 24284 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 24284 ""
+ ns = i_indx(lineq + (*iccount - 1), ch__1, 128 - (*iccount - 1), (
ftnlen)1);
-#line 24291 ""
+#line 24285 ""
ici__1.icierr = 0;
-#line 24291 ""
+#line 24285 ""
ici__1.iciend = 0;
-#line 24291 ""
+#line 24285 ""
ici__1.icirnum = 1;
-#line 24291 ""
+#line 24285 ""
ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
-#line 24291 ""
+#line 24285 ""
ici__1.iciunit = lineq + (*iccount - 1);
/* Writing concatenation */
-#line 24291 ""
+#line 24285 ""
i__2[0] = 2, a__1[0] = "(i";
-#line 24291 ""
+#line 24285 ""
i__1 = ns + 47;
-#line 24291 ""
- chax_(ch__2, (ftnlen)1, &i__1);
-#line 24291 ""
- i__2[1] = 1, a__1[1] = ch__2;
-#line 24291 ""
+#line 24285 ""
+ chax_(ch__1, (ftnlen)1, &i__1);
+#line 24285 ""
+ i__2[1] = 1, a__1[1] = ch__1;
+#line 24285 ""
i__2[2] = 1, a__1[2] = ")";
-#line 24291 ""
- ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
-#line 24291 ""
+#line 24285 ""
+ ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2);
+#line 24285 ""
s_rsfi(&ici__1);
-#line 24291 ""
+#line 24285 ""
do_fio(&c__1, (char *)&(*mtrnum), (ftnlen)sizeof(integer));
-#line 24291 ""
+#line 24285 ""
e_rsfi();
/* Reset iccount to start of second integer */
-#line 24295 ""
+#line 24289 ""
*iccount += ns;
/* There must be either a slash or a blank at pos'n 2 or 3 */
-#line 24299 ""
- ns = i_indx(lineq + (*iccount - 1), "/", (ftnlen)3, (ftnlen)1);
-#line 24300 ""
+#line 24293 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 24293 ""
+ ns = i_indx(lineq + (*iccount - 1), ch__1, (ftnlen)3, (ftnlen)1);
+#line 24294 ""
if (ns == 0) {
-#line 24300 ""
+#line 24294 ""
ns = i_indx(lineq + (*iccount - 1), " ", (ftnlen)3, (ftnlen)1);
-#line 24300 ""
+#line 24294 ""
}
-#line 24301 ""
+#line 24295 ""
ici__1.icierr = 0;
-#line 24301 ""
+#line 24295 ""
ici__1.iciend = 0;
-#line 24301 ""
+#line 24295 ""
ici__1.icirnum = 1;
-#line 24301 ""
+#line 24295 ""
ici__1.icirlen = *iccount + ns - 2 - (*iccount - 1);
-#line 24301 ""
+#line 24295 ""
ici__1.iciunit = lineq + (*iccount - 1);
/* Writing concatenation */
-#line 24301 ""
+#line 24295 ""
i__2[0] = 2, a__1[0] = "(i";
-#line 24301 ""
+#line 24295 ""
i__1 = ns + 47;
-#line 24301 ""
- chax_(ch__2, (ftnlen)1, &i__1);
-#line 24301 ""
- i__2[1] = 1, a__1[1] = ch__2;
-#line 24301 ""
+#line 24295 ""
+ chax_(ch__1, (ftnlen)1, &i__1);
+#line 24295 ""
+ i__2[1] = 1, a__1[1] = ch__1;
+#line 24295 ""
i__2[2] = 1, a__1[2] = ")";
-#line 24301 ""
- ici__1.icifmt = (s_cat(ch__1, a__1, i__2, &c__3, (ftnlen)4), ch__1);
-#line 24301 ""
+#line 24295 ""
+ ici__1.icifmt = (s_cat(ch__2, a__1, i__2, &c__3, (ftnlen)4), ch__2);
+#line 24295 ""
s_rsfi(&ici__1);
-#line 24301 ""
+#line 24295 ""
do_fio(&c__1, (char *)&(*mtrden), (ftnlen)sizeof(integer));
-#line 24301 ""
+#line 24295 ""
e_rsfi();
/* Set iccount to last character used */
-#line 24305 ""
+#line 24299 ""
*iccount = *iccount + ns - 1;
-#line 24306 ""
+#line 24300 ""
}
-#line 24307 ""
+#line 24301 ""
return 0;
} /* readmeter_ */
@@ -60469,78 +60752,78 @@ L5:
/* call this routine *after* detecting a number or decimal. */
/* On exit, durq is next character after end of number. */
-#line 24318 ""
+#line 24312 ""
i1 = *iccount;
-#line 24319 ""
+#line 24313 ""
L1:
-#line 24319 ""
+#line 24313 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24320 ""
+#line 24314 ""
if (i_indx("0123456789.", durq, (ftnlen)11, (ftnlen)1) > 0) {
-#line 24320 ""
+#line 24314 ""
goto L1;
-#line 24320 ""
+#line 24314 ""
}
-#line 24321 ""
+#line 24315 ""
i2 = *iccount - 1;
-#line 24322 ""
+#line 24316 ""
if (i2 < i1) {
-#line 24323 ""
+#line 24317 ""
s_wsle(&io___1727);
/* Writing concatenation */
-#line 24323 ""
+#line 24317 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 24323 ""
+#line 24317 ""
i__1[1] = 1, a__1[1] = durq;
-#line 24323 ""
+#line 24317 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 24323 ""
+#line 24317 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 24323 ""
+#line 24317 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 24323 ""
+#line 24317 ""
e_wsle();
-#line 24324 ""
+#line 24318 ""
stop1_();
-#line 24325 ""
+#line 24319 ""
} else if (*(unsigned char *)&lineq[i1 - 1] == '.' && *(unsigned char *)&
lineq[i2 - 1] == '.') {
-#line 24326 ""
+#line 24320 ""
--i2;
-#line 24327 ""
+#line 24321 ""
--(*iccount);
-#line 24328 ""
+#line 24322 ""
}
-#line 24329 ""
+#line 24323 ""
icf = i2 - i1 + 49;
-#line 24330 ""
+#line 24324 ""
ici__1.icierr = 0;
-#line 24330 ""
+#line 24324 ""
ici__1.iciend = 0;
-#line 24330 ""
+#line 24324 ""
ici__1.icirnum = 1;
-#line 24330 ""
+#line 24324 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 24330 ""
+#line 24324 ""
ici__1.iciunit = lineq + (i1 - 1);
/* Writing concatenation */
-#line 24330 ""
+#line 24324 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 24330 ""
+#line 24324 ""
chax_(ch__3, (ftnlen)1, &icf);
-#line 24330 ""
+#line 24324 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 24330 ""
+#line 24324 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 24330 ""
+#line 24324 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 24330 ""
+#line 24324 ""
s_rsfi(&ici__1);
-#line 24330 ""
+#line 24324 ""
do_fio(&c__1, (char *)&(*fnum), (ftnlen)sizeof(real));
-#line 24330 ""
+#line 24324 ""
e_rsfi();
-#line 24331 ""
+#line 24325 ""
return 0;
} /* readnum_ */
@@ -60556,13 +60839,13 @@ L1:
/* Sets iwidbits of isdata, shifted by ishift, to ivalue */
-#line 24337 ""
+#line 24331 ""
ibase = pow_ii(&c__2, iwidbit) - 1;
-#line 24338 ""
+#line 24332 ""
*isdata = ~ lbit_shift(ibase, *ishift) & *isdata;
-#line 24339 ""
+#line 24333 ""
*isdata |= lbit_shift(*ivalue, *ishift);
-#line 24340 ""
+#line 24334 ""
return 0;
} /* setbits_ */
@@ -60584,97 +60867,97 @@ L1:
/* The MEAN SQUARE slope algorithm */
-#line 24362 ""
+#line 24356 ""
/* Parameter adjustments */
-#line 24362 ""
+#line 24356 ""
--ipb;
-#line 24362 ""
+#line 24356 ""
--xelsk;
-#line 24362 ""
+#line 24356 ""
-#line 24362 ""
+#line 24356 ""
/* Function Body */
-#line 24362 ""
+#line 24356 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
-#line 24363 ""
+#line 24357 ""
sumxx = 0.f;
-#line 24364 ""
+#line 24358 ""
sumxy = 0.f;
-#line 24365 ""
+#line 24359 ""
i__1 = *nnb;
-#line 24365 ""
+#line 24359 ""
for (inb = 1; inb <= i__1; ++inb) {
/* Computing 2nd power */
-#line 24366 ""
+#line 24360 ""
r__1 = xelsk[inb];
-#line 24366 ""
+#line 24360 ""
sumxx += r__1 * r__1;
-#line 24367 ""
+#line 24361 ""
sumxy += xelsk[inb] * all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
-#line 24368 ""
+#line 24362 ""
/* L2: */
-#line 24368 ""
+#line 24362 ""
}
-#line 24369 ""
+#line 24363 ""
delta = *nnb * sumxx - *sumx * *sumx;
-#line 24370 ""
+#line 24364 ""
em = (*nnb * sumxy - *sumx * *sumy) / delta;
-#line 24371 ""
+#line 24365 ""
r__1 = em * .5f * all_1.slfac;
-#line 24371 ""
+#line 24365 ""
*islope = i_nint(&r__1);
-#line 24372 ""
+#line 24366 ""
if (abs(*islope) > 9) {
-#line 24372 ""
+#line 24366 ""
*islope = i_sign(&c__9, islope);
-#line 24372 ""
+#line 24366 ""
}
-#line 24373 ""
+#line 24367 ""
beta = (*sumy - *islope / all_1.slfac * *sumx) / *nnb;
-#line 24374 ""
+#line 24368 ""
*nolev1 = i_nint(&beta);
/* Check if any stems are too short */
-#line 24378 ""
+#line 24372 ""
smin = 100.f;
-#line 24379 ""
+#line 24373 ""
iul = -1;
-#line 24380 ""
+#line 24374 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
-#line 24380 ""
+#line 24374 ""
iul = 1;
-#line 24380 ""
+#line 24374 ""
}
-#line 24381 ""
+#line 24375 ""
i__1 = *nnb;
-#line 24381 ""
+#line 24375 ""
for (inb = 1; inb <= i__1; ++inb) {
-#line 24382 ""
+#line 24376 ""
ybeam = *nolev1 + iul * all_1.stemlen + *islope * xelsk[inb] /
all_1.slfac;
-#line 24383 ""
+#line 24377 ""
ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
/* Computing MIN */
-#line 24384 ""
+#line 24378 ""
r__1 = smin, r__2 = iul * (ybeam - ynote);
-#line 24384 ""
+#line 24378 ""
smin = dmin(r__1,r__2);
-#line 24385 ""
+#line 24379 ""
/* L4: */
-#line 24385 ""
+#line 24379 ""
}
-#line 24386 ""
+#line 24380 ""
if (smin < all_1.stemmin) {
-#line 24387 ""
+#line 24381 ""
deficit = all_1.stemmin - smin;
-#line 24388 ""
+#line 24382 ""
r__1 = *nolev1 + iul * deficit;
-#line 24388 ""
+#line 24382 ""
*nolev1 = i_nint(&r__1);
-#line 24389 ""
+#line 24383 ""
}
-#line 24390 ""
+#line 24384 ""
return 0;
} /* setbm2_ */
@@ -60710,157 +60993,157 @@ L1:
/* Macro action */
-#line 24403 ""
+#line 24397 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 24404 ""
+#line 24398 ""
if (*(unsigned char *)charq == 'S' && *ivx != 1) {
-#line 24405 ""
+#line 24399 ""
s_wsle(&io___1742);
-#line 24405 ""
+#line 24399 ""
e_wsle();
-#line 24406 ""
+#line 24400 ""
s_wsle(&io___1743);
-#line 24406 ""
+#line 24400 ""
e_wsle();
-#line 24407 ""
+#line 24401 ""
s_wsle(&io___1744);
-#line 24407 ""
+#line 24401 ""
do_lio(&c__9, &c__1, "*********WARNING*********", (ftnlen)25);
-#line 24407 ""
+#line 24401 ""
e_wsle();
-#line 24408 ""
+#line 24402 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24408 ""
+#line 24402 ""
errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2"\
"prt if in voice #1!", (ftnlen)128, (ftnlen)53);
-#line 24410 ""
+#line 24404 ""
}
-#line 24411 ""
+#line 24405 ""
if (i_indx("RSP ", charq, (ftnlen)4, (ftnlen)1) == 0) {
-#line 24412 ""
+#line 24406 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24412 ""
+#line 24406 ""
errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro"\
")!", (ftnlen)128, (ftnlen)36);
-#line 24414 ""
+#line 24408 ""
stop1_();
-#line 24415 ""
+#line 24409 ""
} else if (*(unsigned char *)charq != ' ') {
/* Record or playback a macro. Get the number of the macro. */
-#line 24419 ""
+#line 24413 ""
g1etchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24420 ""
+#line 24414 ""
if (i_indx("123456789", durq, (ftnlen)9, (ftnlen)1) == 0) {
-#line 24421 ""
+#line 24415 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24421 ""
+#line 24415 ""
errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\""\
",\"MP\", or \"MS\"!", (ftnlen)128, (ftnlen)43);
-#line 24423 ""
+#line 24417 ""
stop1_();
-#line 24424 ""
+#line 24418 ""
}
-#line 24425 ""
+#line 24419 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 24426 ""
+#line 24420 ""
commac_1.macnum = i_nint(&fnum);
-#line 24427 ""
+#line 24421 ""
if (*(unsigned char *)durq != ' ') {
-#line 24428 ""
+#line 24422 ""
i__1 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24428 ""
+#line 24422 ""
errmsg_(lineq, iccount, &i__1, "Macro number must be followed by"\
" a blank!", (ftnlen)128, (ftnlen)41);
-#line 24430 ""
+#line 24424 ""
stop1_();
-#line 24431 ""
+#line 24425 ""
}
-#line 24432 ""
+#line 24426 ""
if (i_indx("RS", charq, (ftnlen)2, (ftnlen)1) > 0) {
/* Record or save a macro */
-#line 24436 ""
+#line 24430 ""
if (commac_1.macnum < 1 || commac_1.macnum > 20) {
-#line 24437 ""
+#line 24431 ""
i__1 = *iccount - 1;
-#line 24437 ""
+#line 24431 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24437 ""
+#line 24431 ""
errmsg_(lineq, &i__1, &i__2, "Macro number not in range 1-20!"
, (ftnlen)128, (ftnlen)31);
-#line 24439 ""
+#line 24433 ""
stop1_();
-#line 24440 ""
+#line 24434 ""
}
-#line 24441 ""
+#line 24435 ""
commac_1.macuse = bit_set(commac_1.macuse,commac_1.macnum);
-#line 24442 ""
+#line 24436 ""
if (*(unsigned char *)charq == 'R') {
-#line 24443 ""
+#line 24437 ""
m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
ftnlen)128);
-#line 24444 ""
+#line 24438 ""
} else if (*(unsigned char *)charq == 'S') {
/* Save (Record but don't activate) */
-#line 24448 ""
+#line 24442 ""
L1:
-#line 24448 ""
+#line 24442 ""
m1rec1_(lineq, iccount, ibarcnt, ibaroff, nbars, &ndxm, (
ftnlen)128);
-#line 24449 ""
+#line 24443 ""
if (commac_1.mrecord) {
-#line 24450 ""
+#line 24444 ""
getbuf_(lineq, (ftnlen)128);
-#line 24451 ""
+#line 24445 ""
++(*nline);
-#line 24452 ""
+#line 24446 ""
*iccount = 0;
-#line 24453 ""
+#line 24447 ""
goto L1;
-#line 24454 ""
+#line 24448 ""
}
-#line 24455 ""
+#line 24449 ""
*iccount = *iccount + ndxm + 1;
-#line 24456 ""
+#line 24450 ""
}
-#line 24457 ""
+#line 24451 ""
} else {
/* Playback the macro */
-#line 24461 ""
+#line 24455 ""
if (! bit_test(commac_1.macuse,commac_1.macnum)) {
-#line 24462 ""
+#line 24456 ""
i__1 = *iccount - 1;
-#line 24462 ""
+#line 24456 ""
i__2 = *ibarcnt - *ibaroff + *nbars + 1;
-#line 24462 ""
+#line 24456 ""
errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n"\
"ot been recorded!", (ftnlen)128, (ftnlen)47);
-#line 24464 ""
+#line 24458 ""
stop1_();
-#line 24465 ""
+#line 24459 ""
}
-#line 24466 ""
+#line 24460 ""
commac_1.icchold = *iccount;
-#line 24467 ""
+#line 24461 ""
s_copy(commac_1.lnholdq, lineq, (ftnlen)128, (ftnlen)128);
-#line 24468 ""
+#line 24462 ""
*iccount = 128;
-#line 24469 ""
+#line 24463 ""
commac_1.mplay = TRUE_;
-#line 24470 ""
+#line 24464 ""
c1ommac_1.ilmac = c1ommac_1.il1mac[commac_1.macnum - 1];
-#line 24471 ""
+#line 24465 ""
}
-#line 24472 ""
+#line 24466 ""
}
-#line 24473 ""
+#line 24467 ""
return 0;
} /* setmac_ */
@@ -60875,67 +61158,67 @@ L1:
/* 3: triple w/ denom=8, subdivide in groups of 3 8ths */
/* Note that lenbar is set at top or when 'm' symbol is read in getnote */
-#line 24484 ""
+#line 24478 ""
if (*mtrdenl == 4) {
-#line 24485 ""
+#line 24479 ""
if (*mtrnuml % 3 == 0) {
-#line 24486 ""
+#line 24480 ""
*ibmtyp = 2;
-#line 24487 ""
+#line 24481 ""
*ibmrep = *mtrnuml / 3;
-#line 24488 ""
+#line 24482 ""
} else {
-#line 24489 ""
+#line 24483 ""
*ibmtyp = 1;
-#line 24490 ""
+#line 24484 ""
*ibmrep = *mtrnuml / 2;
-#line 24491 ""
+#line 24485 ""
}
-#line 24492 ""
+#line 24486 ""
} else if (*mtrdenl == 2) {
-#line 24493 ""
+#line 24487 ""
*ibmtyp = 1;
-#line 24494 ""
+#line 24488 ""
if (*mtrnuml == 3) {
-#line 24495 ""
+#line 24489 ""
*ibmrep = 3;
-#line 24496 ""
+#line 24490 ""
} else {
-#line 24497 ""
+#line 24491 ""
*ibmrep = (*mtrnuml << 1) / *mtrdenl;
-#line 24498 ""
+#line 24492 ""
}
-#line 24499 ""
+#line 24493 ""
} else if (*mtrdenl == 8 && (*mtrnuml == 8 || *mtrnuml == 4)) {
/* Added 170726 */
-#line 24503 ""
+#line 24497 ""
*ibmtyp = 1;
-#line 24504 ""
+#line 24498 ""
*ibmrep = *mtrnuml / 4;
-#line 24505 ""
+#line 24499 ""
} else {
/* Assumes mtrdenl=8 and 3/8, 6/8, 9/8, or 12/8 */
-#line 24509 ""
+#line 24503 ""
*ibmtyp = 3;
-#line 24510 ""
+#line 24504 ""
*ibmrep = *mtrnuml / 3;
-#line 24511 ""
+#line 24505 ""
}
/* Reset so we don't keep writing new meters */
-#line 24515 ""
+#line 24509 ""
*mtrnuml = 0;
/* Prevent ibmrep=0. Needed for odd bars, e.g. 1/8, where beams don't matter */
-#line 24519 ""
+#line 24513 ""
*ibmrep = max(*ibmrep,1);
-#line 24520 ""
+#line 24514 ""
return 0;
} /* setmeter_ */
@@ -60980,86 +61263,86 @@ L1:
/* The outer combo algorithm */
-#line 24554 ""
+#line 24548 ""
/* Parameter adjustments */
-#line 24554 ""
+#line 24548 ""
--ipb;
-#line 24554 ""
+#line 24548 ""
--xelsk;
-#line 24554 ""
+#line 24548 ""
-#line 24554 ""
+#line 24548 ""
/* Function Body */
-#line 24554 ""
+#line 24548 ""
ibc = all_1.ibmcnt[commvl_1.ivx - 1];
-#line 24555 ""
+#line 24549 ""
comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
-#line 24556 ""
+#line 24550 ""
n1 = comipl2_1.ipl2[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 -
25] * 24 - 25];
/* Initialize counters used in this subroutine, and then later during actual */
/* beam drawing, to count later segments of single-slope beam groups */
-#line 24561 ""
+#line 24555 ""
comxtup_2.nssb[commvl_1.ivx - 1] = 0;
-#line 24562 ""
+#line 24556 ""
comxtup_2.issb[commvl_1.ivx - 1] = 0;
/* Set flag for xtup beam starting with rest (no others can start with rest) */
-#line 24566 ""
+#line 24560 ""
if (bit_test(all_1.irest[commvl_1.ivx + all_1.ipo[n1 - 1] * 24 - 25],0)) {
-#line 24566 ""
+#line 24560 ""
*ixrest = 1;
-#line 24566 ""
+#line 24560 ""
}
/* Figure how many elemskips to each note. Use the list, counting only non-rests. */
-#line 24570 ""
+#line 24564 ""
eskz0 = all_1.eskz[commvl_1.ivx + all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]
* 24 - 25];
-#line 24571 ""
+#line 24565 ""
*nnb = 0;
-#line 24572 ""
+#line 24566 ""
*sumx = 0.f;
-#line 24573 ""
+#line 24567 ""
*sumy = 0.f;
-#line 24574 ""
+#line 24568 ""
ipxt1 = 0;
-#line 24575 ""
+#line 24569 ""
iplast = all_1.ibm2[commvl_1.ivx + ibc * 24 - 25];
-#line 24576 ""
+#line 24570 ""
i__1 = iplast;
-#line 24576 ""
+#line 24570 ""
for (ip = all_1.ibm1[commvl_1.ivx + ibc * 24 - 25]; ip <= i__1; ++ip) {
-#line 24577 ""
+#line 24571 ""
if (! bit_test(all_1.irest[commvl_1.ivx + ip * 24 - 25],0)) {
-#line 24578 ""
+#line 24572 ""
++(*nnb);
-#line 24579 ""
+#line 24573 ""
ipb[*nnb] = ip;
-#line 24580 ""
+#line 24574 ""
xelsk[*nnb] = all_1.eskz[commvl_1.ivx + ip * 24 - 25] - eskz0;
-#line 24581 ""
+#line 24575 ""
*sumx += xelsk[*nnb];
-#line 24582 ""
+#line 24576 ""
*sumy += all_1.nolev[commvl_1.ivx + ipb[*nnb] * 24 - 25];
-#line 24583 ""
+#line 24577 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],21)) {
/* This is the starting note of later segment of single-slope beam group */
/* Temporarily store ip here. */
-#line 24588 ""
+#line 24582 ""
++comxtup_2.nssb[commvl_1.ivx - 1];
-#line 24589 ""
+#line 24583 ""
comxtup_2.lev1ssb[commvl_1.ivx + comxtup_2.nssb[commvl_1.ivx
- 1] * 24 - 25] = *nnb;
-#line 24590 ""
+#line 24584 ""
}
-#line 24591 ""
+#line 24585 ""
}
/* New xtup stuff here. Final object is to get distance from start of xtup */
@@ -61067,220 +61350,224 @@ L1:
/* number. ntupv is number of notes in xtup, and is only used to get */
/* eloff, the distance from start of xtup to the number. */
-#line 24598 ""
+#line 24592 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
-#line 24598 ""
+#line 24592 ""
++ndoub;
-#line 24598 ""
+#line 24592 ""
}
-#line 24599 ""
+#line 24593 ""
if (ipxt1 == 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] == 0) {
/* Xtup is starting here */
-#line 24603 ""
+#line 24597 ""
++comxtup_2.nxtinbm[commvl_1.ivx - 1];
-#line 24604 ""
+#line 24598 ""
ipxt1 = ip;
-#line 24605 ""
+#line 24599 ""
if (bit_test(all_1.nacc[commvl_1.ivx + ip * 24 - 25],18)) {
-#line 24606 ""
+#line 24600 ""
ndoub = 1;
-#line 24607 ""
+#line 24601 ""
} else {
-#line 24608 ""
+#line 24602 ""
ndoub = 0;
-#line 24609 ""
+#line 24603 ""
}
-#line 24610 ""
+#line 24604 ""
} else if (ipxt1 > 0 && all_1.nodur[commvl_1.ivx + ip * 24 - 25] > 0)
{
/* Xtup ends here. Set total number of notes in xtup. */
-#line 24614 ""
+#line 24608 ""
comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
* 24 - 25] = ip + 1 - ipxt1;
/* Set printed number for embedded xtup. */
-#line 24618 ""
+#line 24612 ""
comxtup_2.mtupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
* 24 - 25] = comxtup_2.ntupv[commvl_1.ivx +
comxtup_2.nxtinbm[commvl_1.ivx - 1] * 24 - 25] + ndoub;
/* Middle note of xtup if ntupv odd, note to left of gap if even. */
-#line 24622 ""
+#line 24616 ""
ipxtmid = (ip + ipxt1) / 2;
-#line 24623 ""
+#line 24617 ""
comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx - 1]
* 24 - 25] = comeskz2_1.eskz2[commvl_1.ivx + ipxtmid *
24 - 25] - comeskz2_1.eskz2[commvl_1.ivx + ipxt1 * 24 -
25];
-#line 24624 ""
+#line 24618 ""
if (comxtup_2.ntupv[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx
- 1] * 24 - 25] % 2 == 0) {
-#line 24624 ""
+#line 24618 ""
comxtup_2.eloff[commvl_1.ivx + comxtup_2.nxtinbm[commvl_1.ivx
- 1] * 24 - 25] += (comeskz2_1.eskz2[commvl_1.ivx + (
ipxtmid + 1) * 24 - 25] - comeskz2_1.eskz2[
commvl_1.ivx + ipxtmid * 24 - 25]) * .5f;
-#line 24624 ""
+#line 24618 ""
}
-#line 24627 ""
+#line 24621 ""
ipxt1 = 0;
-#line 24628 ""
+#line 24622 ""
}
-#line 24629 ""
+#line 24623 ""
/* L2: */
-#line 24629 ""
+#line 24623 ""
}
/* Reset nxtinbm for use as counter as #'s are posted by putxtn(..) */
-#line 24633 ""
+#line 24627 ""
comxtup_2.nxtinbm[commvl_1.ivx - 1] = 0;
-#line 24634 ""
+#line 24628 ""
*smed = 0.f;
/* if (.not.btest(islur(ivx,ipb(1)),2)) then */
-#line 24636 ""
+#line 24630 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *nnb >
1) {
/* No forced 0 slope */
/* if (nnb .eq. 1) go to 6 */
-#line 24641 ""
+#line 24635 ""
nsc = 0;
-#line 24642 ""
+#line 24636 ""
i__1 = *nnb - 1;
-#line 24642 ""
+#line 24636 ""
for (inb = 1; inb <= i__1; ++inb) {
-#line 24643 ""
+#line 24637 ""
i__2 = *nnb;
-#line 24643 ""
+#line 24637 ""
for (jnb = inb + 1; jnb <= i__2; ++jnb) {
-#line 24644 ""
+#line 24638 ""
++nsc;
-#line 24645 ""
+#line 24639 ""
slope[nsc - 1] = (all_1.nolev[commvl_1.ivx + ipb[jnb] * 24 -
25] - all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25])
/ (xelsk[jnb] - xelsk[inb]);
-#line 24647 ""
+#line 24641 ""
if ((r__1 = slope[nsc - 1], dabs(r__1)) < 1e-4f) {
-#line 24648 ""
+#line 24642 ""
++nsc;
-#line 24649 ""
+#line 24643 ""
slope[nsc - 1] = slope[nsc - 2];
-#line 24650 ""
+#line 24644 ""
++nsc;
-#line 24651 ""
+#line 24645 ""
slope[nsc - 1] = slope[nsc - 2];
-#line 24652 ""
+#line 24646 ""
}
-#line 24653 ""
-/* L5: */
-#line 24653 ""
+#line 24647 ""
+/* L5999: */
+#line 24647 ""
}
-#line 24653 ""
+#line 24648 ""
+/* L5: */
+#line 24648 ""
}
-#line 24654 ""
+#line 24649 ""
if (nsc == 1) {
-#line 24655 ""
+#line 24650 ""
*smed = slope[0];
-#line 24656 ""
+#line 24651 ""
goto L6;
-#line 24657 ""
+#line 24652 ""
}
-#line 24658 ""
+#line 24653 ""
nscmid = nsc / 2 + 1;
-#line 24659 ""
- i__2 = nscmid;
-#line 24659 ""
- for (i__ = 1; i__ <= i__2; ++i__) {
-#line 24660 ""
- i__1 = nsc;
-#line 24660 ""
- for (j = i__ + 1; j <= i__1; ++j) {
-#line 24661 ""
+#line 24654 ""
+ i__1 = nscmid;
+#line 24654 ""
+ for (i__ = 1; i__ <= i__1; ++i__) {
+#line 24655 ""
+ i__2 = nsc;
+#line 24655 ""
+ for (j = i__ + 1; j <= i__2; ++j) {
+#line 24656 ""
if (slope[j - 1] < slope[i__ - 1]) {
-#line 24662 ""
+#line 24657 ""
t = slope[j - 1];
-#line 24663 ""
+#line 24658 ""
slope[j - 1] = slope[i__ - 1];
-#line 24664 ""
+#line 24659 ""
slope[i__ - 1] = t;
-#line 24665 ""
+#line 24660 ""
}
-#line 24666 ""
-/* L7: */
-#line 24666 ""
+#line 24661 ""
+/* L7999: */
+#line 24661 ""
}
-#line 24666 ""
+#line 24662 ""
+/* L7: */
+#line 24662 ""
}
-#line 24667 ""
+#line 24663 ""
*smed = slope[nscmid - 1];
-#line 24668 ""
+#line 24664 ""
if (nsc == nsc / 2 << 1) {
/* Even number of slopes in the list, so median is ambiguous */
-#line 24672 ""
+#line 24668 ""
if ((r__2 = slope[nscmid - 2], dabs(r__2)) < (r__1 = slope[nscmid
- 1], dabs(r__1)) - comtol_1.tol) {
/* Lower-numbered one is truly less in absolute value, so use it */
-#line 24676 ""
+#line 24672 ""
*smed = slope[nscmid - 2];
-#line 24677 ""
+#line 24673 ""
} else if ((r__1 = slope[nscmid - 2] + slope[nscmid - 1], dabs(
r__1)) < comtol_1.tol) {
/* Two slopes are effectively equal. Take the one with sign of the average */
-#line 24681 ""
+#line 24677 ""
sum = 0.f;
-#line 24682 ""
+#line 24678 ""
i__1 = nsc;
-#line 24682 ""
+#line 24678 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 24683 ""
+#line 24679 ""
sum += slope[i__ - 1];
-#line 24684 ""
+#line 24680 ""
/* L1: */
-#line 24684 ""
+#line 24680 ""
}
-#line 24685 ""
+#line 24681 ""
*smed = r_sign(smed, &sum);
-#line 24686 ""
+#line 24682 ""
}
-#line 24687 ""
+#line 24683 ""
}
-#line 24688 ""
+#line 24684 ""
L6:
-#line 24689 ""
+#line 24685 ""
r__1 = *smed * .5f * all_1.slfac;
-#line 24689 ""
+#line 24685 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
-#line 24690 ""
+#line 24686 ""
if ((i__1 = comxtup_2.islope[commvl_1.ivx - 1], abs(i__1)) > 9) {
-#line 24690 ""
+#line 24686 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_sign(&c__9, &
comxtup_2.islope[commvl_1.ivx - 1]);
-#line 24690 ""
+#line 24686 ""
}
-#line 24692 ""
+#line 24688 ""
} else {
/* Forced horizontal beam */
-#line 24696 ""
+#line 24692 ""
comxtup_2.islope[commvl_1.ivx - 1] = 0;
-#line 24697 ""
+#line 24693 ""
}
-#line 24698 ""
+#line 24694 ""
beta = (*sumy - comxtup_2.islope[commvl_1.ivx - 1] / all_1.slfac * *sumx)
/ *nnb;
@@ -61288,90 +61575,90 @@ L6:
/* as is for placing xtup number and/or bracket, then reset it for start of */
/* actual beam */
-#line 24704 ""
+#line 24700 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&beta);
/* Check if any stems are too short */
-#line 24708 ""
+#line 24704 ""
smin = 100.f;
-#line 24709 ""
+#line 24705 ""
iul = -1;
-#line 24710 ""
+#line 24706 ""
if (*(unsigned char *)&all_1.ulq[commvl_1.ivx + ibc * 24 - 25] == 'u') {
-#line 24710 ""
+#line 24706 ""
iul = 1;
-#line 24710 ""
+#line 24706 ""
}
-#line 24711 ""
+#line 24707 ""
ssq = 0.f;
-#line 24712 ""
+#line 24708 ""
syb = 0.f;
-#line 24713 ""
+#line 24709 ""
yb1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * (all_1.stemlen +
combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 -
25]) - 9));
-#line 24715 ""
+#line 24711 ""
i__1 = *nnb;
-#line 24715 ""
+#line 24711 ""
for (inb = 1; inb <= i__1; ++inb) {
-#line 24716 ""
+#line 24712 ""
ybeam = yb1 + comxtup_2.islope[commvl_1.ivx - 1] * xelsk[inb] /
all_1.slfac - iul * combmh_1.bmhgt * ((15 & all_1.mult[
commvl_1.ivx + ipb[inb] * 24 - 25]) - 9);
-#line 24718 ""
+#line 24714 ""
syb += ybeam;
-#line 24719 ""
+#line 24715 ""
ynote = (real) all_1.nolev[commvl_1.ivx + ipb[inb] * 24 - 25];
-#line 24720 ""
+#line 24716 ""
off = ybeam - ynote;
-#line 24721 ""
+#line 24717 ""
if (inb == 1) {
-#line 24722 ""
+#line 24718 ""
off1 = off;
-#line 24723 ""
+#line 24719 ""
} else if (inb == *nnb) {
-#line 24724 ""
+#line 24720 ""
off2 = off;
-#line 24725 ""
+#line 24721 ""
}
-#line 24726 ""
+#line 24722 ""
ssq += off * off;
/* Computing MIN */
-#line 24727 ""
+#line 24723 ""
r__1 = smin, r__2 = iul * off;
-#line 24727 ""
+#line 24723 ""
smin = dmin(r__1,r__2);
-#line 24728 ""
+#line 24724 ""
/* L4: */
-#line 24728 ""
+#line 24724 ""
}
-#line 24729 ""
+#line 24725 ""
dnolev = 0.f;
-#line 24730 ""
+#line 24726 ""
if (smin < all_1.stemmin) {
-#line 24731 ""
+#line 24727 ""
deficit = all_1.stemmin - smin;
-#line 24732 ""
+#line 24728 ""
nolevo = comxtup_2.nolev1[commvl_1.ivx - 1];
-#line 24733 ""
+#line 24729 ""
r__1 = comxtup_2.nolev1[commvl_1.ivx - 1] + iul * deficit;
-#line 24733 ""
+#line 24729 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
-#line 24734 ""
+#line 24730 ""
dnolev = (real) (comxtup_2.nolev1[commvl_1.ivx - 1] - nolevo);
-#line 24735 ""
+#line 24731 ""
off1 += dnolev;
-#line 24736 ""
+#line 24732 ""
off2 += dnolev;
-#line 24737 ""
+#line 24733 ""
}
/* Computing 2nd power */
-#line 24738 ""
+#line 24734 ""
r__1 = dnolev;
-#line 24738 ""
+#line 24734 ""
ssq = ssq + dnolev * 2 * (syb - *sumy) + r__1 * r__1;
-#line 24739 ""
+#line 24735 ""
if (! comxtup_2.vxtup[commvl_1.ivx - 1] && sqrt(ssq / *nnb) >
all_1.stemmax && (dabs(off1) < all_1.stemmax || dabs(off2) <
all_1.stemmax) && ! bit_test(all_1.islur[commvl_1.ivx + ipb[1] *
@@ -61382,83 +61669,83 @@ L6:
/* The penultimate check is that first and last stems aren't both excessive. */
/* The last check is that a 0 slope has not been forced */
-#line 24749 ""
+#line 24745 ""
setbm2_(&xelsk[1], nnb, sumx, sumy, &ipb[1], &comxtup_2.islope[
commvl_1.ivx - 1], &comxtup_2.nolev1[commvl_1.ivx - 1]);
-#line 24750 ""
+#line 24746 ""
}
/* Check if beam starts or ends too high or low. */
-#line 24754 ""
+#line 24750 ""
xboff = combmh_1.bmhgt * ((15 & all_1.mult[commvl_1.ivx + ipb[1] * 24 -
25]) - 9);
-#line 24755 ""
+#line 24751 ""
l1ng = iul * (comxtup_2.nolev1[commvl_1.ivx - 1] - ncmid_(&all_1.iv, &ipb[
1])) + xboff + 7 < 0.f;
-#line 24756 ""
+#line 24752 ""
xnolev2 = comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[
commvl_1.ivx - 1] / all_1.slfac * xelsk[*nnb];
-#line 24757 ""
+#line 24753 ""
l2ng = iul * (xnolev2 - ncmid_(&all_1.iv, &ipb[*nnb])) + xboff + 7 < 0.f;
-#line 24758 ""
+#line 24754 ""
if (l1ng || l2ng) {
/* Need to correct start or stop, also slope */
-#line 24762 ""
+#line 24758 ""
if (l1ng) {
-#line 24763 ""
+#line 24759 ""
r__1 = ncmid_(&all_1.iv, &ipb[1]) - (xboff + 7.f) * iul;
-#line 24763 ""
+#line 24759 ""
comxtup_2.nolev1[commvl_1.ivx - 1] = i_nint(&r__1);
-#line 24764 ""
+#line 24760 ""
}
-#line 24765 ""
+#line 24761 ""
if (l2ng) {
-#line 24766 ""
+#line 24762 ""
r__1 = ncmid_(&all_1.iv, &ipb[*nnb]) - (xboff + 7.f) * iul;
-#line 24766 ""
+#line 24762 ""
xnolev2 = (real) i_nint(&r__1);
-#line 24767 ""
+#line 24763 ""
}
/* Since one or the other end has changed, need to change slope */
/* if (.not.btest(islur(ivx,ipb(1)),2)) */
-#line 24772 ""
+#line 24768 ""
if (! bit_test(all_1.islur[commvl_1.ivx + ipb[1] * 24 - 25],2) && *
nnb != 1) {
-#line 24772 ""
+#line 24768 ""
r__1 = all_1.slfac * (xnolev2 - comxtup_2.nolev1[commvl_1.ivx - 1]
) / xelsk[*nnb];
-#line 24772 ""
+#line 24768 ""
comxtup_2.islope[commvl_1.ivx - 1] = i_nint(&r__1);
-#line 24772 ""
+#line 24768 ""
}
-#line 24774 ""
+#line 24770 ""
}
-#line 24775 ""
+#line 24771 ""
if (comxtup_2.nssb[commvl_1.ivx - 1] > 0) {
/* This is a single-slope beam group. Store start heights for later segs. */
-#line 24779 ""
+#line 24775 ""
i__1 = comxtup_2.nssb[commvl_1.ivx - 1];
-#line 24779 ""
+#line 24775 ""
for (issbs = 1; issbs <= i__1; ++issbs) {
-#line 24780 ""
+#line 24776 ""
comxtup_2.lev1ssb[commvl_1.ivx + issbs * 24 - 25] =
comxtup_2.nolev1[commvl_1.ivx - 1] + comxtup_2.islope[
commvl_1.ivx - 1] / all_1.slfac * xelsk[comxtup_2.lev1ssb[
commvl_1.ivx + issbs * 24 - 25]];
-#line 24782 ""
+#line 24778 ""
/* L3: */
-#line 24782 ""
+#line 24778 ""
}
-#line 24783 ""
+#line 24779 ""
}
-#line 24784 ""
+#line 24780 ""
return 0;
} /* setupb_ */
@@ -61473,60 +61760,60 @@ L6:
/* Initialize ipoe: */
-#line 24793 ""
+#line 24789 ""
/* Parameter adjustments */
-#line 24793 ""
+#line 24789 ""
--ipoe;
-#line 24793 ""
+#line 24789 ""
--poe;
-#line 24793 ""
+#line 24789 ""
-#line 24793 ""
+#line 24789 ""
/* Function Body */
-#line 24793 ""
+#line 24789 ""
i__1 = *nsyst;
-#line 24793 ""
+#line 24789 ""
for (iord = 1; iord <= i__1; ++iord) {
-#line 24794 ""
+#line 24790 ""
ipoe[iord] = iord;
-#line 24795 ""
+#line 24791 ""
/* L3: */
-#line 24795 ""
+#line 24791 ""
}
/* Construct ipoe vector with pairwise interchanges. When done, ipoe(1) will */
/* be index of smallest poe, and ipoe(nsyst) will be index of biggest poe. */
-#line 24800 ""
+#line 24796 ""
i__1 = *nsyst - 1;
-#line 24800 ""
+#line 24796 ""
for (io1 = 1; io1 <= i__1; ++io1) {
-#line 24801 ""
+#line 24797 ""
i__2 = *nsyst;
-#line 24801 ""
+#line 24797 ""
for (io2 = io1 + 1; io2 <= i__2; ++io2) {
-#line 24802 ""
+#line 24798 ""
if (poe[ipoe[io1]] > poe[ipoe[io2]]) {
/* Interchange the indices */
-#line 24806 ""
+#line 24802 ""
itemp = ipoe[io1];
-#line 24807 ""
+#line 24803 ""
ipoe[io1] = ipoe[io2];
-#line 24808 ""
+#line 24804 ""
ipoe[io2] = itemp;
-#line 24809 ""
+#line 24805 ""
}
-#line 24810 ""
+#line 24806 ""
/* L5: */
-#line 24810 ""
+#line 24806 ""
}
-#line 24811 ""
+#line 24807 ""
/* L4: */
-#line 24811 ""
+#line 24807 ""
}
-#line 24812 ""
+#line 24808 ""
return 0;
} /* sortpoe_ */
@@ -61563,114 +61850,114 @@ L6:
/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */
-#line 24837 ""
+#line 24833 ""
/* Parameter adjustments */
-#line 24837 ""
+#line 24833 ""
--isdat4;
-#line 24837 ""
+#line 24833 ""
--isdat3;
-#line 24837 ""
+#line 24833 ""
--isdat2;
-#line 24837 ""
+#line 24833 ""
--isdat1;
-#line 24837 ""
+#line 24833 ""
-#line 24837 ""
+#line 24833 ""
/* Function Body */
-#line 24837 ""
+#line 24833 ""
numint = 0;
-#line 24838 ""
+#line 24834 ""
ivoff = 0;
-#line 24839 ""
+#line 24835 ""
ihoff = 0;
-#line 24840 ""
+#line 24836 ""
++(*nsdat);
-#line 24841 ""
+#line 24837 ""
if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
{
-#line 24841 ""
+#line 24837 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
-#line 24841 ""
+#line 24837 ""
}
-#line 24843 ""
+#line 24839 ""
setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
-#line 24844 ""
+#line 24840 ""
i__1 = *kv - 1;
-#line 24844 ""
+#line 24840 ""
setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
-#line 24845 ""
+#line 24841 ""
setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
-#line 24846 ""
+#line 24842 ""
isdat3[*nsdat] = 0;
-#line 24847 ""
+#line 24843 ""
isdat4[*nsdat] = 0;
-#line 24848 ""
+#line 24844 ""
ilb12 = 0;
/* Get ID code */
/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */
-#line 24852 ""
+#line 24848 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* if (index('uldtb+-hfnHps ',durq) .gt. 0) then */
-#line 24854 ""
+#line 24850 ""
if (i_indx("uldtb+-hfnHpsv ", durq, (ftnlen)15, (ftnlen)1) > 0) {
/* Null id. Note for ps slurs, 'H' cannot be an ID */
-#line 24858 ""
+#line 24854 ""
--(*iccount);
-#line 24859 ""
+#line 24855 ""
if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
-#line 24860 ""
+#line 24856 ""
idcode = 1;
-#line 24861 ""
+#line 24857 ""
} else {
-#line 24862 ""
+#line 24858 ""
idcode = 32;
-#line 24863 ""
+#line 24859 ""
}
-#line 24864 ""
+#line 24860 ""
} else {
/* Set explicit idcode */
-#line 24868 ""
+#line 24864 ""
idcode = *(unsigned char *)durq;
-#line 24869 ""
+#line 24865 ""
i__1 = *iccount - 2;
-#line 24869 ""
+#line 24865 ""
if (s_cmp(lineq + i__1, "t", *iccount - 1 - i__1, (ftnlen)1) == 0) {
/* Make t[ID] look like s[ID]t */
-#line 24873 ""
+#line 24869 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
-#line 24874 ""
+#line 24870 ""
}
-#line 24875 ""
+#line 24871 ""
i__1 = *iccount;
-#line 24875 ""
+#line 24871 ""
if (s_cmp(lineq + i__1, "x", *iccount + 1 - i__1, (ftnlen)1) == 0) {
/* Flag for 2-voice, indexed slurs */
-#line 24879 ""
+#line 24875 ""
++(*iccount);
-#line 24880 ""
+#line 24876 ""
setbits_(&isdat1[*nsdat], &c__1, &c__1, &c__1);
-#line 24881 ""
+#line 24877 ""
}
-#line 24882 ""
+#line 24878 ""
}
-#line 24883 ""
+#line 24879 ""
setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
/* Set start/stop: look thru list from end for same idcode,iv,kv */
-#line 24887 ""
+#line 24883 ""
for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
-#line 24888 ""
+#line 24884 ""
if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv ==
igetbits_(&isdat1[isdat], &c__5, &c__13) && (*kv - 1 ==
igetbits_(&isdat1[isdat], &c__1, &c__12) || bit_test(isdat1[
@@ -61679,372 +61966,372 @@ L6:
/* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */
-#line 24896 ""
+#line 24892 ""
if (bit_test(isdat1[isdat],11)) {
-#line 24896 ""
+#line 24892 ""
goto L3;
-#line 24896 ""
+#line 24892 ""
}
/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */
-#line 24900 ""
+#line 24896 ""
goto L4;
-#line 24901 ""
+#line 24897 ""
}
-#line 24902 ""
+#line 24898 ""
/* L2: */
-#line 24902 ""
+#line 24898 ""
}
/* If here, this is turnon. */
-#line 24906 ""
+#line 24902 ""
L4:
-#line 24907 ""
+#line 24903 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
-#line 24908 ""
+#line 24904 ""
L3:
/* Now done with initial turnon- or turnoff-specifics. */
-#line 24912 ""
+#line 24908 ""
if (i_nint(&comslur_1.slurcurve) != 0 && bit_test(isdat1[*nsdat],11)) {
/* There's a default curvature tweak */
-#line 24916 ""
+#line 24912 ""
icurv1 = i_nint(&comslur_1.slurcurve) + 3;
-#line 24917 ""
+#line 24913 ""
if (icurv1 == 2) {
-#line 24917 ""
+#line 24913 ""
icurv1 = 1;
-#line 24917 ""
+#line 24913 ""
}
-#line 24918 ""
+#line 24914 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
-#line 24919 ""
+#line 24915 ""
i__1 = icurv1 + 32;
-#line 24919 ""
+#line 24915 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
-#line 24920 ""
+#line 24916 ""
}
/* Loop for rest of input */
-#line 24924 ""
+#line 24920 ""
L1:
-#line 24924 ""
+#line 24920 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 24925 ""
+#line 24921 ""
if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Force direction */
-#line 24929 ""
+#line 24925 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
-#line 24930 ""
+#line 24926 ""
if (*(unsigned char *)durq == 'u') {
-#line 24930 ""
+#line 24926 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
-#line 24930 ""
+#line 24926 ""
}
-#line 24931 ""
+#line 24927 ""
goto L1;
-#line 24932 ""
+#line 24928 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 24933 ""
+#line 24929 ""
++numint;
-#line 24934 ""
+#line 24930 ""
if (numint == 1) {
/* Vertical offset */
-#line 24938 ""
+#line 24934 ""
++(*iccount);
-#line 24939 ""
+#line 24935 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 24940 ""
+#line 24936 ""
--(*iccount);
-#line 24941 ""
+#line 24937 ""
ivoff = i_nint(&fnum);
-#line 24942 ""
+#line 24938 ""
if (*(unsigned char *)durq == '-') {
-#line 24942 ""
+#line 24938 ""
ivoff = -ivoff;
-#line 24942 ""
+#line 24938 ""
}
-#line 24943 ""
+#line 24939 ""
} else if (numint == 2) {
/* Horizontal offset */
-#line 24947 ""
+#line 24943 ""
++(*iccount);
-#line 24948 ""
+#line 24944 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 24949 ""
+#line 24945 ""
--(*iccount);
/* fnum is abs(hshift), must be 0 to 6.3 */
-#line 24953 ""
+#line 24949 ""
ihoff = fnum * 10 + .5f;
-#line 24954 ""
+#line 24950 ""
if (*(unsigned char *)durq == '-') {
-#line 24954 ""
+#line 24950 ""
ihoff = -ihoff;
-#line 24954 ""
+#line 24950 ""
}
/* Later will set bits to 1...127 to represent -6.3,...+6.3 */
-#line 24958 ""
+#line 24954 ""
} else {
/* Must be the 3rd signed integer, so it's a curve specification */
-#line 24962 ""
+#line 24958 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
-#line 24963 ""
+#line 24959 ""
++(*iccount);
-#line 24964 ""
+#line 24960 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 24965 ""
+#line 24961 ""
icurv1 = i_nint(&fnum);
-#line 24966 ""
+#line 24962 ""
if (*(unsigned char *)durq == '-') {
-#line 24966 ""
+#line 24962 ""
icurv1 = -icurv1;
-#line 24966 ""
+#line 24962 ""
}
-#line 24967 ""
+#line 24963 ""
i__1 = icurv1 + 32;
-#line 24967 ""
+#line 24963 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
-#line 24968 ""
+#line 24964 ""
if (*(unsigned char *)dumq != ':') {
/* Back up the pointer and loop for more input */
-#line 24972 ""
+#line 24968 ""
--(*iccount);
-#line 24973 ""
+#line 24969 ""
} else {
/* Expect two single digits as parameters for curve */
-#line 24977 ""
+#line 24973 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
-#line 24978 ""
+#line 24974 ""
i__1 = *iccount;
-#line 24978 ""
+#line 24974 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
-#line 24978 ""
+#line 24974 ""
setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
-#line 24980 ""
+#line 24976 ""
i__1 = *iccount + 1;
-#line 24980 ""
+#line 24976 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
-#line 24980 ""
+#line 24976 ""
setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
-#line 24982 ""
+#line 24978 ""
*iccount += 2;
-#line 24983 ""
+#line 24979 ""
}
-#line 24984 ""
+#line 24980 ""
}
-#line 24985 ""
+#line 24981 ""
goto L1;
-#line 24986 ""
+#line 24982 ""
} else if (*(unsigned char *)durq == 't') {
-#line 24987 ""
+#line 24983 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
-#line 24988 ""
+#line 24984 ""
goto L1;
-#line 24989 ""
+#line 24985 ""
} else if (*(unsigned char *)durq == 'b') {
-#line 24990 ""
+#line 24986 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
-#line 24991 ""
+#line 24987 ""
goto L1;
-#line 24992 ""
+#line 24988 ""
} else if (*(unsigned char *)durq == 's') {
/* Endpoint tweaks for linebreak slurs. */
-#line 24996 ""
+#line 24992 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Next is vertical offset */
/* Must be +|- */
-#line 25000 ""
+#line 24996 ""
++(*iccount);
-#line 25001 ""
+#line 24997 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 25002 ""
+#line 24998 ""
if (*(unsigned char *)durq == '-') {
-#line 25002 ""
+#line 24998 ""
fnum = -fnum;
-#line 25002 ""
+#line 24998 ""
}
-#line 25003 ""
+#line 24999 ""
i__1 = ilb12 << 4;
-#line 25003 ""
+#line 24999 ""
i__2 = i_nint(&fnum) + 32;
-#line 25003 ""
+#line 24999 ""
setbits_(&isdat4[*nsdat], &c__6, &i__1, &i__2);
-#line 25004 ""
+#line 25000 ""
if (i_indx("+-", dumq, (ftnlen)2, (ftnlen)1) > 0) {
/* Also a horizontal offset */
-#line 25008 ""
+#line 25004 ""
++(*iccount);
-#line 25009 ""
+#line 25005 ""
readnum_(lineq, iccount, durq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 25010 ""
+#line 25006 ""
if (*(unsigned char *)dumq == '-') {
-#line 25010 ""
+#line 25006 ""
fnum = -fnum;
-#line 25010 ""
+#line 25006 ""
}
-#line 25011 ""
+#line 25007 ""
i__1 = (ilb12 << 4) + 6;
-#line 25011 ""
+#line 25007 ""
r__1 = fnum * 10;
-#line 25011 ""
+#line 25007 ""
i__2 = i_nint(&r__1) + 64;
-#line 25011 ""
+#line 25007 ""
setbits_(&isdat4[*nsdat], &c__7, &i__1, &i__2);
-#line 25012 ""
+#line 25008 ""
}
-#line 25013 ""
+#line 25009 ""
--(*iccount);
-#line 25014 ""
+#line 25010 ""
ilb12 = 1;
-#line 25015 ""
+#line 25011 ""
goto L1;
-#line 25016 ""
+#line 25012 ""
} else if (i_indx("fnhH", durq, (ftnlen)4, (ftnlen)1) > 0) {
/* Special ps slur curvatures. */
/* Translate to old \midslur args (1,4,5,6) */
-#line 25021 ""
+#line 25017 ""
icurv1 = i_indx("fnxhH", durq, (ftnlen)5, (ftnlen)1);
-#line 25022 ""
+#line 25018 ""
if (icurv1 == 5) {
/* check for 2nd H */
-#line 25026 ""
+#line 25022 ""
i__1 = *iccount;
-#line 25026 ""
+#line 25022 ""
if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
{
-#line 25027 ""
+#line 25023 ""
++(*iccount);
-#line 25028 ""
+#line 25024 ""
icurv1 = 6;
-#line 25029 ""
+#line 25025 ""
}
-#line 25030 ""
+#line 25026 ""
}
-#line 25031 ""
+#line 25027 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
-#line 25032 ""
+#line 25028 ""
i__1 = icurv1 + 32;
-#line 25032 ""
+#line 25028 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
-#line 25033 ""
+#line 25029 ""
goto L1;
-#line 25034 ""
+#line 25030 ""
} else if (*(unsigned char *)durq == 'p') {
/* Local adjustment */
-#line 25035 ""
+#line 25031 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
/* +|- */
-#line 25036 ""
+#line 25032 ""
getchar_(lineq, iccount, dumq, (ftnlen)128, (ftnlen)1);
/* 26 \sluradjust (p+s) */
/* 27 \nosluradjust (p-s) */
/* 28 \tieadjust (p+t) */
/* 29 \notieadjust (p-t) */
/* s|t */
-#line 25041 ""
+#line 25037 ""
if (*(unsigned char *)durq == '+') {
-#line 25042 ""
+#line 25038 ""
if (*(unsigned char *)dumq == 's') {
-#line 25043 ""
+#line 25039 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],26);
-#line 25044 ""
+#line 25040 ""
} else {
-#line 25045 ""
+#line 25041 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],28);
-#line 25046 ""
+#line 25042 ""
}
-#line 25047 ""
+#line 25043 ""
} else {
-#line 25048 ""
+#line 25044 ""
if (*(unsigned char *)dumq == 's') {
-#line 25049 ""
+#line 25045 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],27);
-#line 25050 ""
+#line 25046 ""
} else {
-#line 25051 ""
+#line 25047 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],29);
-#line 25052 ""
+#line 25048 ""
}
-#line 25053 ""
+#line 25049 ""
}
-#line 25054 ""
+#line 25050 ""
goto L1;
-#line 25055 ""
+#line 25051 ""
} else if (*(unsigned char *)durq == 'v') {
/* Stem slur */
-#line 25056 ""
+#line 25052 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],2);
-#line 25057 ""
+#line 25053 ""
goto L1;
-#line 25058 ""
+#line 25054 ""
}
/* Record shifts */
-#line 25062 ""
+#line 25058 ""
i__1 = ivoff + 32;
-#line 25062 ""
+#line 25058 ""
setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
-#line 25063 ""
+#line 25059 ""
i__1 = ihoff + 64;
-#line 25063 ""
+#line 25059 ""
setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
/* Record chord flag, note level, notehead shift */
-#line 25067 ""
+#line 25063 ""
if (*notcrd) {
-#line 25068 ""
+#line 25064 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
-#line 25069 ""
+#line 25065 ""
} else {
-#line 25070 ""
+#line 25066 ""
nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
c__12);
-#line 25071 ""
+#line 25067 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
-#line 25072 ""
+#line 25068 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
-#line 25073 ""
+#line 25069 ""
i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
c__23);
-#line 25073 ""
+#line 25069 ""
setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
-#line 25074 ""
+#line 25070 ""
}
-#line 25075 ""
+#line 25071 ""
return 0;
} /* spsslur_ */
@@ -62079,346 +62366,346 @@ L1:
/* Counter for signed integers. 1st is height, 2nd is horiz, 3rd is curve */
-#line 25100 ""
+#line 25096 ""
/* Parameter adjustments */
-#line 25100 ""
+#line 25096 ""
--isdat3;
-#line 25100 ""
+#line 25096 ""
--isdat2;
-#line 25100 ""
+#line 25096 ""
--isdat1;
-#line 25100 ""
+#line 25096 ""
-#line 25100 ""
+#line 25096 ""
/* Function Body */
-#line 25100 ""
+#line 25096 ""
numint = 0;
-#line 25101 ""
+#line 25097 ""
ivoff = 0;
-#line 25102 ""
+#line 25098 ""
ihoff = 0;
-#line 25103 ""
+#line 25099 ""
++(*nsdat);
-#line 25104 ""
+#line 25100 ""
if (*(unsigned char *)starter == '{' || *(unsigned char *)starter == '}')
{
-#line 25104 ""
+#line 25100 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
-#line 25104 ""
+#line 25100 ""
}
-#line 25106 ""
+#line 25102 ""
setbits_(&isdat1[*nsdat], &c__5, &c__13, iv);
-#line 25107 ""
+#line 25103 ""
i__1 = *kv - 1;
-#line 25107 ""
+#line 25103 ""
setbits_(&isdat1[*nsdat], &c__1, &c__12, &i__1);
-#line 25108 ""
+#line 25104 ""
setbits_(&isdat1[*nsdat], &c__8, &c__3, ip);
-#line 25109 ""
+#line 25105 ""
isdat3[*nsdat] = 0;
/* Get id letter */
-#line 25113 ""
+#line 25109 ""
if (*(unsigned char *)&lineq[*iccount - 1] == 't') {
/* Old-style t-slur. Use special idcode = 1 */
-#line 25117 ""
+#line 25113 ""
idcode = 1;
-#line 25118 ""
+#line 25114 ""
} else {
-#line 25119 ""
+#line 25115 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 25120 ""
+#line 25116 ""
if (i_indx("uldtb+-hf ", durq, (ftnlen)10, (ftnlen)1) > 0) {
/* Null id */
-#line 25124 ""
+#line 25120 ""
idcode = 32;
-#line 25125 ""
+#line 25121 ""
--(*iccount);
-#line 25126 ""
+#line 25122 ""
} else if (*(unsigned char *)durq == 'H') {
/* Postscript slur, cannot use 'H' as code, must check for 2nd 'H' */
-#line 25130 ""
+#line 25126 ""
idcode = 32;
-#line 25131 ""
+#line 25127 ""
--(*iccount);
/* There may be another "H", but no need to deal with it yet */
-#line 25135 ""
+#line 25131 ""
} else {
/* Set explicit idcode */
-#line 25139 ""
+#line 25135 ""
idcode = *(unsigned char *)durq;
-#line 25140 ""
+#line 25136 ""
}
-#line 25141 ""
+#line 25137 ""
}
-#line 25142 ""
+#line 25138 ""
setbits_(&isdat1[*nsdat], &c__7, &c__19, &idcode);
/* Set start/stop: look thru list from end for same idcode,iv,kv */
-#line 25146 ""
+#line 25142 ""
for (isdat = *nsdat - 1; isdat >= 1; --isdat) {
-#line 25147 ""
+#line 25143 ""
if (idcode == igetbits_(&isdat1[isdat], &c__7, &c__19) && *iv ==
igetbits_(&isdat1[isdat], &c__5, &c__13) && *kv - 1 ==
igetbits_(&isdat1[isdat], &c__1, &c__12)) {
/* Matched idcode & ivx. On/off?. If on, new is turnoff, leave bit 11 at 0. */
-#line 25153 ""
+#line 25149 ""
if (bit_test(isdat1[isdat],11)) {
-#line 25153 ""
+#line 25149 ""
goto L3;
-#line 25153 ""
+#line 25149 ""
}
/* Found slur is a turnoff, so new one is a turnon. Jump down to set bit */
-#line 25157 ""
+#line 25153 ""
goto L4;
-#line 25158 ""
+#line 25154 ""
}
-#line 25159 ""
+#line 25155 ""
/* L2: */
-#line 25159 ""
+#line 25155 ""
}
/* If here, this is turnon. */
-#line 25163 ""
+#line 25159 ""
L4:
-#line 25164 ""
+#line 25160 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],11);
-#line 25165 ""
+#line 25161 ""
L3:
/* Now done with initial turnon- or turnoff-specifics. Loop for rest of input */
-#line 25169 ""
+#line 25165 ""
L1:
-#line 25169 ""
+#line 25165 ""
getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1);
-#line 25170 ""
+#line 25166 ""
if (i_indx("uld", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Force direction */
-#line 25174 ""
+#line 25170 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],26);
-#line 25175 ""
+#line 25171 ""
if (*(unsigned char *)durq == 'u') {
-#line 25175 ""
+#line 25171 ""
isdat1[*nsdat] = bit_set(isdat1[*nsdat],27);
-#line 25175 ""
+#line 25171 ""
}
-#line 25176 ""
+#line 25172 ""
goto L1;
-#line 25177 ""
+#line 25173 ""
} else if (i_indx("+-", durq, (ftnlen)2, (ftnlen)1) > 0) {
-#line 25178 ""
+#line 25174 ""
++numint;
-#line 25179 ""
+#line 25175 ""
if (numint == 1) {
/* Vertical offset */
-#line 25183 ""
+#line 25179 ""
++(*iccount);
-#line 25184 ""
+#line 25180 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 25185 ""
+#line 25181 ""
--(*iccount);
-#line 25186 ""
+#line 25182 ""
ivoff = i_nint(&fnum);
-#line 25187 ""
+#line 25183 ""
if (*(unsigned char *)durq == '-') {
-#line 25187 ""
+#line 25183 ""
ivoff = -ivoff;
-#line 25187 ""
+#line 25183 ""
}
-#line 25188 ""
+#line 25184 ""
} else if (numint == 2) {
/* Horizontal offset */
-#line 25192 ""
+#line 25188 ""
++(*iccount);
-#line 25193 ""
+#line 25189 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 25194 ""
+#line 25190 ""
--(*iccount);
/* fnum is abs(hshift), must be 0 to 6.3 */
-#line 25198 ""
+#line 25194 ""
ihoff = fnum * 10 + .5f;
-#line 25199 ""
+#line 25195 ""
if (*(unsigned char *)durq == '-') {
-#line 25199 ""
+#line 25195 ""
ihoff = -ihoff;
-#line 25199 ""
+#line 25195 ""
}
/* Later will set bits to 1...127 to represent -6.3,...+6.3 */
-#line 25203 ""
+#line 25199 ""
} else {
/* Must be the 3rd signed integer, so it's a curve specification */
-#line 25207 ""
+#line 25203 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
-#line 25208 ""
+#line 25204 ""
++(*iccount);
-#line 25209 ""
+#line 25205 ""
readnum_(lineq, iccount, dumq, &fnum, (ftnlen)128, (ftnlen)1);
-#line 25210 ""
+#line 25206 ""
icurv1 = i_nint(&fnum);
-#line 25211 ""
+#line 25207 ""
if (*(unsigned char *)durq == '-') {
-#line 25211 ""
+#line 25207 ""
icurv1 = -icurv1;
-#line 25211 ""
+#line 25207 ""
}
-#line 25212 ""
+#line 25208 ""
i__1 = icurv1 + 32;
-#line 25212 ""
+#line 25208 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
-#line 25213 ""
+#line 25209 ""
if (*(unsigned char *)dumq != ':') {
/* Back up the pointer and loop for more input */
-#line 25217 ""
+#line 25213 ""
--(*iccount);
-#line 25218 ""
+#line 25214 ""
} else {
/* Expect two single digits as parameters for curve */
-#line 25222 ""
+#line 25218 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],1);
-#line 25223 ""
+#line 25219 ""
i__1 = *iccount;
-#line 25223 ""
+#line 25219 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
-#line 25223 ""
+#line 25219 ""
setbits_(&isdat3[*nsdat], &c__3, &c__8, &i__2);
-#line 25225 ""
+#line 25221 ""
i__1 = *iccount + 1;
-#line 25225 ""
+#line 25221 ""
i__2 = *(unsigned char *)&lineq[i__1] - 48;
-#line 25225 ""
+#line 25221 ""
setbits_(&isdat3[*nsdat], &c__3, &c__11, &i__2);
-#line 25227 ""
+#line 25223 ""
*iccount += 2;
-#line 25228 ""
+#line 25224 ""
}
-#line 25229 ""
+#line 25225 ""
}
-#line 25230 ""
+#line 25226 ""
goto L1;
-#line 25231 ""
+#line 25227 ""
} else if (*(unsigned char *)durq == 't') {
-#line 25232 ""
+#line 25228 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],3);
-#line 25233 ""
+#line 25229 ""
goto L1;
-#line 25234 ""
+#line 25230 ""
} else if (*(unsigned char *)durq == 'b') {
-#line 25235 ""
+#line 25231 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],4);
-#line 25236 ""
+#line 25232 ""
goto L1;
-#line 25237 ""
+#line 25233 ""
} else if (i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) > 0) {
/* Special ps slur curvatures. Translate to old \midslur args (1,4,5,6) */
-#line 25241 ""
+#line 25237 ""
icurv1 = i_indx("fhH", durq, (ftnlen)3, (ftnlen)1) + 2;
-#line 25242 ""
+#line 25238 ""
if (icurv1 == 3) {
-#line 25243 ""
+#line 25239 ""
icurv1 = 1;
-#line 25244 ""
+#line 25240 ""
} else if (icurv1 == 5) {
/* check for 2nd H */
-#line 25248 ""
+#line 25244 ""
i__1 = *iccount;
-#line 25248 ""
+#line 25244 ""
if (s_cmp(lineq + i__1, "H", *iccount + 1 - i__1, (ftnlen)1) == 0)
{
-#line 25249 ""
+#line 25245 ""
++(*iccount);
-#line 25250 ""
+#line 25246 ""
icurv1 = 6;
-#line 25251 ""
+#line 25247 ""
}
-#line 25252 ""
+#line 25248 ""
}
-#line 25253 ""
+#line 25249 ""
isdat3[*nsdat] = bit_set(isdat3[*nsdat],0);
/* Must change sign if downslur, but cannot do it now since we don't know */
/* slur direction for sure. */
-#line 25258 ""
+#line 25254 ""
i__1 = icurv1 + 32;
-#line 25258 ""
+#line 25254 ""
setbits_(&isdat3[*nsdat], &c__6, &c__2, &i__1);
-#line 25259 ""
+#line 25255 ""
goto L1;
-#line 25260 ""
+#line 25256 ""
}
/* Record shifts */
-#line 25264 ""
+#line 25260 ""
i__1 = ivoff + 32;
-#line 25264 ""
+#line 25260 ""
setbits_(&isdat2[*nsdat], &c__6, &c__6, &i__1);
-#line 25265 ""
+#line 25261 ""
i__1 = ihoff + 64;
-#line 25265 ""
+#line 25261 ""
setbits_(&isdat2[*nsdat], &c__7, &c__12, &i__1);
/* Record chord flag, note level, notehead shift */
-#line 25269 ""
+#line 25265 ""
if (*notcrd) {
-#line 25270 ""
+#line 25266 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, nolev);
-#line 25271 ""
+#line 25267 ""
} else {
-#line 25272 ""
+#line 25268 ""
nolevc = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__7, &
c__12);
-#line 25273 ""
+#line 25269 ""
setbits_(&isdat2[*nsdat], &c__7, &c__19, &nolevc);
-#line 25274 ""
+#line 25270 ""
isdat2[*nsdat] = bit_set(isdat2[*nsdat],0);
-#line 25275 ""
+#line 25271 ""
i__1 = igetbits_(&comtrill_1.icrdat[comtrill_1.ncrd - 1], &c__2, &
c__23);
-#line 25275 ""
+#line 25271 ""
setbits_(&isdat2[*nsdat], &c__2, &c__1, &i__1);
-#line 25276 ""
+#line 25272 ""
}
-#line 25277 ""
+#line 25273 ""
return 0;
} /* sslur_ */
@@ -62426,9 +62713,9 @@ L1:
{
extern /* Subroutine */ int exit_(integer *);
-#line 25280 ""
+#line 25276 ""
exit_(&c__1);
-#line 25281 ""
+#line 25277 ""
return 0;
} /* stop1_ */
@@ -62529,217 +62816,217 @@ L1:
static cilist io___1872 = { 0, 11, 0, "(a)", 0 };
-#line 25310 ""
+#line 25306 ""
/* Parameter adjustments */
-#line 25310 ""
+#line 25306 ""
--clefq;
-#line 25310 ""
+#line 25306 ""
-#line 25310 ""
+#line 25306 ""
/* Function Body */
-#line 25310 ""
+#line 25306 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 25310 ""
+#line 25306 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 25311 ""
+#line 25307 ""
*vshrink = *xinstf1 > 20.f && ! comnvst_1.novshrinktop;
-#line 25312 ""
+#line 25308 ""
if (*vshrink) {
-#line 25313 ""
+#line 25309 ""
comarp_1.xinsnow = 10.f;
-#line 25314 ""
+#line 25310 ""
} else {
-#line 25315 ""
+#line 25311 ""
comarp_1.xinsnow = *xinstf1;
-#line 25316 ""
+#line 25312 ""
}
-#line 25317 ""
+#line 25313 ""
if (! comlast_1.islast) {
-#line 25317 ""
+#line 25313 ""
return 0;
-#line 25317 ""
+#line 25313 ""
}
/* Initialize octave treble clef tracker */
-#line 25321 ""
+#line 25317 ""
for (im = 1; im <= 24; ++im) {
-#line 25322 ""
+#line 25318 ""
comc8flag_1.c8flag[im - 1] = FALSE_;
-#line 25323 ""
+#line 25319 ""
/* L6: */
-#line 25323 ""
+#line 25319 ""
}
-#line 25324 ""
+#line 25320 ""
s_wsfe(&io___1810);
-#line 25324 ""
+#line 25320 ""
do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17);
-#line 25324 ""
+#line 25320 ""
e_wsfe();
-#line 25325 ""
+#line 25321 ""
s_wsfe(&io___1811);
-#line 25325 ""
+#line 25321 ""
do_fio(&c__1, "%", (ftnlen)1);
-#line 25325 ""
+#line 25321 ""
e_wsfe();
-#line 25326 ""
+#line 25322 ""
s_wsfe(&io___1812);
/* Writing concatenation */
-#line 25326 ""
+#line 25322 ""
i__1[0] = 2, a__1[0] = "% ";
-#line 25326 ""
+#line 25322 ""
i__1[1] = *lbase, a__1[1] = basenameq;
-#line 25326 ""
+#line 25322 ""
i__1[2] = 4, a__1[2] = ".tex";
-#line 25326 ""
+#line 25322 ""
s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)50);
-#line 25326 ""
+#line 25322 ""
do_fio(&c__1, ch__2, *lbase + 6);
-#line 25326 ""
+#line 25322 ""
e_wsfe();
-#line 25327 ""
+#line 25323 ""
s_wsfe(&io___1813);
-#line 25327 ""
+#line 25323 ""
do_fio(&c__1, "%", (ftnlen)1);
-#line 25327 ""
+#line 25323 ""
e_wsfe();
-#line 25328 ""
+#line 25324 ""
s_wsfe(&io___1814);
-#line 25328 ""
+#line 25324 ""
do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16);
-#line 25328 ""
+#line 25324 ""
e_wsfe();
-#line 25329 ""
+#line 25325 ""
s_wsfe(&io___1815);
/* Writing concatenation */
-#line 25329 ""
+#line 25325 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25329 ""
+#line 25325 ""
i__2[1] = 14, a__2[1] = "input musixtex";
-#line 25329 ""
+#line 25325 ""
s_cat(ch__3, a__2, i__2, &c__2, (ftnlen)15);
-#line 25329 ""
+#line 25325 ""
do_fio(&c__1, ch__3, (ftnlen)15);
-#line 25329 ""
+#line 25325 ""
e_wsfe();
-#line 25330 ""
+#line 25326 ""
s_wsfe(&io___1816);
/* Writing concatenation */
-#line 25330 ""
+#line 25326 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25330 ""
+#line 25326 ""
i__2[1] = 9, a__2[1] = "input pmx";
-#line 25330 ""
+#line 25326 ""
s_cat(ch__4, a__2, i__2, &c__2, (ftnlen)10);
-#line 25330 ""
+#line 25326 ""
do_fio(&c__1, ch__4, (ftnlen)10);
-#line 25330 ""
+#line 25326 ""
e_wsfe();
-#line 25331 ""
+#line 25327 ""
s_wsfe(&io___1817);
/* Writing concatenation */
-#line 25331 ""
+#line 25327 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25331 ""
+#line 25327 ""
i__3[1] = 15, a__3[1] = "setmaxslurs{24}";
-#line 25331 ""
+#line 25327 ""
i__3[2] = 1, a__3[2] = sq;
-#line 25331 ""
+#line 25327 ""
i__3[3] = 22, a__3[3] = "setmaxinstruments{24}%";
-#line 25331 ""
+#line 25327 ""
s_cat(ch__5, a__3, i__3, &c__4, (ftnlen)39);
-#line 25331 ""
+#line 25327 ""
do_fio(&c__1, ch__5, (ftnlen)39);
-#line 25331 ""
+#line 25327 ""
e_wsfe();
-#line 25333 ""
+#line 25329 ""
if (! (*fontslur)) {
-#line 25333 ""
+#line 25329 ""
s_wsfe(&io___1818);
/* Writing concatenation */
-#line 25333 ""
+#line 25329 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25333 ""
+#line 25329 ""
i__2[1] = 13, a__2[1] = "input musixps";
-#line 25333 ""
+#line 25329 ""
s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
-#line 25333 ""
+#line 25329 ""
do_fio(&c__1, ch__6, (ftnlen)14);
-#line 25333 ""
+#line 25329 ""
e_wsfe();
-#line 25333 ""
+#line 25329 ""
}
/* Need to input musixmad to permit more slurs. */
-#line 25337 ""
+#line 25333 ""
if (*musicsize == 20) {
-#line 25338 ""
+#line 25334 ""
s_wsfe(&io___1819);
/* Writing concatenation */
-#line 25338 ""
+#line 25334 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25338 ""
+#line 25334 ""
i__2[1] = 16, a__2[1] = "normalmusicsize%";
-#line 25338 ""
+#line 25334 ""
s_cat(ch__7, a__2, i__2, &c__2, (ftnlen)17);
-#line 25338 ""
+#line 25334 ""
do_fio(&c__1, ch__7, (ftnlen)17);
-#line 25338 ""
+#line 25334 ""
e_wsfe();
-#line 25339 ""
+#line 25335 ""
} else if (*musicsize == 16) {
-#line 25340 ""
+#line 25336 ""
s_wsfe(&io___1820);
/* Writing concatenation */
-#line 25340 ""
+#line 25336 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25340 ""
+#line 25336 ""
i__2[1] = 15, a__2[1] = "smallmusicsize%";
-#line 25340 ""
+#line 25336 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
-#line 25340 ""
+#line 25336 ""
do_fio(&c__1, ch__8, (ftnlen)16);
-#line 25340 ""
+#line 25336 ""
e_wsfe();
-#line 25341 ""
+#line 25337 ""
} else if (*musicsize == 24) {
-#line 25342 ""
+#line 25338 ""
s_wsfe(&io___1821);
/* Writing concatenation */
-#line 25342 ""
+#line 25338 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25342 ""
+#line 25338 ""
i__2[1] = 15, a__2[1] = "largemusicsize%";
-#line 25342 ""
+#line 25338 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
-#line 25342 ""
+#line 25338 ""
do_fio(&c__1, ch__8, (ftnlen)16);
-#line 25342 ""
+#line 25338 ""
e_wsfe();
/* Eliminate, per Tennent's analysis and musixtex changes since first input */
/* write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// */
/* * 'meterlargefont}%' */
-#line 25348 ""
+#line 25344 ""
} else if (*musicsize == 29) {
-#line 25349 ""
+#line 25345 ""
s_wsfe(&io___1822);
/* Writing concatenation */
-#line 25349 ""
+#line 25345 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25349 ""
+#line 25345 ""
i__2[1] = 15, a__2[1] = "Largemusicsize%";
-#line 25349 ""
+#line 25345 ""
s_cat(ch__8, a__2, i__2, &c__2, (ftnlen)16);
-#line 25349 ""
+#line 25345 ""
do_fio(&c__1, ch__8, (ftnlen)16);
-#line 25349 ""
+#line 25345 ""
e_wsfe();
/* write(11,'(a)')sq//'def'//sq//'meterfont{'//sq// */
/* * 'meterLargefont}%' */
-#line 25352 ""
+#line 25348 ""
}
/* Set sizes. Have sizes per staff in isize(.) and noinst per staff in */
@@ -62747,235 +63034,277 @@ L1:
/* 130324 */
/* iiv = 1 */
-#line 25359 ""
+#line 25355 ""
i__4 = *noinst;
-#line 25359 ""
+#line 25355 ""
for (iinst = 1; iinst <= i__4; ++iinst) {
/* if (isize(iiv) .eq. 1) then */
-#line 25361 ""
+#line 25357 ""
if (comsize_1.isize[iinst - 1] == 1) {
-#line 25362 ""
+#line 25358 ""
if (iinst <= 9) {
-#line 25363 ""
+#line 25359 ""
s_wsfe(&io___1824);
/* Writing concatenation */
-#line 25363 ""
+#line 25359 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25363 ""
+#line 25359 ""
i__2[1] = 7, a__2[1] = "setsize";
-#line 25363 ""
+#line 25359 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25363 ""
+#line 25359 ""
do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25363 ""
+#line 25359 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25363 ""
+#line 25359 ""
i__5[0] = 1, a__4[0] = sq;
-#line 25363 ""
+#line 25359 ""
i__5[1] = 11, a__4[1] = "smallvalue%";
-#line 25363 ""
+#line 25359 ""
s_cat(ch__10, a__4, i__5, &c__2, (ftnlen)12);
-#line 25363 ""
+#line 25359 ""
do_fio(&c__1, ch__10, (ftnlen)12);
-#line 25363 ""
+#line 25359 ""
e_wsfe();
-#line 25365 ""
+#line 25361 ""
} else {
-#line 25366 ""
+#line 25362 ""
s_wsfe(&io___1825);
/* Writing concatenation */
-#line 25366 ""
+#line 25362 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25366 ""
+#line 25362 ""
i__2[1] = 8, a__2[1] = "setsize{";
-#line 25366 ""
+#line 25362 ""
s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9);
-#line 25366 ""
+#line 25362 ""
do_fio(&c__1, ch__11, (ftnlen)9);
-#line 25366 ""
+#line 25362 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25366 ""
+#line 25362 ""
i__1[0] = 1, a__1[0] = "}";
-#line 25366 ""
+#line 25362 ""
i__1[1] = 1, a__1[1] = sq;
-#line 25366 ""
+#line 25362 ""
i__1[2] = 11, a__1[2] = "smallvalue%";
-#line 25366 ""
+#line 25362 ""
s_cat(ch__12, a__1, i__1, &c__3, (ftnlen)13);
-#line 25366 ""
+#line 25362 ""
do_fio(&c__1, ch__12, (ftnlen)13);
-#line 25366 ""
+#line 25362 ""
e_wsfe();
-#line 25368 ""
+#line 25364 ""
}
/* else if (isize(iiv) .eq. 2) then */
-#line 25370 ""
+#line 25366 ""
} else if (comsize_1.isize[iinst - 1] == 2) {
-#line 25371 ""
+#line 25367 ""
if (iinst <= 9) {
-#line 25372 ""
+#line 25368 ""
s_wsfe(&io___1826);
/* Writing concatenation */
-#line 25372 ""
+#line 25368 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25372 ""
+#line 25368 ""
i__2[1] = 7, a__2[1] = "setsize";
-#line 25372 ""
+#line 25368 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25372 ""
+#line 25368 ""
do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25372 ""
+#line 25368 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25372 ""
+#line 25368 ""
i__5[0] = 1, a__4[0] = sq;
-#line 25372 ""
+#line 25368 ""
i__5[1] = 10, a__4[1] = "tinyvalue%";
-#line 25372 ""
+#line 25368 ""
s_cat(ch__13, a__4, i__5, &c__2, (ftnlen)11);
-#line 25372 ""
+#line 25368 ""
do_fio(&c__1, ch__13, (ftnlen)11);
-#line 25372 ""
+#line 25368 ""
e_wsfe();
-#line 25374 ""
+#line 25370 ""
} else {
-#line 25375 ""
+#line 25371 ""
s_wsfe(&io___1827);
/* Writing concatenation */
-#line 25375 ""
+#line 25371 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25375 ""
+#line 25371 ""
i__2[1] = 8, a__2[1] = "setsize{";
-#line 25375 ""
+#line 25371 ""
s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9);
-#line 25375 ""
+#line 25371 ""
do_fio(&c__1, ch__11, (ftnlen)9);
-#line 25375 ""
+#line 25371 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25375 ""
+#line 25371 ""
i__1[0] = 1, a__1[0] = "}";
-#line 25375 ""
+#line 25371 ""
i__1[1] = 1, a__1[1] = sq;
-#line 25375 ""
+#line 25371 ""
i__1[2] = 10, a__1[2] = "tinyvalue%";
-#line 25375 ""
+#line 25371 ""
s_cat(ch__10, a__1, i__1, &c__3, (ftnlen)12);
-#line 25375 ""
+#line 25371 ""
do_fio(&c__1, ch__10, (ftnlen)12);
-#line 25375 ""
+#line 25371 ""
e_wsfe();
-#line 25377 ""
+#line 25373 ""
}
-#line 25378 ""
+#line 25374 ""
}
/* iiv = iiv+nsperi(iinst) */
-#line 25380 ""
+#line 25376 ""
/* L5: */
-#line 25380 ""
+#line 25376 ""
}
-#line 25381 ""
+#line 25377 ""
s_wsfi(&io___1829);
-#line 25381 ""
+#line 25377 ""
do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real));
-#line 25381 ""
+#line 25377 ""
e_wsfi();
-#line 25382 ""
+#line 25378 ""
s_wsfe(&io___1830);
/* Writing concatenation */
-#line 25382 ""
+#line 25378 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25382 ""
+#line 25378 ""
i__2[1] = 13, a__2[1] = "nopagenumbers";
-#line 25382 ""
+#line 25378 ""
s_cat(ch__6, a__2, i__2, &c__2, (ftnlen)14);
-#line 25382 ""
+#line 25378 ""
do_fio(&c__1, ch__6, (ftnlen)14);
-#line 25382 ""
+#line 25378 ""
e_wsfe();
-#line 25383 ""
+#line 25379 ""
s_wsfe(&io___1831);
/* Writing concatenation */
-#line 25383 ""
+#line 25379 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25383 ""
+#line 25379 ""
i__3[1] = 14, a__3[1] = "tracingstats=2";
-#line 25383 ""
+#line 25379 ""
i__3[2] = 1, a__3[2] = sq;
-#line 25383 ""
+#line 25379 ""
i__3[3] = 5, a__3[3] = "relax";
-#line 25383 ""
+#line 25379 ""
s_cat(ch__14, a__3, i__3, &c__4, (ftnlen)21);
-#line 25383 ""
+#line 25379 ""
do_fio(&c__1, ch__14, (ftnlen)21);
-#line 25383 ""
+#line 25379 ""
e_wsfe();
-#line 25384 ""
+#line 25380 ""
s_wsfe(&io___1832);
/* Writing concatenation */
-#line 25384 ""
+#line 25380 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25384 ""
+#line 25380 ""
i__2[1] = 6, a__2[1] = "hsize=";
-#line 25384 ""
+#line 25380 ""
s_cat(ch__15, a__2, i__2, &c__2, (ftnlen)7);
-#line 25384 ""
+#line 25380 ""
do_fio(&c__1, ch__15, (ftnlen)7);
-#line 25384 ""
+#line 25380 ""
i__4 = i_nint(&comtop_1.widthpt);
-#line 25384 ""
+#line 25380 ""
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 25384 ""
+#line 25380 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25384 ""
+#line 25380 ""
e_wsfe();
-#line 25385 ""
+#line 25381 ""
ci__1.cierr = 0;
-#line 25385 ""
+#line 25381 ""
ci__1.ciunit = 11;
/* Writing concatenation */
-#line 25385 ""
+#line 25381 ""
i__1[0] = 5, a__1[0] = "(a6,i";
-#line 25385 ""
+#line 25381 ""
r__1 = comtop_1.height + .1f;
-#line 25385 ""
+#line 25381 ""
i__4 = (integer) r_lg10(&r__1) + 49;
-#line 25385 ""
+#line 25381 ""
chax_(ch__1, (ftnlen)1, &i__4);
-#line 25385 ""
+#line 25381 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 25385 ""
+#line 25381 ""
i__1[2] = 4, a__1[2] = ",a2)";
-#line 25385 ""
+#line 25381 ""
ci__1.cifmt = (s_cat(ch__4, a__1, i__1, &c__3, (ftnlen)10), ch__4);
-#line 25385 ""
+#line 25381 ""
s_wsfe(&ci__1);
/* Writing concatenation */
-#line 25385 ""
+#line 25381 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25385 ""
+#line 25381 ""
i__2[1] = 5, a__2[1] = "vsize";
-#line 25385 ""
+#line 25381 ""
s_cat(ch__16, a__2, i__2, &c__2, (ftnlen)6);
-#line 25385 ""
+#line 25381 ""
do_fio(&c__1, ch__16, (ftnlen)6);
-#line 25385 ""
+#line 25381 ""
i__6 = (integer) (comtop_1.height + .1f);
-#line 25385 ""
+#line 25381 ""
do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer));
-#line 25385 ""
+#line 25381 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25385 ""
+#line 25381 ""
e_wsfe();
-#line 25387 ""
+#line 25383 ""
if (dabs(comtop_1.hoffpt) > .1f) {
-#line 25388 ""
+#line 25384 ""
if (comtop_1.hoffpt <= -10.f) {
-#line 25389 ""
+#line 25385 ""
s_wsfe(&io___1833);
/* Writing concatenation */
+#line 25385 ""
+ i__2[0] = 1, a__2[0] = sq;
+#line 25385 ""
+ i__2[1] = 7, a__2[1] = "hoffset";
+#line 25385 ""
+ s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
+#line 25385 ""
+ do_fio(&c__1, ch__9, (ftnlen)8);
+#line 25385 ""
+ i__4 = i_nint(&comtop_1.hoffpt);
+#line 25385 ""
+ do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
+#line 25385 ""
+ do_fio(&c__1, "pt", (ftnlen)2);
+#line 25385 ""
+ e_wsfe();
+#line 25386 ""
+ } else if (comtop_1.hoffpt < 0.f) {
+#line 25387 ""
+ s_wsfe(&io___1834);
+/* Writing concatenation */
+#line 25387 ""
+ i__2[0] = 1, a__2[0] = sq;
+#line 25387 ""
+ i__2[1] = 7, a__2[1] = "hoffset";
+#line 25387 ""
+ s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
+#line 25387 ""
+ do_fio(&c__1, ch__9, (ftnlen)8);
+#line 25387 ""
+ i__4 = i_nint(&comtop_1.hoffpt);
+#line 25387 ""
+ do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
+#line 25387 ""
+ do_fio(&c__1, "pt", (ftnlen)2);
+#line 25387 ""
+ e_wsfe();
+#line 25388 ""
+ } else if (comtop_1.hoffpt < 10.f) {
+#line 25389 ""
+ s_wsfe(&io___1835);
+/* Writing concatenation */
#line 25389 ""
i__2[0] = 1, a__2[0] = sq;
#line 25389 ""
@@ -62993,9 +63322,9 @@ L1:
#line 25389 ""
e_wsfe();
#line 25390 ""
- } else if (comtop_1.hoffpt < 0.f) {
+ } else {
#line 25391 ""
- s_wsfe(&io___1834);
+ s_wsfe(&io___1836);
/* Writing concatenation */
#line 25391 ""
i__2[0] = 1, a__2[0] = sq;
@@ -63014,57 +63343,57 @@ L1:
#line 25391 ""
e_wsfe();
#line 25392 ""
- } else if (comtop_1.hoffpt < 10.f) {
+ }
#line 25393 ""
- s_wsfe(&io___1835);
+ }
+#line 25394 ""
+ if (dabs(comtop_1.voffpt) > .1f) {
+#line 25395 ""
+ if (comtop_1.voffpt <= -10.f) {
+#line 25396 ""
+ s_wsfe(&io___1837);
/* Writing concatenation */
-#line 25393 ""
+#line 25396 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25393 ""
- i__2[1] = 7, a__2[1] = "hoffset";
-#line 25393 ""
+#line 25396 ""
+ i__2[1] = 7, a__2[1] = "voffset";
+#line 25396 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25393 ""
+#line 25396 ""
do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25393 ""
- i__4 = i_nint(&comtop_1.hoffpt);
-#line 25393 ""
+#line 25396 ""
+ i__4 = i_nint(&comtop_1.voffpt);
+#line 25396 ""
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 25393 ""
+#line 25396 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25393 ""
+#line 25396 ""
e_wsfe();
-#line 25394 ""
- } else {
-#line 25395 ""
- s_wsfe(&io___1836);
+#line 25397 ""
+ } else if (comtop_1.voffpt < 0.f) {
+#line 25398 ""
+ s_wsfe(&io___1838);
/* Writing concatenation */
-#line 25395 ""
+#line 25398 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25395 ""
- i__2[1] = 7, a__2[1] = "hoffset";
-#line 25395 ""
+#line 25398 ""
+ i__2[1] = 7, a__2[1] = "voffset";
+#line 25398 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25395 ""
+#line 25398 ""
do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25395 ""
- i__4 = i_nint(&comtop_1.hoffpt);
-#line 25395 ""
+#line 25398 ""
+ i__4 = i_nint(&comtop_1.voffpt);
+#line 25398 ""
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 25395 ""
+#line 25398 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25395 ""
- e_wsfe();
-#line 25396 ""
- }
-#line 25397 ""
- }
#line 25398 ""
- if (dabs(comtop_1.voffpt) > .1f) {
+ e_wsfe();
#line 25399 ""
- if (comtop_1.voffpt <= -10.f) {
+ } else if (comtop_1.voffpt < 10.f) {
#line 25400 ""
- s_wsfe(&io___1837);
+ s_wsfe(&io___1839);
/* Writing concatenation */
#line 25400 ""
i__2[0] = 1, a__2[0] = sq;
@@ -63083,9 +63412,9 @@ L1:
#line 25400 ""
e_wsfe();
#line 25401 ""
- } else if (comtop_1.voffpt < 0.f) {
+ } else {
#line 25402 ""
- s_wsfe(&io___1838);
+ s_wsfe(&io___1840);
/* Writing concatenation */
#line 25402 ""
i__2[0] = 1, a__2[0] = sq;
@@ -63104,812 +63433,772 @@ L1:
#line 25402 ""
e_wsfe();
#line 25403 ""
- } else if (comtop_1.voffpt < 10.f) {
-#line 25404 ""
- s_wsfe(&io___1839);
-/* Writing concatenation */
-#line 25404 ""
- i__2[0] = 1, a__2[0] = sq;
-#line 25404 ""
- i__2[1] = 7, a__2[1] = "voffset";
-#line 25404 ""
- s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25404 ""
- do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25404 ""
- i__4 = i_nint(&comtop_1.voffpt);
-#line 25404 ""
- do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 25404 ""
- do_fio(&c__1, "pt", (ftnlen)2);
-#line 25404 ""
- e_wsfe();
-#line 25405 ""
- } else {
-#line 25406 ""
- s_wsfe(&io___1840);
-/* Writing concatenation */
-#line 25406 ""
- i__2[0] = 1, a__2[0] = sq;
-#line 25406 ""
- i__2[1] = 7, a__2[1] = "voffset";
-#line 25406 ""
- s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25406 ""
- do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25406 ""
- i__4 = i_nint(&comtop_1.voffpt);
-#line 25406 ""
- do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
-#line 25406 ""
- do_fio(&c__1, "pt", (ftnlen)2);
-#line 25406 ""
- e_wsfe();
-#line 25407 ""
}
-#line 25408 ""
+#line 25404 ""
}
/* The default raisebarno=3.5 internote, set in pmx.tex. Increase to 4.5 if */
/* 3 sharps and treble clef, to avoid vertical clash with top space g# */
-#line 25413 ""
+#line 25409 ""
if (comtop_1.isig == 3 && *(unsigned char *)&clefq[*nv] == 't') {
-#line 25413 ""
+#line 25409 ""
s_wsfe(&io___1841);
/* Writing concatenation */
-#line 25413 ""
+#line 25409 ""
i__7[0] = 1, a__5[0] = sq;
-#line 25413 ""
+#line 25409 ""
i__7[1] = 3, a__5[1] = "def";
-#line 25413 ""
+#line 25409 ""
i__7[2] = 1, a__5[2] = sq;
-#line 25413 ""
+#line 25409 ""
i__7[3] = 14, a__5[3] = "raisebarno{4.5";
-#line 25413 ""
+#line 25409 ""
i__7[4] = 1, a__5[4] = sq;
-#line 25413 ""
+#line 25409 ""
i__7[5] = 10, a__5[5] = "internote}";
-#line 25413 ""
+#line 25409 ""
s_cat(ch__17, a__5, i__7, &c__6, (ftnlen)30);
-#line 25413 ""
+#line 25409 ""
do_fio(&c__1, ch__17, (ftnlen)30);
-#line 25413 ""
+#line 25409 ""
e_wsfe();
-#line 25413 ""
+#line 25409 ""
}
-#line 25415 ""
+#line 25411 ""
if (*noinst < 10) {
-#line 25416 ""
+#line 25412 ""
s_wsfe(&io___1842);
/* Writing concatenation */
-#line 25416 ""
+#line 25412 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25416 ""
+#line 25412 ""
i__3[1] = 3, a__3[1] = "def";
-#line 25416 ""
+#line 25412 ""
i__3[2] = 1, a__3[2] = sq;
-#line 25416 ""
+#line 25412 ""
i__3[3] = 14, a__3[3] = "nbinstruments{";
-#line 25416 ""
+#line 25412 ""
s_cat(ch__18, a__3, i__3, &c__4, (ftnlen)19);
-#line 25416 ""
+#line 25412 ""
do_fio(&c__1, ch__18, (ftnlen)19);
-#line 25416 ""
+#line 25412 ""
do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
-#line 25416 ""
+#line 25412 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 25416 ""
+#line 25412 ""
e_wsfe();
-#line 25418 ""
+#line 25414 ""
} else {
-#line 25419 ""
+#line 25415 ""
s_wsfe(&io___1843);
/* Writing concatenation */
-#line 25419 ""
+#line 25415 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25419 ""
+#line 25415 ""
i__3[1] = 3, a__3[1] = "def";
-#line 25419 ""
+#line 25415 ""
i__3[2] = 1, a__3[2] = sq;
-#line 25419 ""
+#line 25415 ""
i__3[3] = 14, a__3[3] = "nbinstruments{";
-#line 25419 ""
+#line 25415 ""
s_cat(ch__18, a__3, i__3, &c__4, (ftnlen)19);
-#line 25419 ""
+#line 25415 ""
do_fio(&c__1, ch__18, (ftnlen)19);
-#line 25419 ""
+#line 25415 ""
do_fio(&c__1, (char *)&(*noinst), (ftnlen)sizeof(integer));
-#line 25419 ""
+#line 25415 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 25419 ""
+#line 25415 ""
e_wsfe();
-#line 25421 ""
+#line 25417 ""
}
-#line 25422 ""
+#line 25418 ""
iv = 0;
-#line 25423 ""
+#line 25419 ""
i__4 = *noinst;
-#line 25423 ""
+#line 25419 ""
for (iinst = 1; iinst <= i__4; ++iinst) {
-#line 25424 ""
+#line 25420 ""
nstaves = comnvi_1.nsperi[iinst - 1];
-#line 25425 ""
+#line 25421 ""
if (iinst < 10) {
-#line 25426 ""
+#line 25422 ""
s_wsfe(&io___1846);
/* Writing concatenation */
-#line 25426 ""
+#line 25422 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25426 ""
+#line 25422 ""
i__3[1] = 9, a__3[1] = "setstaffs";
-#line 25426 ""
+#line 25422 ""
i__6 = iinst + 48;
-#line 25426 ""
+#line 25422 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25426 ""
+#line 25422 ""
i__3[2] = 1, a__3[2] = ch__1;
-#line 25426 ""
+#line 25422 ""
i__8 = nstaves + 48;
-#line 25426 ""
+#line 25422 ""
chax_(ch__19, (ftnlen)1, &i__8);
-#line 25426 ""
+#line 25422 ""
i__3[3] = 1, a__3[3] = ch__19;
-#line 25426 ""
+#line 25422 ""
s_cat(ch__10, a__3, i__3, &c__4, (ftnlen)12);
-#line 25426 ""
+#line 25422 ""
do_fio(&c__1, ch__10, (ftnlen)12);
-#line 25426 ""
+#line 25422 ""
e_wsfe();
-#line 25428 ""
+#line 25424 ""
} else {
-#line 25429 ""
+#line 25425 ""
s_wsfe(&io___1847);
/* Writing concatenation */
-#line 25429 ""
+#line 25425 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25429 ""
+#line 25425 ""
i__2[1] = 10, a__2[1] = "setstaffs{";
-#line 25429 ""
+#line 25425 ""
s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11);
-#line 25429 ""
+#line 25425 ""
do_fio(&c__1, ch__13, (ftnlen)11);
-#line 25429 ""
+#line 25425 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25429 ""
+#line 25425 ""
i__5[0] = 1, a__4[0] = "}";
-#line 25429 ""
+#line 25425 ""
i__6 = nstaves + 48;
-#line 25429 ""
+#line 25425 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25429 ""
+#line 25425 ""
i__5[1] = 1, a__4[1] = ch__1;
-#line 25429 ""
+#line 25425 ""
s_cat(ch__20, a__4, i__5, &c__2, (ftnlen)2);
-#line 25429 ""
+#line 25425 ""
do_fio(&c__1, ch__20, (ftnlen)2);
-#line 25429 ""
+#line 25425 ""
e_wsfe();
-#line 25431 ""
+#line 25427 ""
}
-#line 25432 ""
+#line 25428 ""
++iv;
-#line 25433 ""
+#line 25429 ""
*(unsigned char *)clefqiv = *(unsigned char *)&clefq[iv];
-#line 25434 ""
+#line 25430 ""
if (*(unsigned char *)clefqiv == '8') {
-#line 25435 ""
+#line 25431 ""
*(unsigned char *)clefqiv = 't';
-#line 25436 ""
+#line 25432 ""
cominsttrans_1.itransamt[cominsttrans_1.instno[iv - 1] - 1] += 7;
-#line 25437 ""
+#line 25433 ""
comc8flag_1.c8flag[iv - 1] = TRUE_;
-#line 25438 ""
+#line 25434 ""
}
-#line 25439 ""
+#line 25435 ""
if (nstaves == 1) {
-#line 25440 ""
+#line 25436 ""
i__6 = numclef_(clefq + iv, (ftnlen)1) + 48;
-#line 25440 ""
+#line 25436 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25440 ""
+#line 25436 ""
s_copy(fmtq, ch__1, (ftnlen)24, (ftnlen)1);
-#line 25441 ""
+#line 25437 ""
lfmtq = 1;
-#line 25442 ""
+#line 25438 ""
} else {
/* Writing concatenation */
-#line 25443 ""
+#line 25439 ""
i__2[0] = 1, a__2[0] = "{";
-#line 25443 ""
+#line 25439 ""
i__6 = numclef_(clefq + iv, (ftnlen)1) + 48;
-#line 25443 ""
+#line 25439 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25443 ""
+#line 25439 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 25443 ""
+#line 25439 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
-#line 25444 ""
+#line 25440 ""
lfmtq = 2;
-#line 25445 ""
+#line 25441 ""
i__6 = nstaves;
-#line 25445 ""
+#line 25441 ""
for (k = 2; k <= i__6; ++k) {
-#line 25446 ""
+#line 25442 ""
++iv;
/* Writing concatenation */
-#line 25447 ""
+#line 25443 ""
i__2[0] = lfmtq, a__2[0] = fmtq;
-#line 25447 ""
+#line 25443 ""
i__8 = numclef_(clefq + iv, (ftnlen)1) + 48;
-#line 25447 ""
+#line 25443 ""
chax_(ch__1, (ftnlen)1, &i__8);
-#line 25447 ""
+#line 25443 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 25447 ""
+#line 25443 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
-#line 25448 ""
+#line 25444 ""
++lfmtq;
-#line 25449 ""
+#line 25445 ""
/* L2: */
-#line 25449 ""
+#line 25445 ""
}
/* Writing concatenation */
-#line 25450 ""
+#line 25446 ""
i__2[0] = lfmtq, a__2[0] = fmtq;
-#line 25450 ""
+#line 25446 ""
i__2[1] = 1, a__2[1] = "}";
-#line 25450 ""
+#line 25446 ""
s_cat(fmtq, a__2, i__2, &c__2, (ftnlen)24);
-#line 25451 ""
+#line 25447 ""
++lfmtq;
-#line 25452 ""
+#line 25448 ""
}
-#line 25453 ""
+#line 25449 ""
if (iinst < 10) {
-#line 25454 ""
+#line 25450 ""
s_wsfe(&io___1852);
/* Writing concatenation */
-#line 25454 ""
+#line 25450 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25454 ""
+#line 25450 ""
i__3[1] = 7, a__3[1] = "setclef";
-#line 25454 ""
+#line 25450 ""
i__6 = iinst + 48;
-#line 25454 ""
+#line 25450 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25454 ""
+#line 25450 ""
i__3[2] = 1, a__3[2] = ch__1;
-#line 25454 ""
+#line 25450 ""
i__3[3] = lfmtq, a__3[3] = fmtq;
-#line 25454 ""
+#line 25450 ""
s_cat(ch__21, a__3, i__3, &c__4, (ftnlen)33);
-#line 25454 ""
+#line 25450 ""
do_fio(&c__1, ch__21, lfmtq + 9);
-#line 25454 ""
+#line 25450 ""
e_wsfe();
-#line 25455 ""
+#line 25451 ""
} else {
-#line 25456 ""
+#line 25452 ""
s_wsfe(&io___1853);
/* Writing concatenation */
-#line 25456 ""
+#line 25452 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25456 ""
+#line 25452 ""
i__2[1] = 8, a__2[1] = "setclef{";
-#line 25456 ""
+#line 25452 ""
s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9);
-#line 25456 ""
+#line 25452 ""
do_fio(&c__1, ch__11, (ftnlen)9);
-#line 25456 ""
+#line 25452 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25456 ""
+#line 25452 ""
i__5[0] = 1, a__4[0] = "}";
-#line 25456 ""
+#line 25452 ""
i__5[1] = lfmtq, a__4[1] = fmtq;
-#line 25456 ""
+#line 25452 ""
s_cat(ch__22, a__4, i__5, &c__2, (ftnlen)25);
-#line 25456 ""
+#line 25452 ""
do_fio(&c__1, ch__22, lfmtq + 1);
-#line 25456 ""
+#line 25452 ""
e_wsfe();
-#line 25457 ""
+#line 25453 ""
}
-#line 25458 ""
+#line 25454 ""
if (*(unsigned char *)&clefq[iv] == '8') {
-#line 25459 ""
+#line 25455 ""
if (iinst < 10) {
-#line 25460 ""
+#line 25456 ""
s_wsfe(&io___1854);
/* Writing concatenation */
-#line 25460 ""
+#line 25456 ""
i__9[0] = 1, a__6[0] = sq;
-#line 25460 ""
+#line 25456 ""
i__9[1] = 19, a__6[1] = "settrebleclefsymbol";
-#line 25460 ""
+#line 25456 ""
i__6 = iinst + 48;
-#line 25460 ""
+#line 25456 ""
chax_(ch__1, (ftnlen)1, &i__6);
-#line 25460 ""
+#line 25456 ""
i__9[2] = 1, a__6[2] = ch__1;
-#line 25460 ""
+#line 25456 ""
i__9[3] = 1, a__6[3] = sq;
-#line 25460 ""
+#line 25456 ""
i__9[4] = 13, a__6[4] = "treblelowoct%";
-#line 25460 ""
+#line 25456 ""
s_cat(ch__23, a__6, i__9, &c__5, (ftnlen)35);
-#line 25460 ""
+#line 25456 ""
do_fio(&c__1, ch__23, (ftnlen)35);
-#line 25460 ""
+#line 25456 ""
e_wsfe();
-#line 25462 ""
+#line 25458 ""
} else {
-#line 25463 ""
+#line 25459 ""
s_wsfe(&io___1855);
/* Writing concatenation */
-#line 25463 ""
+#line 25459 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25463 ""
+#line 25459 ""
i__2[1] = 20, a__2[1] = "settrebleclefsymbol{";
-#line 25463 ""
+#line 25459 ""
s_cat(ch__14, a__2, i__2, &c__2, (ftnlen)21);
-#line 25463 ""
+#line 25459 ""
do_fio(&c__1, ch__14, (ftnlen)21);
-#line 25463 ""
+#line 25459 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25463 ""
+#line 25459 ""
i__1[0] = 1, a__1[0] = "}";
-#line 25463 ""
+#line 25459 ""
i__1[1] = 1, a__1[1] = sq;
-#line 25463 ""
+#line 25459 ""
i__1[2] = 13, a__1[2] = "treblelowoct%";
-#line 25463 ""
+#line 25459 ""
s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)15);
-#line 25463 ""
+#line 25459 ""
do_fio(&c__1, ch__3, (ftnlen)15);
-#line 25463 ""
+#line 25459 ""
e_wsfe();
-#line 25465 ""
+#line 25461 ""
}
-#line 25466 ""
+#line 25462 ""
comc8flag_1.c8flag[iv - 1] = TRUE_;
-#line 25467 ""
+#line 25463 ""
}
-#line 25468 ""
+#line 25464 ""
for (lname = 79; lname >= 2; --lname) {
-#line 25469 ""
+#line 25465 ""
if (*(unsigned char *)&comtop_1.inameq[(iinst - 1) * 79 + (lname
- 1)] != ' ') {
-#line 25469 ""
+#line 25465 ""
goto L4;
-#line 25469 ""
+#line 25465 ""
}
-#line 25470 ""
+#line 25466 ""
/* L3: */
-#line 25470 ""
+#line 25466 ""
}
-#line 25471 ""
+#line 25467 ""
L4:
-#line 25472 ""
+#line 25468 ""
comtop_1.lnam[iinst - 1] = lname;
-#line 25473 ""
+#line 25469 ""
if (iinst < 10) {
-#line 25474 ""
+#line 25470 ""
s_wsfe(&io___1857);
/* Writing concatenation */
-#line 25474 ""
+#line 25470 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25474 ""
+#line 25470 ""
i__2[1] = 7, a__2[1] = "setname";
-#line 25474 ""
+#line 25470 ""
s_cat(ch__9, a__2, i__2, &c__2, (ftnlen)8);
-#line 25474 ""
+#line 25470 ""
do_fio(&c__1, ch__9, (ftnlen)8);
-#line 25474 ""
+#line 25470 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25474 ""
+#line 25470 ""
i__1[0] = 1, a__1[0] = "{";
-#line 25474 ""
+#line 25470 ""
i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
-#line 25474 ""
+#line 25470 ""
i__1[2] = 1, a__1[2] = "}";
-#line 25474 ""
+#line 25470 ""
s_cat(ch__24, a__1, i__1, &c__3, (ftnlen)81);
-#line 25474 ""
+#line 25470 ""
do_fio(&c__1, ch__24, lname + 2);
-#line 25474 ""
+#line 25470 ""
e_wsfe();
-#line 25476 ""
+#line 25472 ""
} else {
-#line 25477 ""
+#line 25473 ""
s_wsfe(&io___1858);
/* Writing concatenation */
-#line 25477 ""
+#line 25473 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25477 ""
+#line 25473 ""
i__2[1] = 8, a__2[1] = "setname{";
-#line 25477 ""
+#line 25473 ""
s_cat(ch__11, a__2, i__2, &c__2, (ftnlen)9);
-#line 25477 ""
+#line 25473 ""
do_fio(&c__1, ch__11, (ftnlen)9);
-#line 25477 ""
+#line 25473 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
/* Writing concatenation */
-#line 25477 ""
+#line 25473 ""
i__1[0] = 2, a__1[0] = "}{";
-#line 25477 ""
+#line 25473 ""
i__1[1] = lname, a__1[1] = comtop_1.inameq + (iinst - 1) * 79;
-#line 25477 ""
+#line 25473 ""
i__1[2] = 1, a__1[2] = "}";
-#line 25477 ""
+#line 25473 ""
s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)82);
-#line 25477 ""
+#line 25473 ""
do_fio(&c__1, ch__25, lname + 3);
-#line 25477 ""
+#line 25473 ""
e_wsfe();
-#line 25479 ""
+#line 25475 ""
}
-#line 25480 ""
+#line 25476 ""
/* L1: */
-#line 25480 ""
+#line 25476 ""
}
-#line 25481 ""
+#line 25477 ""
s_wsfe(&io___1859);
/* Writing concatenation */
-#line 25481 ""
+#line 25477 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25481 ""
+#line 25477 ""
i__2[1] = 17, a__2[1] = "generalsignature{";
-#line 25481 ""
+#line 25477 ""
s_cat(ch__26, a__2, i__2, &c__2, (ftnlen)18);
-#line 25481 ""
+#line 25477 ""
do_fio(&c__1, ch__26, (ftnlen)18);
-#line 25481 ""
+#line 25477 ""
do_fio(&c__1, (char *)&comtop_1.isig, (ftnlen)sizeof(integer));
-#line 25481 ""
+#line 25477 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 25481 ""
+#line 25477 ""
e_wsfe();
-#line 25482 ""
+#line 25478 ""
if (cominsttrans_1.earlytranson) {
-#line 25482 ""
+#line 25478 ""
writesetsign_(&cominsttrans_1.ninsttrans, cominsttrans_1.iinsttrans,
cominsttrans_1.itranskey, &cominsttrans_1.earlytranson);
-#line 25482 ""
+#line 25478 ""
}
-#line 25484 ""
+#line 25480 ""
wgmeter_(mtrnmp, mtrdnp);
-#line 25485 ""
+#line 25481 ""
r__1 = comtop_1.fracindent * comtop_1.widthpt;
-#line 25485 ""
+#line 25481 ""
ipi = i_nint(&r__1);
-#line 25486 ""
+#line 25482 ""
if (ipi < 10) {
-#line 25487 ""
+#line 25483 ""
s_wsfe(&io___1861);
/* Writing concatenation */
-#line 25487 ""
+#line 25483 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25487 ""
+#line 25483 ""
i__2[1] = 10, a__2[1] = "parindent ";
-#line 25487 ""
+#line 25483 ""
s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11);
-#line 25487 ""
+#line 25483 ""
do_fio(&c__1, ch__13, (ftnlen)11);
-#line 25487 ""
+#line 25483 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
-#line 25487 ""
+#line 25483 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25487 ""
+#line 25483 ""
e_wsfe();
-#line 25488 ""
+#line 25484 ""
} else if (ipi < 100) {
-#line 25489 ""
+#line 25485 ""
s_wsfe(&io___1862);
/* Writing concatenation */
-#line 25489 ""
+#line 25485 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25489 ""
+#line 25485 ""
i__2[1] = 10, a__2[1] = "parindent ";
-#line 25489 ""
+#line 25485 ""
s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11);
-#line 25489 ""
+#line 25485 ""
do_fio(&c__1, ch__13, (ftnlen)11);
-#line 25489 ""
+#line 25485 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
-#line 25489 ""
+#line 25485 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25489 ""
+#line 25485 ""
e_wsfe();
-#line 25490 ""
+#line 25486 ""
} else {
-#line 25491 ""
+#line 25487 ""
s_wsfe(&io___1863);
/* Writing concatenation */
-#line 25491 ""
+#line 25487 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25491 ""
+#line 25487 ""
i__2[1] = 10, a__2[1] = "parindent ";
-#line 25491 ""
+#line 25487 ""
s_cat(ch__13, a__2, i__2, &c__2, (ftnlen)11);
-#line 25491 ""
+#line 25487 ""
do_fio(&c__1, ch__13, (ftnlen)11);
-#line 25491 ""
+#line 25487 ""
do_fio(&c__1, (char *)&ipi, (ftnlen)sizeof(integer));
-#line 25491 ""
+#line 25487 ""
do_fio(&c__1, "pt", (ftnlen)2);
-#line 25491 ""
+#line 25487 ""
e_wsfe();
-#line 25492 ""
+#line 25488 ""
}
-#line 25493 ""
+#line 25489 ""
s_wsfe(&io___1864);
/* Writing concatenation */
-#line 25493 ""
+#line 25489 ""
i__10[0] = 1, a__7[0] = sq;
-#line 25493 ""
+#line 25489 ""
i__10[1] = 11, a__7[1] = "elemskip1pt";
-#line 25493 ""
+#line 25489 ""
i__10[2] = 1, a__7[2] = sq;
-#line 25493 ""
+#line 25489 ""
i__10[3] = 13, a__7[3] = "afterruleskip";
-#line 25493 ""
+#line 25489 ""
i__10[4] = 5, a__7[4] = fbarq;
-#line 25493 ""
+#line 25489 ""
i__10[5] = 2, a__7[5] = "pt";
-#line 25493 ""
+#line 25489 ""
i__10[6] = 1, a__7[6] = sq;
-#line 25493 ""
+#line 25489 ""
i__10[7] = 17, a__7[7] = "beforeruleskip0pt";
-#line 25493 ""
+#line 25489 ""
i__10[8] = 1, a__7[8] = sq;
-#line 25493 ""
+#line 25489 ""
i__10[9] = 5, a__7[9] = "relax";
-#line 25493 ""
+#line 25489 ""
s_cat(ch__27, a__7, i__10, &c__10, (ftnlen)57);
-#line 25493 ""
+#line 25489 ""
do_fio(&c__1, ch__27, (ftnlen)57);
-#line 25493 ""
+#line 25489 ""
e_wsfe();
-#line 25495 ""
+#line 25491 ""
if (! (*vshrink)) {
-#line 25496 ""
+#line 25492 ""
if (*xinstf1 < 9.95f) {
-#line 25497 ""
+#line 25493 ""
s_copy(fmtq, "(a,f3.1,a)", (ftnlen)24, (ftnlen)10);
-#line 25498 ""
+#line 25494 ""
} else {
-#line 25499 ""
+#line 25495 ""
s_copy(fmtq, "(a,f4.1,a)", (ftnlen)24, (ftnlen)10);
-#line 25500 ""
+#line 25496 ""
}
-#line 25501 ""
+#line 25497 ""
facis = 1.f;
-#line 25502 ""
+#line 25498 ""
if (comis4bignv_1.is4bignv) {
-#line 25502 ""
+#line 25498 ""
facis = .95f;
-#line 25502 ""
+#line 25498 ""
}
-#line 25503 ""
+#line 25499 ""
s_wsfe(&io___1866);
/* Writing concatenation */
-#line 25503 ""
+#line 25499 ""
i__7[0] = 1, a__5[0] = sq;
-#line 25503 ""
+#line 25499 ""
i__7[1] = 15, a__5[1] = "stafftopmarg0pt";
-#line 25503 ""
+#line 25499 ""
i__7[2] = 1, a__5[2] = sq;
-#line 25503 ""
+#line 25499 ""
i__7[3] = 15, a__5[3] = "staffbotmarg0pt";
-#line 25503 ""
+#line 25499 ""
i__7[4] = 1, a__5[4] = sq;
-#line 25503 ""
+#line 25499 ""
i__7[5] = 11, a__5[5] = "interstaff{";
-#line 25503 ""
+#line 25499 ""
s_cat(ch__28, a__5, i__7, &c__6, (ftnlen)44);
-#line 25503 ""
+#line 25499 ""
do_fio(&c__1, ch__28, (ftnlen)44);
-#line 25503 ""
+#line 25499 ""
r__1 = *xinstf1 * facis;
-#line 25503 ""
+#line 25499 ""
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
/* Writing concatenation */
-#line 25503 ""
+#line 25499 ""
i__1[0] = 1, a__1[0] = "}";
-#line 25503 ""
+#line 25499 ""
i__1[1] = 1, a__1[1] = sq;
-#line 25503 ""
+#line 25499 ""
i__1[2] = 5, a__1[2] = "relax";
-#line 25503 ""
+#line 25499 ""
s_cat(ch__15, a__1, i__1, &c__3, (ftnlen)7);
-#line 25503 ""
+#line 25499 ""
do_fio(&c__1, ch__15, (ftnlen)7);
-#line 25503 ""
+#line 25499 ""
e_wsfe();
-#line 25505 ""
+#line 25501 ""
} else {
-#line 25506 ""
+#line 25502 ""
s_wsfe(&io___1867);
/* Writing concatenation */
-#line 25506 ""
+#line 25502 ""
i__10[0] = 1, a__7[0] = sq;
-#line 25506 ""
+#line 25502 ""
i__10[1] = 15, a__7[1] = "stafftopmarg0pt";
-#line 25506 ""
+#line 25502 ""
i__10[2] = 1, a__7[2] = sq;
-#line 25506 ""
+#line 25502 ""
i__10[3] = 13, a__7[3] = "staffbotmarg5";
-#line 25506 ""
+#line 25502 ""
i__10[4] = 1, a__7[4] = sq;
-#line 25506 ""
+#line 25502 ""
i__10[5] = 10, a__7[5] = "Interligne";
-#line 25506 ""
+#line 25502 ""
i__10[6] = 1, a__7[6] = sq;
-#line 25506 ""
+#line 25502 ""
i__10[7] = 14, a__7[7] = "interstaff{10}";
-#line 25506 ""
+#line 25502 ""
i__10[8] = 1, a__7[8] = sq;
-#line 25506 ""
+#line 25502 ""
i__10[9] = 5, a__7[9] = "relax";
-#line 25506 ""
+#line 25502 ""
s_cat(ch__29, a__7, i__10, &c__10, (ftnlen)62);
-#line 25506 ""
+#line 25502 ""
do_fio(&c__1, ch__29, (ftnlen)62);
-#line 25506 ""
+#line 25502 ""
e_wsfe();
-#line 25509 ""
+#line 25505 ""
}
-#line 25510 ""
+#line 25506 ""
if (*nv == 1) {
-#line 25510 ""
+#line 25506 ""
s_wsfe(&io___1868);
/* Writing concatenation */
-#line 25510 ""
+#line 25506 ""
i__2[0] = 1, a__2[0] = sq;
-#line 25510 ""
+#line 25506 ""
i__2[1] = 11, a__2[1] = "nostartrule";
-#line 25510 ""
+#line 25506 ""
s_cat(ch__10, a__2, i__2, &c__2, (ftnlen)12);
-#line 25510 ""
+#line 25506 ""
do_fio(&c__1, ch__10, (ftnlen)12);
-#line 25510 ""
+#line 25506 ""
e_wsfe();
-#line 25510 ""
+#line 25506 ""
}
-#line 25511 ""
+#line 25507 ""
s_wsfe(&io___1869);
/* Writing concatenation */
-#line 25511 ""
+#line 25507 ""
i__3[0] = 1, a__3[0] = sq;
-#line 25511 ""
+#line 25507 ""
i__3[1] = 8, a__3[1] = "readmod{";
-#line 25511 ""
+#line 25507 ""
i__3[2] = *lbase, a__3[2] = basenameq;
-#line 25511 ""
+#line 25507 ""
i__3[3] = 1, a__3[3] = "}";
-#line 25511 ""
+#line 25507 ""
s_cat(ch__30, a__3, i__3, &c__4, (ftnlen)54);
-#line 25511 ""
+#line 25507 ""
do_fio(&c__1, ch__30, *lbase + 10);
-#line 25511 ""
+#line 25507 ""
e_wsfe();
-#line 25512 ""
+#line 25508 ""
if (comnvst_1.cstuplet) {
-#line 25513 ""
+#line 25509 ""
s_wsfe(&io___1870);
/* Writing concatenation */
-#line 25513 ""
+#line 25509 ""
i__11[0] = 1, a__8[0] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[1] = 12, a__8[1] = "input tuplet";
-#line 25513 ""
+#line 25509 ""
i__11[2] = 1, a__8[2] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[3] = 3, a__8[3] = "def";
-#line 25513 ""
+#line 25509 ""
i__11[4] = 1, a__8[4] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[5] = 12, a__8[5] = "xnumt#1#2#3{";
-#line 25513 ""
+#line 25509 ""
i__11[6] = 1, a__8[6] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}";
-#line 25513 ""
+#line 25509 ""
i__11[8] = 1, a__8[8] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[9] = 3, a__8[9] = "def";
-#line 25513 ""
+#line 25509 ""
i__11[10] = 1, a__8[10] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[11] = 10, a__8[11] = "tuplettxt{";
-#line 25513 ""
+#line 25509 ""
i__11[12] = 1, a__8[12] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[13] = 9, a__8[13] = "smalltype";
-#line 25513 ""
+#line 25509 ""
i__11[14] = 1, a__8[14] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[15] = 6, a__8[15] = "it{#3}";
-#line 25513 ""
+#line 25509 ""
i__11[16] = 1, a__8[16] = sq;
-#line 25513 ""
- i__11[17] = 1, a__8[17] = "/";
-#line 25513 ""
+#line 25509 ""
+ chax_(ch__1, (ftnlen)1, &c__47);
+#line 25509 ""
+ i__11[17] = 1, a__8[17] = ch__1;
+#line 25509 ""
i__11[18] = 1, a__8[18] = sq;
-#line 25513 ""
+#line 25509 ""
i__11[19] = 4, a__8[19] = "/}}%";
-#line 25513 ""
+#line 25509 ""
s_cat(ch__31, a__8, i__11, &c__20, (ftnlen)86);
-#line 25513 ""
+#line 25509 ""
do_fio(&c__1, ch__31, (ftnlen)86);
-#line 25513 ""
+#line 25509 ""
e_wsfe();
-#line 25517 ""
+#line 25513 ""
s_wsfe(&io___1871);
/* Writing concatenation */
-#line 25517 ""
+#line 25513 ""
i__12[0] = 1, a__9[0] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[1] = 3, a__9[1] = "let";
-#line 25517 ""
+#line 25513 ""
i__12[2] = 1, a__9[2] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[3] = 5, a__9[3] = "ovbkt";
-#line 25517 ""
+#line 25513 ""
i__12[4] = 1, a__9[4] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[5] = 8, a__9[5] = "uptuplet";
-#line 25517 ""
+#line 25513 ""
i__12[6] = 1, a__9[6] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[7] = 3, a__9[7] = "let";
-#line 25517 ""
+#line 25513 ""
i__12[8] = 1, a__9[8] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[9] = 5, a__9[9] = "unbkt";
-#line 25517 ""
+#line 25513 ""
i__12[10] = 1, a__9[10] = sq;
-#line 25517 ""
+#line 25513 ""
i__12[11] = 11, a__9[11] = "downtuplet%";
-#line 25517 ""
+#line 25513 ""
s_cat(ch__32, a__9, i__12, &c__12, (ftnlen)41);
-#line 25517 ""
+#line 25513 ""
do_fio(&c__1, ch__32, (ftnlen)41);
-#line 25517 ""
+#line 25513 ""
e_wsfe();
-#line 25519 ""
+#line 25515 ""
}
-#line 25520 ""
+#line 25516 ""
s_wsfe(&io___1872);
/* Writing concatenation */
-#line 25520 ""
+#line 25516 ""
i__13[0] = 1, a__10[0] = sq;
-#line 25520 ""
+#line 25516 ""
i__13[1] = 11, a__10[1] = "startmuflex";
-#line 25520 ""
+#line 25516 ""
i__13[2] = 1, a__10[2] = sq;
-#line 25520 ""
+#line 25516 ""
i__13[3] = 10, a__10[3] = "startpiece";
-#line 25520 ""
+#line 25516 ""
i__13[4] = 1, a__10[4] = sq;
-#line 25520 ""
+#line 25516 ""
i__13[5] = 8, a__10[5] = "addspace";
-#line 25520 ""
+#line 25516 ""
i__13[6] = 1, a__10[6] = sq;
-#line 25520 ""
+#line 25516 ""
i__13[7] = 14, a__10[7] = "afterruleskip%";
-#line 25520 ""
+#line 25516 ""
s_cat(ch__33, a__10, i__13, &c__8, (ftnlen)47);
-#line 25520 ""
+#line 25516 ""
do_fio(&c__1, ch__33, (ftnlen)47);
-#line 25520 ""
+#line 25516 ""
e_wsfe();
-#line 25522 ""
+#line 25518 ""
return 0;
} /* topfile_ */
@@ -63921,19 +64210,19 @@ L4:
/* Slur directions */
-#line 25530 ""
+#line 25526 ""
ntest = *nolev - *ncm;
-#line 25531 ""
+#line 25527 ""
if (ntest < 0 || ntest == 0 && combc_1.bcspec && *ncm == 23) {
-#line 25533 ""
+#line 25529 ""
*(unsigned char *)ret_val = 'd';
-#line 25534 ""
+#line 25530 ""
} else {
-#line 25535 ""
+#line 25531 ""
*(unsigned char *)ret_val = 'u';
-#line 25536 ""
+#line 25532 ""
}
-#line 25537 ""
+#line 25533 ""
return ;
} /* udfq_ */
@@ -63951,52 +64240,52 @@ L4:
/* Stem direction for single notes */
-#line 25546 ""
+#line 25542 ""
if (bit_test(*isl,30)) {
/* Absolute override */
-#line 25550 ""
+#line 25546 ""
if (bit_test(*isl,17)) {
-#line 25551 ""
+#line 25547 ""
*(unsigned char *)udqqq = 'u';
-#line 25552 ""
+#line 25548 ""
} else {
-#line 25553 ""
+#line 25549 ""
*(unsigned char *)udqqq = 'l';
-#line 25554 ""
+#line 25550 ""
}
-#line 25555 ""
+#line 25551 ""
} else if (*nvmx == 1) {
/* Single voice per staff, default */
-#line 25559 ""
+#line 25555 ""
r__1 = *nole * 1.f;
-#line 25559 ""
+#line 25555 ""
ulfq_(ch__2, (ftnlen)1, &r__1, ncm);
-#line 25559 ""
+#line 25555 ""
*(unsigned char *)udqqq = *(unsigned char *)&ch__2[0];
-#line 25560 ""
+#line 25556 ""
} else {
/* Multi-voice per staff, 1st is lower, 2nd upper */
-#line 25564 ""
+#line 25560 ""
if (*ivx <= *nv) {
-#line 25565 ""
+#line 25561 ""
*(unsigned char *)udqqq = 'l';
-#line 25566 ""
+#line 25562 ""
} else {
-#line 25567 ""
+#line 25563 ""
*(unsigned char *)udqqq = 'u';
-#line 25568 ""
+#line 25564 ""
}
-#line 25569 ""
+#line 25565 ""
}
-#line 25570 ""
+#line 25566 ""
*(unsigned char *)ret_val = *(unsigned char *)udqqq;
-#line 25571 ""
+#line 25567 ""
return ;
} /* udqq_ */
@@ -64008,19 +64297,19 @@ L4:
/* Stem directions */
-#line 25579 ""
+#line 25575 ""
test = *xnolev - *ncm;
-#line 25580 ""
+#line 25576 ""
if (test < -.001f || test < .001f && combc_1.bcspec && *ncm == 23) {
-#line 25582 ""
+#line 25578 ""
*(unsigned char *)ret_val = 'u';
-#line 25583 ""
+#line 25579 ""
} else {
-#line 25584 ""
+#line 25580 ""
*(unsigned char *)ret_val = 'l';
-#line 25585 ""
+#line 25581 ""
}
-#line 25586 ""
+#line 25582 ""
return ;
} /* ulfq_ */
@@ -64045,37 +64334,37 @@ L4:
static cilist io___1876 = { 0, 6, 0, 0, 0 };
-#line 25590 ""
+#line 25586 ""
if (*(unsigned char *)chq >= 61 && *(unsigned char *)chq < 122) {
-#line 25591 ""
+#line 25587 ""
i__1 = *(unsigned char *)chq - 32;
-#line 25591 ""
+#line 25587 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 25591 ""
+#line 25587 ""
*(unsigned char *)ret_val = *(unsigned char *)&ch__2[0];
-#line 25592 ""
+#line 25588 ""
} else {
-#line 25593 ""
+#line 25589 ""
*(unsigned char *)ret_val = *(unsigned char *)chq;
-#line 25594 ""
+#line 25590 ""
s_wsle(&io___1876);
/* Writing concatenation */
-#line 25594 ""
+#line 25590 ""
i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a"\
"rgument: ";
-#line 25594 ""
+#line 25590 ""
i__2[1] = 1, a__1[1] = chq;
-#line 25594 ""
+#line 25590 ""
s_cat(ch__3, a__1, i__2, &c__2, (ftnlen)53);
-#line 25594 ""
+#line 25590 ""
do_lio(&c__9, &c__1, ch__3, (ftnlen)53);
-#line 25594 ""
+#line 25590 ""
e_wsle();
-#line 25596 ""
+#line 25592 ""
s_stop("", (ftnlen)0);
-#line 25597 ""
+#line 25593 ""
}
-#line 25598 ""
+#line 25594 ""
return ;
} /* upcaseq_ */
@@ -64110,23 +64399,50 @@ L4:
/* Writes meter stuff to file 11, so only called if islast=.true. */
-#line 25605 ""
+#line 25601 ""
if (*mtrdnp == 0) {
-#line 25605 ""
+#line 25601 ""
return 0;
-#line 25605 ""
+#line 25601 ""
}
-#line 25606 ""
+#line 25602 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 25606 ""
+#line 25602 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 25607 ""
+#line 25603 ""
if (*mtrnmp > 0 && *mtrnmp <= 9) {
-#line 25608 ""
+#line 25604 ""
if (*mtrdnp < 10) {
-#line 25609 ""
+#line 25605 ""
s_wsfe(&io___1878);
/* Writing concatenation */
+#line 25605 ""
+ i__1[0] = 1, a__1[0] = sq;
+#line 25605 ""
+ i__1[1] = 13, a__1[1] = "generalmeter{";
+#line 25605 ""
+ i__1[2] = 1, a__1[2] = sq;
+#line 25605 ""
+ i__1[3] = 10, a__1[3] = "meterfrac{";
+#line 25605 ""
+ s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
+#line 25605 ""
+ do_fio(&c__1, ch__2, (ftnlen)25);
+#line 25605 ""
+ do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
+#line 25605 ""
+ do_fio(&c__1, "}{", (ftnlen)2);
+#line 25605 ""
+ do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
+#line 25605 ""
+ do_fio(&c__1, "}}%", (ftnlen)3);
+#line 25605 ""
+ e_wsfe();
+#line 25608 ""
+ } else {
+#line 25609 ""
+ s_wsfe(&io___1879);
+/* Writing concatenation */
#line 25609 ""
i__1[0] = 1, a__1[0] = sq;
#line 25609 ""
@@ -64150,40 +64466,40 @@ L4:
#line 25609 ""
e_wsfe();
#line 25612 ""
- } else {
+ }
#line 25613 ""
- s_wsfe(&io___1879);
+ } else if (*mtrnmp >= 10) {
+#line 25614 ""
+ if (*mtrdnp < 10) {
+#line 25615 ""
+ s_wsfe(&io___1880);
/* Writing concatenation */
-#line 25613 ""
+#line 25615 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25613 ""
+#line 25615 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
-#line 25613 ""
+#line 25615 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25613 ""
+#line 25615 ""
i__1[3] = 10, a__1[3] = "meterfrac{";
-#line 25613 ""
+#line 25615 ""
s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
-#line 25613 ""
+#line 25615 ""
do_fio(&c__1, ch__2, (ftnlen)25);
-#line 25613 ""
+#line 25615 ""
do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
-#line 25613 ""
+#line 25615 ""
do_fio(&c__1, "}{", (ftnlen)2);
-#line 25613 ""
+#line 25615 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
-#line 25613 ""
+#line 25615 ""
do_fio(&c__1, "}}%", (ftnlen)3);
-#line 25613 ""
+#line 25615 ""
e_wsfe();
-#line 25616 ""
- }
-#line 25617 ""
- } else if (*mtrnmp >= 10) {
#line 25618 ""
- if (*mtrdnp < 10) {
+ } else {
#line 25619 ""
- s_wsfe(&io___1880);
+ s_wsfe(&io___1881);
/* Writing concatenation */
#line 25619 ""
i__1[0] = 1, a__1[0] = sq;
@@ -64208,146 +64524,119 @@ L4:
#line 25619 ""
e_wsfe();
#line 25622 ""
- } else {
-#line 25623 ""
- s_wsfe(&io___1881);
-/* Writing concatenation */
-#line 25623 ""
- i__1[0] = 1, a__1[0] = sq;
-#line 25623 ""
- i__1[1] = 13, a__1[1] = "generalmeter{";
-#line 25623 ""
- i__1[2] = 1, a__1[2] = sq;
-#line 25623 ""
- i__1[3] = 10, a__1[3] = "meterfrac{";
-#line 25623 ""
- s_cat(ch__2, a__1, i__1, &c__4, (ftnlen)25);
-#line 25623 ""
- do_fio(&c__1, ch__2, (ftnlen)25);
-#line 25623 ""
- do_fio(&c__1, (char *)&(*mtrnmp), (ftnlen)sizeof(integer));
-#line 25623 ""
- do_fio(&c__1, "}{", (ftnlen)2);
-#line 25623 ""
- do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
-#line 25623 ""
- do_fio(&c__1, "}}%", (ftnlen)3);
-#line 25623 ""
- e_wsfe();
-#line 25626 ""
}
-#line 25627 ""
+#line 25623 ""
} else if (*mtrnmp < 0) {
-#line 25628 ""
+#line 25624 ""
s_wsfe(&io___1882);
/* Writing concatenation */
-#line 25628 ""
+#line 25624 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25628 ""
+#line 25624 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
-#line 25628 ""
+#line 25624 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25628 ""
+#line 25624 ""
i__1[3] = 11, a__1[3] = "meterfracS{";
-#line 25628 ""
+#line 25624 ""
s_cat(ch__3, a__1, i__1, &c__4, (ftnlen)26);
-#line 25628 ""
+#line 25624 ""
do_fio(&c__1, ch__3, (ftnlen)26);
-#line 25628 ""
+#line 25624 ""
i__2 = -(*mtrnmp);
-#line 25628 ""
+#line 25624 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 25628 ""
+#line 25624 ""
do_fio(&c__1, "}{", (ftnlen)2);
-#line 25628 ""
+#line 25624 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
-#line 25628 ""
+#line 25624 ""
do_fio(&c__1, "}}%", (ftnlen)3);
-#line 25628 ""
+#line 25624 ""
e_wsfe();
-#line 25631 ""
+#line 25627 ""
} else if (*mtrdnp <= 4) {
-#line 25632 ""
+#line 25628 ""
s_wsfe(&io___1883);
/* Writing concatenation */
-#line 25632 ""
+#line 25628 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25632 ""
+#line 25628 ""
i__1[1] = 13, a__1[1] = "generalmeter{";
-#line 25632 ""
+#line 25628 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25632 ""
+#line 25628 ""
i__1[3] = 6, a__1[3] = "meterN";
-#line 25632 ""
+#line 25628 ""
s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
-#line 25632 ""
+#line 25628 ""
do_fio(&c__1, ch__4, (ftnlen)21);
-#line 25632 ""
+#line 25628 ""
do_fio(&c__1, (char *)&(*mtrdnp), (ftnlen)sizeof(integer));
-#line 25632 ""
+#line 25628 ""
do_fio(&c__1, "}%", (ftnlen)2);
-#line 25632 ""
+#line 25628 ""
e_wsfe();
-#line 25634 ""
+#line 25630 ""
} else if (*mtrdnp == 5) {
-#line 25635 ""
+#line 25631 ""
s_wsfe(&io___1884);
/* Writing concatenation */
-#line 25635 ""
+#line 25631 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25635 ""
+#line 25631 ""
i__1[1] = 12, a__1[1] = "generalmeter";
-#line 25635 ""
+#line 25631 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25635 ""
+#line 25631 ""
i__1[3] = 10, a__1[3] = "allabreve%";
-#line 25635 ""
+#line 25631 ""
s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
-#line 25635 ""
+#line 25631 ""
do_fio(&c__1, ch__5, (ftnlen)24);
-#line 25635 ""
+#line 25631 ""
e_wsfe();
-#line 25636 ""
+#line 25632 ""
} else if (*mtrdnp == 6) {
-#line 25637 ""
+#line 25633 ""
s_wsfe(&io___1885);
/* Writing concatenation */
-#line 25637 ""
+#line 25633 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25637 ""
+#line 25633 ""
i__1[1] = 12, a__1[1] = "generalmeter";
-#line 25637 ""
+#line 25633 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25637 ""
+#line 25633 ""
i__1[3] = 7, a__1[3] = "meterC%";
-#line 25637 ""
+#line 25633 ""
s_cat(ch__4, a__1, i__1, &c__4, (ftnlen)21);
-#line 25637 ""
+#line 25633 ""
do_fio(&c__1, ch__4, (ftnlen)21);
-#line 25637 ""
+#line 25633 ""
e_wsfe();
-#line 25638 ""
+#line 25634 ""
} else if (*mtrdnp == 7) {
-#line 25639 ""
+#line 25635 ""
s_wsfe(&io___1886);
/* Writing concatenation */
-#line 25639 ""
+#line 25635 ""
i__1[0] = 1, a__1[0] = sq;
-#line 25639 ""
+#line 25635 ""
i__1[1] = 12, a__1[1] = "generalmeter";
-#line 25639 ""
+#line 25635 ""
i__1[2] = 1, a__1[2] = sq;
-#line 25639 ""
+#line 25635 ""
i__1[3] = 10, a__1[3] = "meterIIIS%";
-#line 25639 ""
+#line 25635 ""
s_cat(ch__5, a__1, i__1, &c__4, (ftnlen)24);
-#line 25639 ""
+#line 25635 ""
do_fio(&c__1, ch__5, (ftnlen)24);
-#line 25639 ""
+#line 25635 ""
e_wsfe();
-#line 25640 ""
+#line 25636 ""
}
-#line 25641 ""
+#line 25637 ""
return 0;
} /* wgmeter_ */
@@ -64406,8 +64695,6 @@ L4:
static cilist io___1921 = { 0, 52, 0, "(z4)", 0 };
static cilist io___1922 = { 0, 51, 0, "(a,$)", 0 };
static cilist io___1923 = { 0, 52, 0, "(4z4)", 0 };
- static cilist io___1924 = { 0, 6, 0, "(1x,a12,(10i6))", 0 };
- static cilist io___1925 = { 0, 15, 0, "(1x,a12,(10i6))", 0 };
@@ -64419,705 +64706,693 @@ L4:
/* Write Header */
-#line 25694 ""
+#line 25690 ""
s_wsfe(&io___1888);
/* Writing concatenation */
-#line 25694 ""
+#line 25690 ""
i__1[0] = 11, a__1[0] = "MThd\000\000\000\006\000\001\000";
-#line 25694 ""
+#line 25690 ""
*(unsigned char *)&ch__2[0] = commidi_1.numchan + 1;
-#line 25694 ""
+#line 25690 ""
i__1[1] = 1, a__1[1] = ch__2;
-#line 25694 ""
+#line 25690 ""
i__1[2] = 1, a__1[2] = "\000";
-#line 25694 ""
+#line 25690 ""
i__1[3] = 1, a__1[3] = "\360";
-#line 25694 ""
+#line 25690 ""
s_cat(ch__1, a__1, i__1, &c__4, (ftnlen)14);
-#line 25694 ""
+#line 25690 ""
do_fio(&c__1, ch__1, (ftnlen)14);
-#line 25694 ""
+#line 25690 ""
e_wsfe();
-#line 25696 ""
+#line 25692 ""
if (commidi_1.debugmidi) {
-#line 25696 ""
+#line 25692 ""
s_wsfe(&io___1889);
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, "\"MThd\"", (ftnlen)6);
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
i__2 = commidi_1.numchan + 1;
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
do_fio(&c__1, (char *)&c__240, (ftnlen)sizeof(integer));
-#line 25696 ""
+#line 25692 ""
e_wsfe();
-#line 25696 ""
+#line 25692 ""
}
/* Write the "conductor" track, for keys, meter, and tempos */
/* Get the number of bytes in the conductor event stream */
-#line 25703 ""
+#line 25699 ""
ndata = commidi_1.imidi[commidi_1.numchan] + 1 - commmac_1.msecstrt[
commidi_1.numchan + commmac_1.nmidsec * 25 - 25];
-#line 25704 ""
+#line 25700 ""
i__2 = commmac_1.nmidsec - 1;
-#line 25704 ""
+#line 25700 ""
for (isec = 1; isec <= i__2; ++isec) {
-#line 25705 ""
+#line 25701 ""
ndata = ndata + 1 + commmac_1.msecend[commidi_1.numchan + isec * 25 -
25] - commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
-#line 25706 ""
+#line 25702 ""
/* L15: */
-#line 25706 ""
+#line 25702 ""
}
/* ib1 = (4+ljob+26+ndata+4)/256 */
/* ib0 = 4+ljob+26+ndata+4-256*ib1 */
-#line 25709 ""
+#line 25705 ""
ib1 = (*ljob + 31 + ndata + 4) / 256;
-#line 25710 ""
+#line 25706 ""
ib0 = *ljob + 31 + ndata + 4 - (ib1 << 8);
-#line 25711 ""
+#line 25707 ""
s_wsfe(&io___1894);
/* Writing concatenation */
-#line 25711 ""
+#line 25707 ""
i__3[0] = 6, a__2[0] = "MTrk\000\000";
-#line 25711 ""
+#line 25707 ""
*(unsigned char *)&ch__2[0] = ib1;
-#line 25711 ""
+#line 25707 ""
i__3[1] = 1, a__2[1] = ch__2;
-#line 25711 ""
+#line 25707 ""
*(unsigned char *)&ch__4[0] = ib0;
-#line 25711 ""
+#line 25707 ""
i__3[2] = 1, a__2[2] = ch__4;
-#line 25711 ""
+#line 25707 ""
i__3[3] = 1, a__2[3] = "\000";
-#line 25711 ""
+#line 25707 ""
i__3[4] = 1, a__2[4] = "\377";
-#line 25711 ""
+#line 25707 ""
i__3[5] = 1, a__2[5] = "\001";
-#line 25711 ""
+#line 25707 ""
*(unsigned char *)&ch__5[0] = *ljob + 27;
-#line 25711 ""
+#line 25707 ""
i__3[6] = 1, a__2[6] = ch__5;
-#line 25711 ""
+#line 25707 ""
s_cat(ch__3, a__2, i__3, &c__7, (ftnlen)12);
-#line 25711 ""
+#line 25707 ""
do_fio(&c__1, ch__3, (ftnlen)12);
-#line 25711 ""
+#line 25707 ""
e_wsfe();
/* Text header */
/* * //char(0)//char(255)//char(1)//char(ljob+26) */
-#line 25717 ""
+#line 25713 ""
if (commidi_1.debugmidi) {
-#line 25717 ""
+#line 25713 ""
s_wsfe(&io___1895);
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, "\"MTrk\"", (ftnlen)6);
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&ib1, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&ib0, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
i__2 = *ljob + 27;
-#line 25717 ""
+#line 25713 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 25717 ""
+#line 25713 ""
e_wsfe();
-#line 25717 ""
+#line 25713 ""
}
-#line 25720 ""
+#line 25716 ""
s_wsfe(&io___1896);
-#line 25720 ""
+#line 25716 ""
do_fio(&c__1, jobname, (*ljob));
-#line 25720 ""
+#line 25716 ""
e_wsfe();
-#line 25721 ""
+#line 25717 ""
if (commidi_1.debugmidi) {
-#line 25721 ""
+#line 25717 ""
s_wsfe(&io___1897);
/* Writing concatenation */
-#line 25721 ""
- i__4[0] = 1, a__3[0] = "\"";
-#line 25721 ""
+#line 25717 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 25717 ""
+ i__4[0] = 1, a__3[0] = ch__2;
+#line 25717 ""
i__4[1] = *ljob, a__3[1] = jobname;
-#line 25721 ""
- i__4[2] = 1, a__3[2] = "\"";
-#line 25721 ""
+#line 25717 ""
+ chax_(ch__4, (ftnlen)1, &c__34);
+#line 25717 ""
+ i__4[2] = 1, a__3[2] = ch__4;
+#line 25717 ""
s_cat(ch__6, a__3, i__4, &c__3, (ftnlen)46);
-#line 25721 ""
+#line 25717 ""
do_fio(&c__1, ch__6, *ljob + 2);
-#line 25721 ""
+#line 25717 ""
e_wsfe();
-#line 25721 ""
+#line 25717 ""
}
/* (separate writes are needed to defeat compiler BUG!!!) */
-/* write(51,'(a,$)')'.mid, produced by PMX 2.30' */
-#line 25726 ""
+#line 25721 ""
s_wsfe(&io___1898);
/* Writing concatenation */
-#line 25726 ""
+#line 25721 ""
i__5[0] = 22, a__4[0] = ".mid, produced by PMX ";
-#line 25726 ""
+#line 25721 ""
i__5[1] = 5, a__4[1] = comver_1.versionc;
-#line 25726 ""
+#line 25721 ""
s_cat(ch__7, a__4, i__5, &c__2, (ftnlen)27);
-#line 25726 ""
+#line 25721 ""
do_fio(&c__1, ch__7, (ftnlen)27);
-#line 25726 ""
+#line 25721 ""
e_wsfe();
-#line 25727 ""
+#line 25722 ""
if (commidi_1.debugmidi) {
-#line 25727 ""
+#line 25722 ""
s_wsfe(&io___1899);
/* Writing concatenation */
-#line 25727 ""
- i__4[0] = 23, a__3[0] = "\".mid, produced by PMX ";
-#line 25727 ""
- i__4[1] = 5, a__3[1] = comver_1.versionc;
-#line 25727 ""
- i__4[2] = 1, a__3[2] = "\"";
-#line 25727 ""
- s_cat(ch__8, a__3, i__4, &c__3, (ftnlen)29);
-#line 25727 ""
+#line 25722 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 25722 ""
+ i__1[0] = 1, a__1[0] = ch__2;
+#line 25722 ""
+ i__1[1] = 22, a__1[1] = ".mid, produced by PMX ";
+#line 25722 ""
+ i__1[2] = 5, a__1[2] = comver_1.versionc;
+#line 25722 ""
+ chax_(ch__4, (ftnlen)1, &c__34);
+#line 25722 ""
+ i__1[3] = 1, a__1[3] = ch__4;
+#line 25722 ""
+ s_cat(ch__8, a__1, i__1, &c__4, (ftnlen)29);
+#line 25722 ""
do_fio(&c__1, ch__8, (ftnlen)29);
-#line 25727 ""
+#line 25722 ""
e_wsfe();
-#line 25727 ""
+#line 25722 ""
}
/* Conductor event data: Loop over sections. */
-#line 25732 ""
+#line 25727 ""
i__2 = commmac_1.nmidsec;
-#line 25732 ""
+#line 25727 ""
for (isec = 1; isec <= i__2; ++isec) {
-#line 25733 ""
+#line 25728 ""
if (isec < commmac_1.nmidsec) {
-#line 25734 ""
+#line 25729 ""
mend = commmac_1.msecend[commidi_1.numchan + isec * 25 - 25];
-#line 25735 ""
+#line 25730 ""
} else {
-#line 25736 ""
+#line 25731 ""
mend = commidi_1.imidi[commidi_1.numchan];
-#line 25737 ""
+#line 25732 ""
}
-#line 25738 ""
+#line 25733 ""
i__6 = mend;
-#line 25738 ""
+#line 25733 ""
for (i__ = commmac_1.msecstrt[commidi_1.numchan + isec * 25 - 25];
i__ <= i__6; ++i__) {
-#line 25739 ""
+#line 25734 ""
s_wsfe(&io___1902);
-#line 25739 ""
+#line 25734 ""
*(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[
commidi_1.numchan + i__ * 25 - 25];
-#line 25739 ""
+#line 25734 ""
do_fio(&c__1, ch__2, (ftnlen)1);
-#line 25739 ""
+#line 25734 ""
e_wsfe();
-#line 25740 ""
+#line 25735 ""
if (commidi_1.debugmidi) {
-#line 25740 ""
+#line 25735 ""
s_wsfe(&io___1903);
-#line 25740 ""
+#line 25735 ""
do_fio(&c__1, (char *)&commidi_1.mmidi[commidi_1.numchan +
i__ * 25 - 25], (ftnlen)sizeof(shortint));
-#line 25740 ""
+#line 25735 ""
e_wsfe();
-#line 25740 ""
+#line 25735 ""
}
-#line 25741 ""
+#line 25736 ""
/* L17: */
-#line 25741 ""
+#line 25736 ""
}
-#line 25742 ""
+#line 25737 ""
/* L16: */
-#line 25742 ""
+#line 25737 ""
}
/* And close out the time sig / tempo track. */
-#line 25746 ""
+#line 25741 ""
s_wsfe(&io___1904);
-#line 25746 ""
+#line 25741 ""
do_fio(&c__1, "\000\377/\000", (ftnlen)4);
-#line 25746 ""
+#line 25741 ""
e_wsfe();
-#line 25747 ""
+#line 25742 ""
if (commidi_1.debugmidi) {
-#line 25747 ""
+#line 25742 ""
s_wsfe(&io___1905);
-#line 25747 ""
+#line 25742 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25747 ""
+#line 25742 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
-#line 25747 ""
+#line 25742 ""
do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
-#line 25747 ""
+#line 25742 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25747 ""
+#line 25742 ""
e_wsfe();
-#line 25747 ""
+#line 25742 ""
}
/* Loop over track for each voice: The following sets up iv. */
-#line 25751 ""
+#line 25746 ""
all_1.iv = all_1.nv;
-#line 25752 ""
+#line 25747 ""
if (commidi_1.twoline[all_1.nv - 1]) {
-#line 25753 ""
+#line 25748 ""
kv = 2;
-#line 25754 ""
+#line 25749 ""
} else {
-#line 25755 ""
+#line 25750 ""
kv = 1;
-#line 25756 ""
+#line 25751 ""
}
-#line 25758 ""
+#line 25753 ""
i__2 = commidi_1.numchan - 1;
-#line 25758 ""
+#line 25753 ""
for (icm = 0; icm <= i__2; ++icm) {
/* Get the number of bytes in the data stream */
-#line 25762 ""
+#line 25757 ""
ndata = commidi_1.imidi[icm] + 1 - commmac_1.msecstrt[icm +
commmac_1.nmidsec * 25 - 25];
-#line 25763 ""
+#line 25758 ""
i__6 = commmac_1.nmidsec - 1;
-#line 25763 ""
+#line 25758 ""
for (isec = 1; isec <= i__6; ++isec) {
-#line 25764 ""
+#line 25759 ""
ndata = ndata + 1 + commmac_1.msecend[icm + isec * 25 - 25] -
commmac_1.msecstrt[icm + isec * 25 - 25];
-#line 25765 ""
+#line 25760 ""
/* L11: */
-#line 25765 ""
+#line 25760 ""
}
/* Add 3 for instrum, 4 for bal, plus 4 (for closing) to byte count, */
-#line 25769 ""
+#line 25764 ""
ndata += 11;
/* Add 4+lnam(iinsiv(iv)) if lnam>0 , */
-#line 25773 ""
+#line 25768 ""
if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
-#line 25773 ""
+#line 25768 ""
ndata = ndata + 4 + comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1]
- 1];
-#line 25773 ""
+#line 25768 ""
}
/* Separate total byte counts into 4 bytes */
-#line 25777 ""
+#line 25772 ""
for (ibyte = 1; ibyte <= 4; ++ibyte) {
-#line 25778 ""
+#line 25773 ""
if (ndata > 0) {
-#line 25779 ""
+#line 25774 ""
*(unsigned char *)&byteq[ibyte - 1] = (char) (ndata % 256);
-#line 25780 ""
+#line 25775 ""
ndata = lbit_shift(ndata, (ftnlen)-8);
-#line 25781 ""
+#line 25776 ""
} else {
-#line 25782 ""
+#line 25777 ""
*(unsigned char *)&byteq[ibyte - 1] = '\0';
-#line 25783 ""
+#line 25778 ""
}
-#line 25784 ""
+#line 25779 ""
/* L2: */
-#line 25784 ""
+#line 25779 ""
}
/* Now write front stuff for this track */
-#line 25788 ""
+#line 25783 ""
s_wsfe(&io___1910);
/* Writing concatenation */
-#line 25788 ""
+#line 25783 ""
i__7[0] = 4, a__5[0] = "MTrk";
-#line 25788 ""
+#line 25783 ""
i__7[1] = 1, a__5[1] = byteq + 3;
-#line 25788 ""
+#line 25783 ""
i__7[2] = 1, a__5[2] = byteq + 2;
-#line 25788 ""
+#line 25783 ""
i__7[3] = 1, a__5[3] = byteq + 1;
-#line 25788 ""
+#line 25783 ""
i__7[4] = 1, a__5[4] = byteq;
-#line 25788 ""
+#line 25783 ""
i__7[5] = 1, a__5[5] = "\000";
-#line 25788 ""
+#line 25783 ""
*(unsigned char *)&ch__2[0] = icmm[icm] + 192;
-#line 25788 ""
+#line 25783 ""
i__7[6] = 1, a__5[6] = ch__2;
-#line 25788 ""
+#line 25783 ""
*(unsigned char *)&ch__4[0] = commidi_1.midinst[commvel_1.iinsiv[
all_1.iv - 1] - 1];
-#line 25788 ""
+#line 25783 ""
i__7[7] = 1, a__5[7] = ch__4;
-#line 25788 ""
+#line 25783 ""
i__7[8] = 1, a__5[8] = "\000";
-#line 25788 ""
+#line 25783 ""
*(unsigned char *)&ch__5[0] = icmm[icm] + 176;
-#line 25788 ""
+#line 25783 ""
i__7[9] = 1, a__5[9] = ch__5;
-#line 25788 ""
+#line 25783 ""
i__7[10] = 1, a__5[10] = "\n";
-#line 25788 ""
+#line 25783 ""
*(unsigned char *)&ch__10[0] = commvel_1.midbc[icm];
-#line 25788 ""
+#line 25783 ""
i__7[11] = 1, a__5[11] = ch__10;
-#line 25788 ""
+#line 25783 ""
s_cat(ch__9, a__5, i__7, &c__12, (ftnlen)15);
-#line 25788 ""
+#line 25783 ""
do_fio(&c__1, ch__9, (ftnlen)15);
-#line 25788 ""
+#line 25783 ""
e_wsfe();
-#line 25791 ""
+#line 25786 ""
if (commidi_1.debugmidi) {
-#line 25791 ""
+#line 25786 ""
s_wsfe(&io___1911);
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, "icm=", (ftnlen)4);
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, " \"MTrk\"", (ftnlen)7);
-#line 25791 ""
+#line 25786 ""
i__6 = *(unsigned char *)&byteq[3];
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__6, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
i__8 = *(unsigned char *)&byteq[2];
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__8, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
i__9 = *(unsigned char *)&byteq[1];
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__9, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
i__10 = *(unsigned char *)&byteq[0];
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__10, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
i__11 = icmm[icm] + 192;
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__11, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[
all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
i__12 = icmm[icm] + 176;
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&i__12, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&c__10, (ftnlen)sizeof(integer));
-#line 25791 ""
+#line 25786 ""
do_fio(&c__1, (char *)&commvel_1.midbc[icm], (ftnlen)sizeof(
integer));
-#line 25791 ""
+#line 25786 ""
e_wsfe();
-#line 25791 ""
+#line 25786 ""
}
-#line 25795 ""
+#line 25790 ""
if (comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1] > 0) {
/* Add instrument name as sequence name */
-#line 25799 ""
+#line 25794 ""
s_wsfe(&io___1912);
/* Writing concatenation */
-#line 25799 ""
+#line 25794 ""
i__5[0] = 3, a__4[0] = "\000\377\003";
-#line 25799 ""
+#line 25794 ""
*(unsigned char *)&ch__2[0] = comtop_1.lnam[commvel_1.iinsiv[
all_1.iv - 1] - 1];
-#line 25799 ""
+#line 25794 ""
i__5[1] = 1, a__4[1] = ch__2;
-#line 25799 ""
+#line 25794 ""
s_cat(ch__11, a__4, i__5, &c__2, (ftnlen)4);
-#line 25799 ""
+#line 25794 ""
do_fio(&c__1, ch__11, (ftnlen)4);
-#line 25799 ""
+#line 25794 ""
e_wsfe();
-#line 25801 ""
+#line 25796 ""
if (commidi_1.debugmidi) {
-#line 25801 ""
+#line 25796 ""
s_wsfe(&io___1913);
-#line 25801 ""
+#line 25796 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25801 ""
+#line 25796 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
-#line 25801 ""
+#line 25796 ""
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
-#line 25801 ""
+#line 25796 ""
do_fio(&c__1, (char *)&comtop_1.lnam[commvel_1.iinsiv[
all_1.iv - 1] - 1], (ftnlen)sizeof(integer));
-#line 25801 ""
+#line 25796 ""
e_wsfe();
-#line 25801 ""
+#line 25796 ""
}
-#line 25802 ""
+#line 25797 ""
s_wsfe(&io___1914);
-#line 25802 ""
+#line 25797 ""
do_fio(&c__1, comtop_1.inameq + (commvel_1.iinsiv[all_1.iv - 1] -
1) * 79, comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1]
);
-#line 25802 ""
+#line 25797 ""
e_wsfe();
-#line 25804 ""
+#line 25799 ""
if (commidi_1.debugmidi) {
-#line 25804 ""
+#line 25799 ""
s_wsfe(&io___1915);
/* Writing concatenation */
-#line 25804 ""
- i__4[0] = 1, a__3[0] = "\"";
-#line 25804 ""
+#line 25799 ""
+ chax_(ch__2, (ftnlen)1, &c__34);
+#line 25799 ""
+ i__4[0] = 1, a__3[0] = ch__2;
+#line 25799 ""
i__4[1] = comtop_1.lnam[commvel_1.iinsiv[all_1.iv - 1] - 1],
a__3[1] = comtop_1.inameq + (commvel_1.iinsiv[
all_1.iv - 1] - 1) * 79;
-#line 25804 ""
- i__4[2] = 1, a__3[2] = "\"";
-#line 25804 ""
+#line 25799 ""
+ chax_(ch__4, (ftnlen)1, &c__34);
+#line 25799 ""
+ i__4[2] = 1, a__3[2] = ch__4;
+#line 25799 ""
s_cat(ch__12, a__3, i__4, &c__3, (ftnlen)81);
-#line 25804 ""
+#line 25799 ""
do_fio(&c__1, ch__12, comtop_1.lnam[commvel_1.iinsiv[all_1.iv
- 1] - 1] + 2);
-#line 25804 ""
+#line 25799 ""
e_wsfe();
-#line 25804 ""
+#line 25799 ""
}
-#line 25806 ""
+#line 25801 ""
}
-#line 25807 ""
+#line 25802 ""
s_wsfi(&io___1917);
-#line 25807 ""
+#line 25802 ""
do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer));
-#line 25807 ""
+#line 25802 ""
e_wsfi();
-#line 25808 ""
+#line 25803 ""
s_wsfi(&io___1919);
-#line 25808 ""
+#line 25803 ""
do_fio(&c__1, (char *)&commidi_1.midinst[commvel_1.iinsiv[all_1.iv -
1] - 1], (ftnlen)sizeof(integer));
-#line 25808 ""
+#line 25803 ""
e_wsfi();
/* Writing concatenation */
-#line 25809 ""
+#line 25804 ""
i__1[0] = 16, a__1[0] = "MIDI instrument ";
-#line 25809 ""
+#line 25804 ""
i__1[1] = 2, a__1[1] = tempoq;
-#line 25809 ""
+#line 25804 ""
i__1[2] = 4, a__1[2] = " is ";
-#line 25809 ""
+#line 25804 ""
i__1[3] = 3, a__1[3] = instq;
-#line 25809 ""
+#line 25804 ""
s_cat(ch__13, a__1, i__1, &c__4, (ftnlen)25);
-#line 25809 ""
+#line 25804 ""
printl_(ch__13, (ftnlen)25);
/* Notes: Loop over sections. */
-#line 25813 ""
+#line 25808 ""
i__6 = commmac_1.nmidsec;
-#line 25813 ""
+#line 25808 ""
for (isec = 1; isec <= i__6; ++isec) {
-#line 25814 ""
+#line 25809 ""
if (isec < commmac_1.nmidsec) {
-#line 25815 ""
+#line 25810 ""
mend = commmac_1.msecend[icm + isec * 25 - 25];
-#line 25816 ""
+#line 25811 ""
} else {
-#line 25817 ""
+#line 25812 ""
mend = commidi_1.imidi[icm];
-#line 25818 ""
+#line 25813 ""
}
-#line 25819 ""
+#line 25814 ""
i__8 = mend;
-#line 25819 ""
+#line 25814 ""
for (i__ = commmac_1.msecstrt[icm + isec * 25 - 25]; i__ <= i__8;
++i__) {
-#line 25820 ""
+#line 25815 ""
s_wsfe(&io___1920);
-#line 25820 ""
+#line 25815 ""
*(unsigned char *)&ch__2[0] = (char) commidi_1.mmidi[icm +
i__ * 25 - 25];
-#line 25820 ""
+#line 25815 ""
do_fio(&c__1, ch__2, (ftnlen)1);
-#line 25820 ""
+#line 25815 ""
e_wsfe();
-#line 25821 ""
+#line 25816 ""
if (commidi_1.debugmidi) {
-#line 25821 ""
+#line 25816 ""
s_wsfe(&io___1921);
-#line 25821 ""
+#line 25816 ""
do_fio(&c__1, (char *)&commidi_1.mmidi[icm + i__ * 25 -
25], (ftnlen)sizeof(shortint));
-#line 25821 ""
+#line 25816 ""
e_wsfe();
-#line 25821 ""
+#line 25816 ""
}
-#line 25822 ""
+#line 25817 ""
/* L10: */
-#line 25822 ""
+#line 25817 ""
}
-#line 25823 ""
+#line 25818 ""
/* L9: */
-#line 25823 ""
+#line 25818 ""
}
/* Closing 4 bytes */
-#line 25827 ""
+#line 25822 ""
s_wsfe(&io___1922);
/* Writing concatenation */
-#line 25827 ""
+#line 25822 ""
chax_(ch__2, (ftnlen)1, &c__0);
-#line 25827 ""
+#line 25822 ""
i__1[0] = 1, a__1[0] = ch__2;
-#line 25827 ""
+#line 25822 ""
i__1[1] = 1, a__1[1] = "\377";
-#line 25827 ""
+#line 25822 ""
i__1[2] = 1, a__1[2] = "/";
-#line 25827 ""
+#line 25822 ""
i__1[3] = 1, a__1[3] = "\000";
-#line 25827 ""
+#line 25822 ""
s_cat(ch__11, a__1, i__1, &c__4, (ftnlen)4);
-#line 25827 ""
+#line 25822 ""
do_fio(&c__1, ch__11, (ftnlen)4);
-#line 25827 ""
+#line 25822 ""
e_wsfe();
-#line 25828 ""
+#line 25823 ""
if (commidi_1.debugmidi) {
-#line 25828 ""
+#line 25823 ""
s_wsfe(&io___1923);
-#line 25828 ""
+#line 25823 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25828 ""
+#line 25823 ""
do_fio(&c__1, (char *)&c__255, (ftnlen)sizeof(integer));
-#line 25828 ""
+#line 25823 ""
do_fio(&c__1, (char *)&c__47, (ftnlen)sizeof(integer));
-#line 25828 ""
+#line 25823 ""
do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
-#line 25828 ""
+#line 25823 ""
e_wsfe();
-#line 25828 ""
+#line 25823 ""
}
-#line 25829 ""
+#line 25824 ""
if (kv == 2) {
-#line 25830 ""
+#line 25825 ""
kv = 1;
-#line 25831 ""
+#line 25826 ""
} else if (all_1.iv == 1) {
-#line 25832 ""
+#line 25827 ""
goto L5;
-#line 25833 ""
+#line 25828 ""
} else {
-#line 25834 ""
+#line 25829 ""
--all_1.iv;
-#line 25835 ""
+#line 25830 ""
if (commidi_1.twoline[all_1.iv - 1]) {
-#line 25835 ""
+#line 25830 ""
kv = 2;
-#line 25835 ""
+#line 25830 ""
}
-#line 25836 ""
+#line 25831 ""
}
-#line 25837 ""
+#line 25832 ""
L5:
-#line 25837 ""
+#line 25832 ""
;
-#line 25837 ""
- }
-#line 25838 ""
- s_wsfe(&io___1924);
-#line 25838 ""
- do_fio(&c__1, "Bytes used:", (ftnlen)11);
-#line 25838 ""
- i__2 = commidi_1.numchan;
-#line 25838 ""
- for (icm = 0; icm <= i__2; ++icm) {
-#line 25838 ""
- do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
-#line 25838 ""
- }
-#line 25838 ""
- e_wsfe();
-#line 25839 ""
- s_wsfe(&io___1925);
-#line 25839 ""
- do_fio(&c__1, "Bytes used:", (ftnlen)11);
-#line 25839 ""
- i__2 = commidi_1.numchan;
-#line 25839 ""
- for (icm = 0; icm <= i__2; ++icm) {
-#line 25839 ""
- do_fio(&c__1, (char *)&commidi_1.imidi[icm], (ftnlen)sizeof(integer));
-#line 25839 ""
+#line 25832 ""
}
-#line 25839 ""
- e_wsfe();
-#line 25841 ""
+/* write(*,'(1x,a12,(10i6))')'Bytes used:',(imidi(icm),icm=0,numchan) */
+/* write(15,'(1x,a12,(10i6))') */
+/* * 'Bytes used:',(imidi(icm),icm=0,numchan) */
+#line 25836 ""
cl__1.cerr = 0;
-#line 25841 ""
+#line 25836 ""
cl__1.cunit = 51;
-#line 25841 ""
+#line 25836 ""
cl__1.csta = 0;
-#line 25841 ""
+#line 25836 ""
f_clos(&cl__1);
-#line 25842 ""
+#line 25837 ""
if (commidi_1.debugmidi) {
-#line 25842 ""
+#line 25837 ""
cl__1.cerr = 0;
-#line 25842 ""
+#line 25837 ""
cl__1.cunit = 52;
-#line 25842 ""
+#line 25837 ""
cl__1.csta = 0;
-#line 25842 ""
+#line 25837 ""
f_clos(&cl__1);
-#line 25842 ""
+#line 25837 ""
}
-#line 25843 ""
+#line 25838 ""
return 0;
} /* writemidi_ */
@@ -65142,143 +65417,143 @@ L5:
static char notexq[79];
/* Fortran I/O blocks */
- static cilist io___1929 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1927 = { 0, 11, 0, "(a)", 0 };
/* Assumes notexq is blank */
-#line 25854 ""
+#line 25849 ""
/* Parameter adjustments */
-#line 25854 ""
+#line 25849 ""
--itranskey;
-#line 25854 ""
+#line 25849 ""
--iinsttrans;
-#line 25854 ""
+#line 25849 ""
-#line 25854 ""
+#line 25849 ""
/* Function Body */
-#line 25854 ""
+#line 25849 ""
i__1 = *ninsttrans;
-#line 25854 ""
+#line 25849 ""
for (i__ = 1; i__ <= i__1; ++i__) {
/* Writing concatenation */
-#line 25855 ""
+#line 25850 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 25855 ""
+#line 25850 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 25855 ""
+#line 25850 ""
i__2[1] = 7, a__1[1] = "setsign";
-#line 25855 ""
+#line 25850 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 25856 ""
+#line 25851 ""
lnote = 8;
-#line 25857 ""
+#line 25852 ""
if (iinsttrans[i__] < 10) {
/* Writing concatenation */
-#line 25858 ""
+#line 25853 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 25858 ""
+#line 25853 ""
i__3 = iinsttrans[i__] + 48;
-#line 25858 ""
+#line 25853 ""
chax_(ch__1, (ftnlen)1, &i__3);
-#line 25858 ""
+#line 25853 ""
i__2[1] = 1, a__1[1] = ch__1;
-#line 25858 ""
+#line 25853 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 25859 ""
+#line 25854 ""
++lnote;
-#line 25860 ""
+#line 25855 ""
} else {
-#line 25861 ""
+#line 25856 ""
i__3 = lnote;
-#line 25861 ""
+#line 25856 ""
ici__1.icierr = 0;
-#line 25861 ""
+#line 25856 ""
ici__1.icirnum = 1;
-#line 25861 ""
+#line 25856 ""
ici__1.icirlen = lnote + 4 - i__3;
-#line 25861 ""
+#line 25856 ""
ici__1.iciunit = notexq + i__3;
-#line 25861 ""
+#line 25856 ""
ici__1.icifmt = "(a1,i2,a1)";
-#line 25861 ""
+#line 25856 ""
s_wsfi(&ici__1);
-#line 25861 ""
+#line 25856 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 25861 ""
+#line 25856 ""
do_fio(&c__1, (char *)&iinsttrans[i__], (ftnlen)sizeof(integer));
-#line 25861 ""
+#line 25856 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 25861 ""
+#line 25856 ""
e_wsfi();
-#line 25863 ""
+#line 25858 ""
lnote += 4;
-#line 25864 ""
+#line 25859 ""
}
-#line 25865 ""
+#line 25860 ""
if (itranskey[i__] < 0) {
-#line 25866 ""
+#line 25861 ""
i__3 = lnote;
-#line 25866 ""
+#line 25861 ""
ici__1.icierr = 0;
-#line 25866 ""
+#line 25861 ""
ici__1.icirnum = 1;
-#line 25866 ""
+#line 25861 ""
ici__1.icirlen = lnote + 4 - i__3;
-#line 25866 ""
+#line 25861 ""
ici__1.iciunit = notexq + i__3;
-#line 25866 ""
+#line 25861 ""
ici__1.icifmt = "(a1,i2,a1)";
-#line 25866 ""
+#line 25861 ""
s_wsfi(&ici__1);
-#line 25866 ""
+#line 25861 ""
do_fio(&c__1, "{", (ftnlen)1);
-#line 25866 ""
+#line 25861 ""
do_fio(&c__1, (char *)&itranskey[i__], (ftnlen)sizeof(integer));
-#line 25866 ""
+#line 25861 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 25866 ""
+#line 25861 ""
e_wsfi();
-#line 25868 ""
+#line 25863 ""
lnote += 4;
-#line 25869 ""
+#line 25864 ""
} else {
/* Writing concatenation */
-#line 25870 ""
+#line 25865 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 25870 ""
+#line 25865 ""
i__3 = itranskey[i__] + 48;
-#line 25870 ""
+#line 25865 ""
chax_(ch__1, (ftnlen)1, &i__3);
-#line 25870 ""
+#line 25865 ""
i__2[1] = 1, a__1[1] = ch__1;
-#line 25870 ""
+#line 25865 ""
s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79);
-#line 25871 ""
+#line 25866 ""
++lnote;
-#line 25872 ""
+#line 25867 ""
}
-#line 25873 ""
- s_wsfe(&io___1929);
+#line 25868 ""
+ s_wsfe(&io___1927);
/* Writing concatenation */
-#line 25873 ""
+#line 25868 ""
i__2[0] = lnote, a__1[0] = notexq;
-#line 25873 ""
+#line 25868 ""
i__2[1] = 1, a__1[1] = "%";
-#line 25873 ""
+#line 25868 ""
s_cat(ch__2, a__1, i__2, &c__2, (ftnlen)80);
-#line 25873 ""
+#line 25868 ""
do_fio(&c__1, ch__2, lnote + 1);
-#line 25873 ""
+#line 25868 ""
e_wsfe();
-#line 25874 ""
+#line 25869 ""
/* L1: */
-#line 25874 ""
+#line 25869 ""
}
-#line 25875 ""
+#line 25870 ""
*flag__ = FALSE_;
-#line 25876 ""
+#line 25871 ""
return 0;
} /* writesetsign_ */
@@ -65293,75 +65568,75 @@ L5:
integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
;
-#line 25880 ""
+#line 25875 ""
if (*x < .95f) {
-#line 25881 ""
+#line 25876 ""
i__1 = *lenline;
-#line 25881 ""
+#line 25876 ""
ici__1.icierr = 0;
-#line 25881 ""
+#line 25876 ""
ici__1.icirnum = 1;
-#line 25881 ""
+#line 25876 ""
ici__1.icirlen = *lenline + 2 - i__1;
-#line 25881 ""
+#line 25876 ""
ici__1.iciunit = notexq + i__1;
-#line 25881 ""
+#line 25876 ""
ici__1.icifmt = "(f2.1)";
-#line 25881 ""
+#line 25876 ""
s_wsfi(&ici__1);
-#line 25881 ""
+#line 25876 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
-#line 25881 ""
+#line 25876 ""
e_wsfi();
-#line 25882 ""
+#line 25877 ""
*lenline += 2;
-#line 25883 ""
+#line 25878 ""
} else if (*x < 9.95f) {
-#line 25884 ""
+#line 25879 ""
i__1 = *lenline;
-#line 25884 ""
+#line 25879 ""
ici__1.icierr = 0;
-#line 25884 ""
+#line 25879 ""
ici__1.icirnum = 1;
-#line 25884 ""
+#line 25879 ""
ici__1.icirlen = *lenline + 3 - i__1;
-#line 25884 ""
+#line 25879 ""
ici__1.iciunit = notexq + i__1;
-#line 25884 ""
+#line 25879 ""
ici__1.icifmt = "(f3.1)";
-#line 25884 ""
+#line 25879 ""
s_wsfi(&ici__1);
-#line 25884 ""
+#line 25879 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
-#line 25884 ""
+#line 25879 ""
e_wsfi();
-#line 25885 ""
+#line 25880 ""
*lenline += 3;
-#line 25886 ""
+#line 25881 ""
} else {
-#line 25887 ""
+#line 25882 ""
i__1 = *lenline;
-#line 25887 ""
+#line 25882 ""
ici__1.icierr = 0;
-#line 25887 ""
+#line 25882 ""
ici__1.icirnum = 1;
-#line 25887 ""
+#line 25882 ""
ici__1.icirlen = *lenline + 4 - i__1;
-#line 25887 ""
+#line 25882 ""
ici__1.iciunit = notexq + i__1;
-#line 25887 ""
+#line 25882 ""
ici__1.icifmt = "(f4.1)";
-#line 25887 ""
+#line 25882 ""
s_wsfi(&ici__1);
-#line 25887 ""
+#line 25882 ""
do_fio(&c__1, (char *)&(*x), (ftnlen)sizeof(real));
-#line 25887 ""
+#line 25882 ""
e_wsfi();
-#line 25888 ""
+#line 25883 ""
*lenline += 4;
-#line 25889 ""
+#line 25884 ""
}
-#line 25890 ""
+#line 25885 ""
return 0;
} /* writflot_ */
@@ -65389,12 +65664,12 @@ L5:
extern integer numclef_(char *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1932 = { 0, 6, 0, 0, 0 };
- static cilist io___1933 = { 0, 6, 0, 0, 0 };
- static icilist io___1937 = { 0, temq, 0, "(a9,i2,a1)", 40, 1 };
+ static cilist io___1930 = { 0, 6, 0, 0, 0 };
+ static cilist io___1931 = { 0, 6, 0, 0, 0 };
+ static icilist io___1935 = { 0, temq, 0, "(a9,i2,a1)", 40, 1 };
+ static cilist io___1936 = { 0, 11, 0, "(a)", 0 };
static cilist io___1938 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1940 = { 0, 11, 0, "(a)", 0 };
- static cilist io___1941 = { 0, 11, 0, "(a)", 0 };
+ static cilist io___1939 = { 0, 11, 0, "(a)", 0 };
/* subroutine wsclef(iv,ninow,clefq,nclef) */
@@ -65405,209 +65680,209 @@ L5:
/* In pmx271, had removed clefq, so with 2 or more staves in */
/* an instrument, had problems. So replace in 272 */
-#line 25911 ""
+#line 25906 ""
if (*nclef < 7) {
-#line 25912 ""
+#line 25907 ""
i__1 = *nclef + 48;
-#line 25912 ""
+#line 25907 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 25912 ""
+#line 25907 ""
*(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)&
ch__1[0];
-#line 25913 ""
+#line 25908 ""
} else {
-#line 25914 ""
+#line 25909 ""
*(unsigned char *)&comclefq_1.clefq[*iv - 1] = '9';
-#line 25915 ""
+#line 25910 ""
}
-#line 25916 ""
+#line 25911 ""
if (! comlast_1.islast) {
-#line 25916 ""
+#line 25911 ""
return 0;
-#line 25916 ""
+#line 25911 ""
}
-#line 25917 ""
+#line 25912 ""
iv1 = 1;
-#line 25918 ""
+#line 25913 ""
i__1 = *ninow;
-#line 25918 ""
+#line 25913 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 25919 ""
+#line 25914 ""
if (*iv < iv1 + comnvi_1.nspern[iinst - 1]) {
-#line 25919 ""
+#line 25914 ""
goto L2;
-#line 25919 ""
+#line 25914 ""
}
-#line 25920 ""
+#line 25915 ""
iv1 += comnvi_1.nspern[iinst - 1];
-#line 25921 ""
+#line 25916 ""
/* L1: */
-#line 25921 ""
+#line 25916 ""
}
-#line 25922 ""
- s_wsle(&io___1932);
-#line 25922 ""
+#line 25917 ""
+ s_wsle(&io___1930);
+#line 25917 ""
e_wsle();
-#line 25923 ""
- s_wsle(&io___1933);
-#line 25923 ""
+#line 25918 ""
+ s_wsle(&io___1931);
+#line 25918 ""
do_lio(&c__9, &c__1, "Should not be here in wsclef!", (ftnlen)29);
-#line 25923 ""
+#line 25918 ""
e_wsle();
-#line 25924 ""
+#line 25919 ""
stop1_();
-#line 25925 ""
+#line 25920 ""
L2:
/* Here, iinst is the instrument number with staff of clef change */
-#line 25929 ""
+#line 25924 ""
iv2 = iv1 + comnvi_1.nspern[iinst - 1] - 1;
-#line 25930 ""
+#line 25925 ""
if (iinst < 10) {
/* Writing concatenation */
-#line 25931 ""
+#line 25926 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 25931 ""
+#line 25926 ""
i__2[0] = 1, a__1[0] = ch__1;
-#line 25931 ""
+#line 25926 ""
i__2[1] = 7, a__1[1] = "setclef";
-#line 25931 ""
+#line 25926 ""
i__1 = iinst + 48;
-#line 25931 ""
+#line 25926 ""
chax_(ch__2, (ftnlen)1, &i__1);
-#line 25931 ""
+#line 25926 ""
i__2[2] = 1, a__1[2] = ch__2;
-#line 25931 ""
+#line 25926 ""
s_cat(temq, a__1, i__2, &c__3, (ftnlen)40);
-#line 25932 ""
+#line 25927 ""
ltem = 9;
-#line 25933 ""
+#line 25928 ""
} else {
-#line 25934 ""
- s_wsfi(&io___1937);
+#line 25929 ""
+ s_wsfi(&io___1935);
/* Writing concatenation */
-#line 25934 ""
+#line 25929 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 25934 ""
+#line 25929 ""
i__3[0] = 1, a__2[0] = ch__1;
-#line 25934 ""
+#line 25929 ""
i__3[1] = 8, a__2[1] = "setclef{";
-#line 25934 ""
+#line 25929 ""
s_cat(ch__3, a__2, i__3, &c__2, (ftnlen)9);
-#line 25934 ""
+#line 25929 ""
do_fio(&c__1, ch__3, (ftnlen)9);
-#line 25934 ""
+#line 25929 ""
do_fio(&c__1, (char *)&iinst, (ftnlen)sizeof(integer));
-#line 25934 ""
+#line 25929 ""
do_fio(&c__1, "}", (ftnlen)1);
-#line 25934 ""
+#line 25929 ""
e_wsfi();
-#line 25935 ""
+#line 25930 ""
ltem = 12;
-#line 25936 ""
+#line 25931 ""
}
-#line 25937 ""
+#line 25932 ""
if (iv1 == iv2) {
/* Only one staff (iv) in instrument with clef change */
-#line 25941 ""
- s_wsfe(&io___1938);
+#line 25936 ""
+ s_wsfe(&io___1936);
/* Writing concatenation */
-#line 25941 ""
+#line 25936 ""
i__2[0] = ltem, a__1[0] = temq;
-#line 25941 ""
+#line 25936 ""
i__2[1] = 1, a__1[1] = comclefq_1.clefq + (*iv - 1);
-#line 25941 ""
+#line 25936 ""
i__2[2] = 1, a__1[2] = "%";
-#line 25941 ""
+#line 25936 ""
s_cat(ch__4, a__1, i__2, &c__3, (ftnlen)42);
-#line 25941 ""
+#line 25936 ""
do_fio(&c__1, ch__4, ltem + 2);
-#line 25941 ""
+#line 25936 ""
e_wsfe();
-#line 25942 ""
+#line 25937 ""
} else {
/* Writing concatenation */
-#line 25943 ""
+#line 25938 ""
i__3[0] = ltem, a__2[0] = temq;
-#line 25943 ""
+#line 25938 ""
i__3[1] = 1, a__2[1] = "{";
-#line 25943 ""
+#line 25938 ""
s_cat(temq, a__2, i__3, &c__2, (ftnlen)40);
-#line 25944 ""
+#line 25939 ""
++ltem;
/* Loop over staves, but clefq has only changed for one of them */
-#line 25948 ""
+#line 25943 ""
i__1 = iv2;
-#line 25948 ""
+#line 25943 ""
for (iiv = iv1; iiv <= i__1; ++iiv) {
/* Writing concatenation */
-#line 25949 ""
+#line 25944 ""
i__3[0] = ltem, a__2[0] = temq;
-#line 25949 ""
+#line 25944 ""
i__4 = numclef_(comclefq_1.clefq + (iiv - 1), (ftnlen)1) + 48;
-#line 25949 ""
+#line 25944 ""
chax_(ch__1, (ftnlen)1, &i__4);
-#line 25949 ""
+#line 25944 ""
i__3[1] = 1, a__2[1] = ch__1;
-#line 25949 ""
+#line 25944 ""
s_cat(temq, a__2, i__3, &c__2, (ftnlen)40);
-#line 25950 ""
+#line 25945 ""
++ltem;
-#line 25951 ""
+#line 25946 ""
/* L3: */
-#line 25951 ""
+#line 25946 ""
}
-#line 25952 ""
- s_wsfe(&io___1940);
+#line 25947 ""
+ s_wsfe(&io___1938);
/* Writing concatenation */
-#line 25952 ""
+#line 25947 ""
i__3[0] = ltem, a__2[0] = temq;
-#line 25952 ""
+#line 25947 ""
i__3[1] = 2, a__2[1] = "}%";
-#line 25952 ""
+#line 25947 ""
s_cat(ch__4, a__2, i__3, &c__2, (ftnlen)42);
-#line 25952 ""
+#line 25947 ""
do_fio(&c__1, ch__4, ltem + 2);
-#line 25952 ""
+#line 25947 ""
e_wsfe();
-#line 25953 ""
+#line 25948 ""
}
-#line 25954 ""
+#line 25949 ""
if (comc8flag_1.c8flag[*iv - 1]) {
/* If we change FROM octave treble clef to some other, need the following. */
-#line 25958 ""
- s_wsfe(&io___1941);
+#line 25953 ""
+ s_wsfe(&io___1939);
/* Writing concatenation */
-#line 25958 ""
+#line 25953 ""
i__5[0] = 20, a__3[0] = "\\settrebleclefsymbol";
-#line 25958 ""
+#line 25953 ""
i__1 = iinst + 48;
-#line 25958 ""
+#line 25953 ""
chax_(ch__1, (ftnlen)1, &i__1);
-#line 25958 ""
+#line 25953 ""
i__5[1] = 1, a__3[1] = ch__1;
-#line 25958 ""
+#line 25953 ""
i__5[2] = 1, a__3[2] = "\\";
-#line 25958 ""
+#line 25953 ""
i__5[3] = 11, a__3[3] = "trebleclef%";
-#line 25958 ""
+#line 25953 ""
s_cat(ch__5, a__3, i__5, &c__4, (ftnlen)33);
-#line 25958 ""
+#line 25953 ""
do_fio(&c__1, ch__5, (ftnlen)33);
-#line 25958 ""
+#line 25953 ""
e_wsfe();
-#line 25960 ""
+#line 25955 ""
comc8flag_1.c8flag[*iv - 1] = FALSE_;
-#line 25961 ""
+#line 25956 ""
}
-#line 25962 ""
+#line 25957 ""
return 0;
} /* wsclef_ */
@@ -65616,99 +65891,103 @@ L2:
{
/* System generated locals */
integer i__1;
+ char ch__1[1];
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *,
ftnlen, ftnlen);
/* Local variables */
+ extern /* Character */ VOID chax_(char *, ftnlen, integer *);
static char charq[1];
extern /* Subroutine */ int g1etchar_(char *, integer *, char *, ftnlen,
ftnlen);
-#line 25967 ""
+#line 25962 ""
*lyrerr = 0;
/* On entry, last char was " */
-#line 25971 ""
+#line 25966 ""
L18:
-#line 25971 ""
+#line 25966 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 25972 ""
+#line 25967 ""
if (*iccount == 121) {
-#line 25973 ""
+#line 25968 ""
*lyrerr = 2;
-#line 25974 ""
+#line 25969 ""
return 0;
-/* else if (charq.eq.'"') then */
-#line 25976 ""
+#line 25970 ""
} else /* if(complicated condition) */ {
-#line 25976 ""
+#line 25970 ""
i__1 = *iccount - 2;
-#line 25976 ""
- if (*(unsigned char *)charq == '"' && ! (s_cmp(lineq + i__1, "\\", *
- iccount - 1 - i__1, (ftnlen)1) == 0)) {
-#line 25978 ""
+#line 25970 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 25970 ""
+ if (*(unsigned char *)charq == *(unsigned char *)&ch__1[0] && ! (
+ s_cmp(lineq + i__1, "\\", *iccount - 1 - i__1, (ftnlen)1) ==
+ 0)) {
+#line 25972 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
/* Check for raise/lower command */
-#line 25982 ""
+#line 25976 ""
if (*(unsigned char *)charq == '@') {
/* @ positions lyrics vertically for current voice */
/* [a,b] above or below of the staff */
/* +/- i offset, \internotes */
-#line 25988 ""
+#line 25982 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 25989 ""
+#line 25983 ""
if (i_indx("ab", charq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 25990 ""
+#line 25984 ""
*lyrerr = 3;
-#line 25991 ""
+#line 25985 ""
return 0;
-#line 25992 ""
+#line 25986 ""
}
-#line 25993 ""
+#line 25987 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 25994 ""
+#line 25988 ""
if (i_indx("+-", charq, (ftnlen)2, (ftnlen)1) == 0) {
-#line 25995 ""
+#line 25989 ""
*lyrerr = 4;
-#line 25996 ""
+#line 25990 ""
return 0;
-#line 25997 ""
+#line 25991 ""
}
-#line 25998 ""
+#line 25992 ""
g1etchar_(lineq, iccount, charq, (ftnlen)128, (ftnlen)1);
-#line 25999 ""
+#line 25993 ""
if (i_indx("0123456789", charq, (ftnlen)10, (ftnlen)1) == 0) {
-#line 26000 ""
+#line 25994 ""
*lyrerr = 5;
-#line 26001 ""
+#line 25995 ""
return 0;
-#line 26002 ""
+#line 25996 ""
}
-#line 26003 ""
+#line 25997 ""
} else if (*(unsigned char *)charq != ' ') {
/* 2nd " must be followed by ' ' */
-#line 26007 ""
+#line 26001 ""
*lyrerr = 1;
-#line 26008 ""
+#line 26002 ""
return 0;
-#line 26009 ""
+#line 26003 ""
}
-#line 26010 ""
+#line 26004 ""
return 0;
-#line 26011 ""
+#line 26005 ""
}
-#line 26011 ""
+#line 26005 ""
}
-#line 26012 ""
+#line 26006 ""
goto L18;
} /* chkpmxlyr_ */
@@ -65738,7 +66017,7 @@ L18:
extern integer lenstr_(char *, integer *, ftnlen);
/* Fortran I/O blocks */
- static cilist io___1948 = { 0, 6, 0, 0, 0 };
+ static cilist io___1946 = { 0, 6, 0, 0, 0 };
@@ -65746,171 +66025,175 @@ L18:
/* with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', */
/* (unless preceded with '\'), check length */
-#line 26022 ""
+#line 26016 ""
chax_(ch__1, (ftnlen)1, &c__92);
-#line 26022 ""
+#line 26016 ""
*(unsigned char *)sq = *(unsigned char *)&ch__1[0];
-#line 26023 ""
+#line 26017 ""
iend = lenstr_(lineq, &c__128, (ftnlen)128);
/* i2nd = iccount+index(lineq(iccount+1:128),'"') */
/* Find position of closing '"'; must bypass any \" which is used for umlaut */
-#line 26028 ""
+#line 26022 ""
i__1 = *iccount;
-#line 26028 ""
- i2nd = *iccount + i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
-#line 26029 ""
+#line 26022 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 26022 ""
+ i2nd = *iccount + i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1);
+#line 26023 ""
L2:
-#line 26030 ""
+#line 26024 ""
i__1 = i2nd - 2;
-#line 26030 ""
+#line 26024 ""
if (s_cmp(lineq + i__1, "\\", i2nd - 1 - i__1, (ftnlen)1) == 0) {
-#line 26031 ""
+#line 26025 ""
i__1 = i2nd;
-#line 26031 ""
- i2nd += i_indx(lineq + i__1, "\"", 128 - i__1, (ftnlen)1);
-#line 26032 ""
+#line 26025 ""
+ chax_(ch__1, (ftnlen)1, &c__34);
+#line 26025 ""
+ i2nd += i_indx(lineq + i__1, ch__1, 128 - i__1, (ftnlen)1);
+#line 26026 ""
goto L2;
-#line 26033 ""
+#line 26027 ""
}
-#line 26034 ""
+#line 26028 ""
istart = *iccount;
-#line 26035 ""
+#line 26029 ""
L1:
-#line 26035 ""
+#line 26029 ""
i__1 = istart;
-#line 26035 ""
+#line 26029 ""
itilde = istart + i_indx(lineq + i__1, "~", i2nd - 1 - i__1, (ftnlen)1);
-#line 26036 ""
+#line 26030 ""
if (itilde > istart && itilde < i2nd) {
/* Replace tilde if not preceded by \ */
-#line 26040 ""
+#line 26034 ""
if (iend >= 117) {
-#line 26041 ""
- s_wsle(&io___1948);
-#line 26041 ""
+#line 26035 ""
+ s_wsle(&io___1946);
+#line 26035 ""
do_lio(&c__9, &c__1, "Sorry, lyric string is too long, stopping",
(ftnlen)41);
-#line 26041 ""
+#line 26035 ""
e_wsle();
-#line 26042 ""
+#line 26036 ""
stop1_();
-#line 26043 ""
+#line 26037 ""
} else /* if(complicated condition) */ {
-#line 26043 ""
+#line 26037 ""
i__1 = itilde - 2;
-#line 26043 ""
+#line 26037 ""
if (s_cmp(lineq + i__1, sq, itilde - 1 - i__1, (ftnlen)1) == 0) {
-#line 26044 ""
+#line 26038 ""
istart = itilde;
-#line 26045 ""
+#line 26039 ""
goto L1;
-#line 26046 ""
+#line 26040 ""
}
-#line 26046 ""
+#line 26040 ""
}
-#line 26047 ""
+#line 26041 ""
i__1 = itilde;
/* Writing concatenation */
-#line 26047 ""
+#line 26041 ""
i__2[0] = itilde - 1, a__1[0] = lineq;
-#line 26047 ""
+#line 26041 ""
i__2[1] = 1, a__1[1] = sq;
-#line 26047 ""
+#line 26041 ""
i__2[2] = 3, a__1[2] = "lk ";
-#line 26047 ""
+#line 26041 ""
i__2[3] = iend - i__1, a__1[3] = lineq + i__1;
-#line 26047 ""
+#line 26041 ""
s_cat(lineqt, a__1, i__2, &c__4, (ftnlen)128);
-#line 26049 ""
+#line 26043 ""
iend = lenstr_(lineqt, &c__128, (ftnlen)128);
-#line 26050 ""
+#line 26044 ""
i2nd += 3;
-#line 26051 ""
+#line 26045 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
-#line 26052 ""
+#line 26046 ""
goto L1;
-#line 26053 ""
+#line 26047 ""
}
-#line 26054 ""
+#line 26048 ""
if (*iccount == 1) {
-#line 26055 ""
+#line 26049 ""
i__1 = i2nd;
/* Writing concatenation */
-#line 26055 ""
+#line 26049 ""
i__3[0] = 1, a__2[0] = sq;
-#line 26055 ""
+#line 26049 ""
i__3[1] = 7, a__2[1] = "pmxlyr{";
-#line 26055 ""
+#line 26049 ""
i__3[2] = i2nd - 2, a__2[2] = lineq + 1;
-#line 26055 ""
+#line 26049 ""
i__3[3] = 1, a__2[3] = "}";
-#line 26055 ""
+#line 26049 ""
i__3[4] = 1, a__2[4] = sq;
-#line 26055 ""
+#line 26049 ""
i__3[5] = 128 - i__1, a__2[5] = lineq + i__1;
-#line 26055 ""
+#line 26049 ""
s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128);
-#line 26057 ""
+#line 26051 ""
} else {
-#line 26058 ""
+#line 26052 ""
i__1 = *iccount;
-#line 26058 ""
+#line 26052 ""
i__4 = i2nd;
/* Writing concatenation */
-#line 26058 ""
+#line 26052 ""
i__5[0] = *iccount - 1, a__3[0] = lineq;
-#line 26058 ""
+#line 26052 ""
i__5[1] = 1, a__3[1] = sq;
-#line 26058 ""
+#line 26052 ""
i__5[2] = 7, a__3[2] = "pmxlyr{";
-#line 26058 ""
+#line 26052 ""
i__5[3] = i2nd - 1 - i__1, a__3[3] = lineq + i__1;
-#line 26058 ""
+#line 26052 ""
i__5[4] = 1, a__3[4] = "}";
-#line 26058 ""
+#line 26052 ""
i__5[5] = 1, a__3[5] = sq;
-#line 26058 ""
+#line 26052 ""
i__5[6] = 128 - i__4, a__3[6] = lineq + i__4;
-#line 26058 ""
+#line 26052 ""
s_cat(lineqt, a__3, i__5, &c__7, (ftnlen)128);
-#line 26061 ""
+#line 26055 ""
}
-#line 26062 ""
+#line 26056 ""
i2nd += 8;
-#line 26063 ""
+#line 26057 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
-#line 26064 ""
+#line 26058 ""
i__1 = i2nd;
-#line 26064 ""
+#line 26058 ""
if (s_cmp(lineq + i__1, "@", i2nd + 1 - i__1, (ftnlen)1) == 0) {
-#line 26065 ""
+#line 26059 ""
i__1 = i2nd + 1;
-#line 26065 ""
+#line 26059 ""
i__4 = i2nd + 4;
/* Writing concatenation */
-#line 26065 ""
+#line 26059 ""
i__3[0] = i2nd, a__2[0] = lineq;
-#line 26065 ""
+#line 26059 ""
i__3[1] = 3, a__2[1] = "at{";
-#line 26065 ""
+#line 26059 ""
i__3[2] = i2nd + 4 - i__1, a__2[2] = lineq + i__1;
-#line 26065 ""
+#line 26059 ""
i__3[3] = 1, a__2[3] = "}";
-#line 26065 ""
+#line 26059 ""
i__3[4] = 1, a__2[4] = sq;
-#line 26065 ""
+#line 26059 ""
i__3[5] = 128 - i__4, a__2[5] = lineq + i__4;
-#line 26065 ""
+#line 26059 ""
s_cat(lineqt, a__2, i__3, &c__6, (ftnlen)128);
-#line 26067 ""
+#line 26061 ""
s_copy(lineq, lineqt, (ftnlen)128, (ftnlen)128);
-#line 26068 ""
+#line 26062 ""
}
-#line 26069 ""
+#line 26063 ""
return 0;
} /* dopmxlyr_ */
@@ -65920,33 +66203,33 @@ L1:
static integer iv;
/* propagate per-instrument quantities to per-channel ones */
-#line 26077 ""
+#line 26071 ""
/* Parameter adjustments */
-#line 26077 ""
+#line 26071 ""
--twoline;
-#line 26077 ""
+#line 26071 ""
--iinsiv;
-#line 26077 ""
+#line 26071 ""
midchan -= 25;
-#line 26077 ""
+#line 26071 ""
--midi;
-#line 26077 ""
+#line 26071 ""
-#line 26077 ""
+#line 26071 ""
/* Function Body */
-#line 26077 ""
+#line 26071 ""
for (iv = *nv; iv >= 1; --iv) {
-#line 26078 ""
+#line 26072 ""
if (twoline[iv]) {
-#line 26079 ""
+#line 26073 ""
midc[midchan[iv + 48]] = midi[iinsiv[iv]];
-#line 26080 ""
+#line 26074 ""
}
-#line 26081 ""
+#line 26075 ""
midc[midchan[iv + 24]] = midi[iinsiv[iv]];
-#line 26082 ""
+#line 26076 ""
}
-#line 26083 ""
+#line 26077 ""
return 0;
} /* inst2chan_ */
diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.c b/Build/source/utils/pmx/pmx-src/scor2prt.c
index 4873c52314d..36f2ebcf453 100644
--- a/Build/source/utils/pmx/pmx-src/scor2prt.c
+++ b/Build/source/utils/pmx/pmx-src/scor2prt.c
@@ -60,7 +60,7 @@ static integer c__125 = 125;
/* ccccccccccccccccccccccccc */
/* c */
-/* c scor2prt 2/19/16 for PMX 2.74 */
+/* c scor2prt 1/29/21 for PMX 2.94 */
/* ccccccccccccccccccccccccc */
/* This program, developed by Don Simons (dsimons@roadrunner.com), is */
/* part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert */
@@ -82,6 +82,9 @@ static integer c__125 = 125;
/* You should have received a copy of the GNU General Public License */
/* along with this program. If not, see <http://www.gnu.org/licenses/>. */
+/* 1/29/21 */
+/* Reformat output statement for warning about full bar rests to */
+/* eliminate use of H format specifier */
/* 2/19/16 */
/* Exit gracefully when last input line is comment, with mods in */
/* subroutine chkcom, adding logical argument goto999 */
@@ -270,465 +273,465 @@ static integer c__125 = 125;
static cilist io___104 = { 0, 0, 0, "(a)", 0 };
-#line 104 ""
+#line 107 ""
clefpend = FALSE_;
-#line 105 ""
+#line 108 ""
all_1.insetup = TRUE_;
-#line 106 ""
+#line 109 ""
all_1.replacing = FALSE_;
-#line 107 ""
+#line 110 ""
frstln = TRUE_;
-#line 108 ""
+#line 111 ""
lenhold = 0;
-#line 109 ""
+#line 112 ""
*(unsigned char *)sq = '\\';
-#line 110 ""
+#line 113 ""
s_wsle(&io___6);
-#line 110 ""
- do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.74, 19 February 2016", (
- ftnlen)47);
-#line 110 ""
+#line 113 ""
+ do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.94, 29 January 2021", (
+ ftnlen)46);
+#line 113 ""
e_wsle();
-#line 111 ""
+#line 114 ""
numargs = iargc_();
-#line 112 ""
+#line 115 ""
if (numargs == 0) {
-#line 113 ""
+#line 116 ""
s_wsle(&io___8);
-#line 113 ""
+#line 116 ""
do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\
"d line,", (ftnlen)53);
-#line 113 ""
+#line 116 ""
e_wsle();
-#line 114 ""
+#line 117 ""
s_wsle(&io___9);
-#line 114 ""
+#line 117 ""
do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32);
-#line 114 ""
+#line 117 ""
e_wsle();
-#line 115 ""
+#line 118 ""
s_rsfe(&io___10);
-#line 115 ""
+#line 118 ""
do_fio(&c__1, jobname, (ftnlen)27);
-#line 115 ""
+#line 118 ""
e_rsfe();
-#line 116 ""
+#line 119 ""
numargs = 1;
-#line 117 ""
+#line 120 ""
} else {
/* call getarg(1,jobname,idum) ! May need to replace this w/ next line */
-#line 119 ""
+#line 122 ""
getarg_(&c__1, jobname, (ftnlen)27);
-#line 120 ""
+#line 123 ""
}
-#line 121 ""
+#line 124 ""
ljob = lenstr_(jobname, &c__27, (ftnlen)27);
-#line 122 ""
+#line 125 ""
if (ljob == 0) {
-#line 123 ""
+#line 126 ""
s_wsle(&io___13);
-#line 123 ""
+#line 126 ""
do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.",
(ftnlen)46);
-#line 123 ""
+#line 126 ""
e_wsle();
-#line 124 ""
+#line 127 ""
s_stop("", (ftnlen)0);
-#line 125 ""
+#line 128 ""
}
/* Strip ".pmx" if necessary */
/* Computing MAX */
-#line 129 ""
+#line 132 ""
i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx(
jobname, ".PMX", (ftnlen)27, (ftnlen)4);
-#line 129 ""
+#line 132 ""
ndxpmx = max(i__1,i__2);
-#line 130 ""
+#line 133 ""
if (ndxpmx > 0) {
-#line 131 ""
+#line 134 ""
s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1);
-#line 132 ""
+#line 135 ""
ljob += -4;
-#line 133 ""
+#line 136 ""
}
/* Check for existence of input file */
/* Writing concatenation */
-#line 137 ""
+#line 140 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 137 ""
+#line 140 ""
i__3[1] = 4, a__1[1] = ".pmx";
-#line 137 ""
+#line 140 ""
s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27);
-#line 138 ""
+#line 141 ""
ioin__1.inerr = 0;
-#line 138 ""
+#line 141 ""
ioin__1.infilen = 27;
-#line 138 ""
+#line 141 ""
ioin__1.infile = infileq;
-#line 138 ""
+#line 141 ""
ioin__1.inex = &fexist;
-#line 138 ""
+#line 141 ""
ioin__1.inopen = 0;
-#line 138 ""
+#line 141 ""
ioin__1.innum = 0;
-#line 138 ""
+#line 141 ""
ioin__1.innamed = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inname = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inacc = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inseq = 0;
-#line 138 ""
+#line 141 ""
ioin__1.indir = 0;
-#line 138 ""
+#line 141 ""
ioin__1.infmt = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inform = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inunf = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inrecl = 0;
-#line 138 ""
+#line 141 ""
ioin__1.innrec = 0;
-#line 138 ""
+#line 141 ""
ioin__1.inblank = 0;
-#line 138 ""
+#line 141 ""
f_inqu(&ioin__1);
-#line 139 ""
+#line 142 ""
if (! fexist) {
-#line 140 ""
+#line 143 ""
s_wsle(&io___17);
/* Writing concatenation */
-#line 140 ""
+#line 143 ""
i__3[0] = 17, a__1[0] = "Cannot find file ";
-#line 140 ""
+#line 143 ""
i__3[1] = 27, a__1[1] = infileq;
-#line 140 ""
+#line 143 ""
s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44);
-#line 140 ""
+#line 143 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)44);
-#line 140 ""
+#line 143 ""
e_wsle();
-#line 141 ""
+#line 144 ""
s_stop("", (ftnlen)0);
-#line 142 ""
+#line 145 ""
}
-#line 143 ""
+#line 146 ""
o__1.oerr = 0;
-#line 143 ""
+#line 146 ""
o__1.ounit = 10;
-#line 143 ""
+#line 146 ""
o__1.ofnmlen = ljob + 4;
/* Writing concatenation */
-#line 143 ""
+#line 146 ""
i__3[0] = ljob, a__1[0] = jobname;
-#line 143 ""
+#line 146 ""
i__3[1] = 4, a__1[1] = ".pmx";
-#line 143 ""
+#line 146 ""
s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31);
-#line 143 ""
+#line 146 ""
o__1.ofnm = ch__2;
-#line 143 ""
+#line 146 ""
o__1.orl = 0;
-#line 143 ""
+#line 146 ""
o__1.osta = 0;
-#line 143 ""
+#line 146 ""
o__1.oacc = 0;
-#line 143 ""
+#line 146 ""
o__1.ofm = 0;
-#line 143 ""
+#line 146 ""
o__1.oblnk = 0;
-#line 143 ""
+#line 146 ""
f_open(&o__1);
/* Open all instrument files now for allparts stuff. Later disgard those >nv */
-#line 147 ""
+#line 150 ""
for (iv = 1; iv <= 24; ++iv) {
-#line 148 ""
+#line 151 ""
all_1.iorig[iv - 1] = iv;
-#line 149 ""
+#line 152 ""
o__1.oerr = 0;
-#line 149 ""
+#line 152 ""
o__1.ounit = iv + 10;
-#line 149 ""
+#line 152 ""
o__1.ofnm = 0;
-#line 149 ""
+#line 152 ""
o__1.orl = 0;
-#line 149 ""
+#line 152 ""
o__1.osta = "SCRATCH";
-#line 149 ""
+#line 152 ""
o__1.oacc = 0;
-#line 149 ""
+#line 152 ""
o__1.ofm = 0;
-#line 149 ""
+#line 152 ""
o__1.oblnk = 0;
-#line 149 ""
+#line 152 ""
f_open(&o__1);
-#line 150 ""
+#line 153 ""
ludpfn[iv - 1] = 0;
-#line 151 ""
+#line 154 ""
/* L19: */
-#line 151 ""
+#line 154 ""
}
-#line 152 ""
+#line 155 ""
s_rsfe(&io___20);
-#line 152 ""
+#line 155 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 152 ""
+#line 155 ""
e_rsfe();
-#line 153 ""
+#line 156 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 154 ""
+#line 157 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
-#line 155 ""
+#line 158 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 156 ""
+#line 159 ""
L31:
-#line 156 ""
+#line 159 ""
s_rsfe(&io___23);
-#line 156 ""
+#line 159 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 156 ""
+#line 159 ""
e_rsfe();
-#line 157 ""
+#line 160 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) {
-#line 158 ""
+#line 161 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 159 ""
+#line 162 ""
goto L31;
-#line 160 ""
+#line 163 ""
}
-#line 161 ""
+#line 164 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 162 ""
+#line 165 ""
s_rsfe(&io___24);
-#line 162 ""
+#line 165 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 162 ""
+#line 165 ""
e_rsfe();
-#line 163 ""
+#line 166 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 164 ""
+#line 167 ""
}
-#line 165 ""
+#line 168 ""
iccount = 0;
-#line 166 ""
+#line 169 ""
nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f;
-#line 167 ""
+#line 170 ""
all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f;
-#line 168 ""
+#line 171 ""
if (all_1.noinst > 0) {
-#line 169 ""
+#line 172 ""
all_1.nvi[0] = nv - all_1.noinst + 1;
-#line 170 ""
+#line 173 ""
} else {
-#line 171 ""
+#line 174 ""
all_1.noinst = 1 - all_1.noinst;
-#line 172 ""
+#line 175 ""
i__1 = all_1.noinst;
-#line 172 ""
+#line 175 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 173 ""
+#line 176 ""
all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128)
+ .1f;
-#line 174 ""
+#line 177 ""
/* L21: */
-#line 174 ""
+#line 177 ""
}
-#line 175 ""
+#line 178 ""
}
-#line 176 ""
+#line 179 ""
all_1.noinow = all_1.noinst;
-#line 177 ""
+#line 180 ""
insnow = 1;
/* ivlast is last iv in current inst. instnum(iv) is iinst for current voice. */
-#line 181 ""
+#line 184 ""
ivlast = all_1.nvi[0];
-#line 182 ""
+#line 185 ""
i__1 = nv;
-#line 182 ""
+#line 185 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 183 ""
+#line 186 ""
all_1.instnum[iv - 1] = insnow;
-#line 184 ""
+#line 187 ""
if (iv == ivlast) {
-#line 185 ""
+#line 188 ""
if (iv < nv) {
-#line 185 ""
+#line 188 ""
all_1.botv[iv] = TRUE_;
-#line 185 ""
+#line 188 ""
}
/* The previous stmt will set botv true only for bot voice of iinst>1. It is */
/* used when writing termrpts, but the one in voice one is handled differently, */
/* so botv(1) is left .false. */
-#line 191 ""
+#line 194 ""
if (insnow < all_1.noinst) {
-#line 192 ""
+#line 195 ""
++insnow;
-#line 193 ""
+#line 196 ""
ivlast += all_1.nvi[insnow - 1];
-#line 194 ""
+#line 197 ""
}
-#line 195 ""
+#line 198 ""
}
-#line 196 ""
+#line 199 ""
/* L22: */
-#line 196 ""
+#line 199 ""
}
-#line 197 ""
+#line 200 ""
mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 198 ""
+#line 201 ""
mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 199 ""
+#line 202 ""
mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 200 ""
+#line 203 ""
mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 201 ""
+#line 204 ""
xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128);
-#line 202 ""
+#line 205 ""
isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 203 ""
+#line 206 ""
npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f;
-#line 204 ""
+#line 207 ""
all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f;
-#line 205 ""
+#line 208 ""
musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f;
-#line 206 ""
+#line 209 ""
fracindent = readin_(line, &iccount, &c__5, (ftnlen)128);
-#line 207 ""
+#line 210 ""
if (npages == 0) {
-#line 208 ""
+#line 211 ""
s_wsle(&io___39);
-#line 208 ""
+#line 211 ""
do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not"\
" the total number", (ftnlen)63);
-#line 208 ""
+#line 211 ""
e_wsle();
-#line 210 ""
+#line 213 ""
s_wsle(&io___40);
-#line 210 ""
+#line 213 ""
do_lio(&c__9, &c__1, "of systems. Scor2prt has to know the total nu"\
"mber of systems.", (ftnlen)62);
-#line 210 ""
+#line 213 ""
e_wsle();
-#line 212 ""
+#line 215 ""
s_wsle(&io___41);
-#line 212 ""
+#line 215 ""
do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu"\
"es.", (ftnlen)49);
-#line 212 ""
+#line 215 ""
e_wsle();
-#line 214 ""
+#line 217 ""
s_stop("", (ftnlen)0);
-#line 215 ""
+#line 218 ""
}
/* Must leave insetup=.true. else could bypass ALL instrument names. */
-#line 219 ""
+#line 222 ""
s_rsfe(&io___42);
-#line 219 ""
+#line 222 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 219 ""
+#line 222 ""
e_rsfe();
-#line 220 ""
+#line 223 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 221 ""
+#line 224 ""
al__1.aerr = 0;
-#line 221 ""
+#line 224 ""
al__1.aunit = 10;
-#line 221 ""
+#line 224 ""
f_back(&al__1);
/* Normally this puts pointer at start of line with 1st inst name */
/* Check if prior line was "%%" */
-#line 226 ""
+#line 229 ""
al__1.aerr = 0;
-#line 226 ""
+#line 229 ""
al__1.aunit = 10;
-#line 226 ""
+#line 229 ""
f_back(&al__1);
-#line 227 ""
+#line 230 ""
s_rsfe(&io___43);
-#line 227 ""
+#line 230 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 227 ""
+#line 230 ""
e_rsfe();
-#line 228 ""
+#line 231 ""
if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) {
-#line 228 ""
+#line 231 ""
al__1.aerr = 0;
-#line 228 ""
+#line 231 ""
al__1.aunit = 10;
-#line 228 ""
+#line 231 ""
f_back(&al__1);
-#line 228 ""
+#line 231 ""
}
-#line 229 ""
+#line 232 ""
i__1 = all_1.noinst;
-#line 229 ""
+#line 232 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 230 ""
+#line 233 ""
gotname = FALSE_;
-#line 231 ""
+#line 234 ""
L16:
-#line 231 ""
+#line 234 ""
s_rsfe(&io___45);
-#line 231 ""
+#line 234 ""
do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128);
-#line 231 ""
+#line 234 ""
e_rsfe();
-#line 232 ""
+#line 235 ""
if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) {
-#line 233 ""
+#line 236 ""
s_rsfe(&io___47);
-#line 233 ""
+#line 236 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 233 ""
+#line 236 ""
e_rsfe();
-#line 234 ""
+#line 237 ""
goto L16;
-#line 235 ""
+#line 238 ""
} else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') {
-#line 236 ""
+#line 239 ""
ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48;
-#line 237 ""
+#line 240 ""
if (ivq != iv) {
/* It's really a comment. Copy to parts, then get another trial name. */
-#line 241 ""
+#line 244 ""
allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128);
-#line 242 ""
+#line 245 ""
goto L16;
-#line 243 ""
+#line 246 ""
} else {
-#line 244 ""
+#line 247 ""
s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, (
ftnlen)126);
-#line 245 ""
+#line 248 ""
s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen)
128);
-#line 246 ""
+#line 249 ""
gotname = TRUE_;
-#line 247 ""
+#line 250 ""
}
-#line 248 ""
+#line 251 ""
} else {
-#line 249 ""
+#line 252 ""
gotname = TRUE_;
-#line 250 ""
+#line 253 ""
}
/* c */
/* c The following checks for macro that write original C-clef as part of */
@@ -744,117 +747,117 @@ L16:
/* * char(iy1+49)//char(iy2+49) */
/* instrum(iv) = instrum(iv)(inm1:inm2) */
/* end if */
-#line 265 ""
+#line 268 ""
if (! gotname) {
-#line 266 ""
+#line 269 ""
s_wsle(&io___49);
-#line 266 ""
+#line 269 ""
do_lio(&c__9, &c__1, "You must provide a replacement instrument "\
"name", (ftnlen)46);
-#line 266 ""
+#line 269 ""
e_wsle();
-#line 267 ""
+#line 270 ""
s_stop("", (ftnlen)0);
-#line 268 ""
+#line 271 ""
}
-#line 269 ""
+#line 272 ""
io___50.ciunit = iv + 10;
-#line 269 ""
+#line 272 ""
s_wsfe(&io___50);
-#line 269 ""
+#line 272 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 269 ""
+#line 272 ""
e_wsfe();
-#line 270 ""
+#line 273 ""
/* L14: */
-#line 270 ""
+#line 273 ""
}
-#line 271 ""
+#line 274 ""
all_1.replacing = FALSE_;
-#line 272 ""
+#line 275 ""
all_1.nvnow = nv;
/* Clef string: Note insetup is still T, so "%%" will be treated specially */
-#line 276 ""
+#line 279 ""
s_rsfe(&io___51);
-#line 276 ""
+#line 279 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 276 ""
+#line 279 ""
e_rsfe();
-#line 277 ""
+#line 280 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 278 ""
+#line 281 ""
if (all_1.replacing) {
/* If here, we have next line after "%%", containing score's clef string */
/* Assume all clefs are handled with instrument comments. */
-#line 283 ""
+#line 286 ""
s_rsfe(&io___52);
-#line 283 ""
+#line 286 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 283 ""
+#line 286 ""
e_rsfe();
-#line 284 ""
+#line 287 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 285 ""
+#line 288 ""
al__1.aerr = 0;
-#line 285 ""
+#line 288 ""
al__1.aunit = 10;
-#line 285 ""
+#line 288 ""
f_back(&al__1);
-#line 286 ""
+#line 289 ""
} else {
/* If here, line has the clef string in it. Handle the old way */
-#line 290 ""
+#line 293 ""
kvstart = 1;
-#line 291 ""
+#line 294 ""
kvend = all_1.nvi[0];
-#line 292 ""
+#line 295 ""
i__1 = all_1.noinst;
-#line 292 ""
+#line 295 ""
for (inst = 1; inst <= i__1; ++inst) {
-#line 293 ""
+#line 296 ""
ci__1.cierr = 0;
-#line 293 ""
+#line 296 ""
ci__1.ciunit = inst + 10;
/* Writing concatenation */
-#line 293 ""
+#line 296 ""
i__4[0] = 2, a__2[0] = "(a";
-#line 293 ""
+#line 296 ""
*(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48;
-#line 293 ""
+#line 296 ""
i__4[1] = 1, a__2[1] = ch__4;
-#line 293 ""
+#line 296 ""
i__4[2] = 1, a__2[2] = ")";
-#line 293 ""
+#line 296 ""
ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3);
-#line 293 ""
+#line 296 ""
s_wsfe(&ci__1);
-#line 293 ""
+#line 296 ""
do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1));
-#line 293 ""
+#line 296 ""
e_wsfe();
-#line 295 ""
+#line 298 ""
if (inst < all_1.noinst) {
-#line 296 ""
+#line 299 ""
kvstart = kvend + 1;
-#line 297 ""
+#line 300 ""
kvend = kvstart + all_1.nvi[inst] - 1;
-#line 298 ""
+#line 301 ""
}
-#line 299 ""
+#line 302 ""
/* L2: */
-#line 299 ""
+#line 302 ""
}
-#line 300 ""
+#line 303 ""
}
-#line 301 ""
+#line 304 ""
all_1.replacing = FALSE_;
-#line 302 ""
+#line 305 ""
all_1.insetup = FALSE_;
/* *****NOTE*****This comment applies to stuff done earlier! */
@@ -865,50 +868,50 @@ L16:
/* Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */
-#line 312 ""
+#line 315 ""
L18:
-#line 312 ""
+#line 315 ""
s_rsfe(&io___56);
-#line 312 ""
+#line 315 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 312 ""
+#line 315 ""
e_rsfe();
-#line 313 ""
+#line 316 ""
if (*(unsigned char *)line == '%') {
-#line 314 ""
+#line 317 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 315 ""
+#line 318 ""
goto L18;
-#line 316 ""
+#line 319 ""
}
-#line 317 ""
+#line 320 ""
allparts_(line, &c__128, (ftnlen)128);
/* Write instrument names. Will be blank if later part of a score. */
-#line 321 ""
+#line 324 ""
if (*(unsigned char *)&instrum[0] != ' ') {
-#line 322 ""
+#line 325 ""
i__1 = all_1.noinst;
-#line 322 ""
+#line 325 ""
for (iv = 1; iv <= i__1; ++iv) {
-#line 323 ""
+#line 326 ""
len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128);
-#line 324 ""
+#line 327 ""
io___58.ciunit = iv + 10;
-#line 324 ""
+#line 327 ""
s_wsfe(&io___58);
-#line 324 ""
+#line 327 ""
do_fio(&c__1, "Ti", (ftnlen)2);
-#line 324 ""
+#line 327 ""
do_fio(&c__1, instrum + (iv - 1 << 7), len);
-#line 324 ""
+#line 327 ""
e_wsfe();
-#line 325 ""
+#line 328 ""
/* L3: */
-#line 325 ""
+#line 328 ""
}
-#line 326 ""
+#line 329 ""
}
/* The big loop. Except for '%%', put all comment lines in all parts. */
@@ -921,481 +924,481 @@ L18:
/* Check for "P"; ignore in parts. */
/* Check for consecutive full-bar rests; if found, replace with rm[nn] */
-#line 338 ""
+#line 341 ""
iv = 1;
-#line 339 ""
+#line 342 ""
iinst = 1;
-#line 340 ""
+#line 343 ""
termrpt = FALSE_;
-#line 341 ""
+#line 344 ""
L4:
-#line 342 ""
+#line 345 ""
i__1 = s_rsfe(&io___60);
-#line 342 ""
+#line 345 ""
if (i__1 != 0) {
-#line 342 ""
+#line 345 ""
goto L999;
-#line 342 ""
+#line 345 ""
}
-#line 342 ""
+#line 345 ""
i__1 = do_fio(&c__1, line, (ftnlen)128);
-#line 342 ""
+#line 345 ""
if (i__1 != 0) {
-#line 342 ""
+#line 345 ""
goto L999;
-#line 342 ""
+#line 345 ""
}
-#line 342 ""
+#line 345 ""
i__1 = e_rsfe();
-#line 342 ""
+#line 345 ""
if (i__1 != 0) {
-#line 342 ""
+#line 345 ""
goto L999;
-#line 342 ""
+#line 345 ""
}
-#line 343 ""
+#line 346 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
-#line 344 ""
+#line 347 ""
if (lenline == 0) {
-#line 344 ""
+#line 347 ""
goto L4;
-#line 344 ""
+#line 347 ""
}
-#line 345 ""
+#line 348 ""
zapbl_(line, &c__128, (ftnlen)128);
-#line 346 ""
+#line 349 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 347 ""
+#line 350 ""
if (goto999) {
-#line 347 ""
+#line 350 ""
goto L999;
-#line 347 ""
+#line 350 ""
}
-#line 348 ""
+#line 351 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
-#line 349 ""
+#line 352 ""
if (lenline == 0) {
-#line 349 ""
+#line 352 ""
goto L4;
-#line 349 ""
+#line 352 ""
}
-#line 350 ""
+#line 353 ""
if (*(unsigned char *)line == 'T') {
-#line 351 ""
+#line 354 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 352 ""
+#line 355 ""
s_rsfe(&io___62);
-#line 352 ""
+#line 355 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 352 ""
+#line 355 ""
e_rsfe();
-#line 353 ""
+#line 356 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 354 ""
+#line 357 ""
goto L4;
-#line 355 ""
+#line 358 ""
} else /* if(complicated condition) */ {
/* Writing concatenation */
-#line 355 ""
+#line 358 ""
i__3[0] = 1, a__1[0] = sq;
-#line 355 ""
+#line 358 ""
i__3[1] = 1, a__1[1] = sq;
-#line 355 ""
+#line 358 ""
s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2);
-#line 355 ""
+#line 358 ""
if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) {
-#line 356 ""
+#line 359 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 357 ""
+#line 360 ""
goto L4;
-#line 358 ""
+#line 361 ""
} else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx(
" +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) {
-#line 360 ""
+#line 363 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 361 ""
+#line 364 ""
s_rsfe(&io___63);
-#line 361 ""
+#line 364 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 361 ""
+#line 364 ""
e_rsfe();
-#line 362 ""
+#line 365 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 363 ""
+#line 366 ""
goto L4;
-#line 364 ""
+#line 367 ""
} else if (iv == 1) {
-#line 365 ""
+#line 368 ""
for (ia = 1; ia <= 10; ++ia) {
-#line 366 ""
+#line 369 ""
L24:
-#line 367 ""
+#line 370 ""
idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen)
1);
-#line 368 ""
+#line 371 ""
isachar = idxa > 0;
-#line 369 ""
+#line 372 ""
if (idxa > 1) {
-#line 369 ""
+#line 372 ""
i__1 = idxa - 2;
-#line 369 ""
+#line 372 ""
isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, (
ftnlen)1) == 0;
-#line 369 ""
+#line 372 ""
}
/* 1 2 3 4 5 6 7 8 9 10 */
/* data achar /'P','m','V','R','A','h','w','K','M','I'/ */
-#line 374 ""
+#line 377 ""
if (ia == 9) {
-#line 374 ""
+#line 377 ""
i__1 = idxa;
-#line 374 ""
+#line 377 ""
isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 -
i__1, (ftnlen)1) == 0;
-#line 374 ""
+#line 377 ""
}
-#line 376 ""
+#line 379 ""
if (isachar) {
/* Check whether character is inside a quoted string by counting */
/* how many quotes precede it in the line */
-#line 382 ""
+#line 385 ""
oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128);
-#line 383 ""
+#line 386 ""
if (yesodd) {
-#line 383 ""
+#line 386 ""
isachar = FALSE_;
-#line 383 ""
+#line 386 ""
}
-#line 384 ""
+#line 387 ""
}
-#line 385 ""
+#line 388 ""
if (isachar) {
/* Find next blank */
-#line 389 ""
+#line 392 ""
for (ib = idxa + 1; ib <= 128; ++ib) {
-#line 390 ""
+#line 393 ""
if (*(unsigned char *)&line[ib - 1] == ' ') {
-#line 390 ""
+#line 393 ""
goto L7;
-#line 390 ""
+#line 393 ""
}
-#line 391 ""
+#line 394 ""
/* L6: */
-#line 391 ""
+#line 394 ""
}
-#line 392 ""
+#line 395 ""
s_wsle(&io___69);
-#line 392 ""
+#line 395 ""
do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o"\
"r w\"", (ftnlen)35);
-#line 392 ""
+#line 395 ""
e_wsle();
-#line 393 ""
+#line 396 ""
s_wsle(&io___70);
-#line 393 ""
+#line 396 ""
do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a"\
"t roadrunner dot com", (ftnlen)54);
-#line 393 ""
+#line 396 ""
e_wsle();
-#line 395 ""
+#line 398 ""
s_stop("1", (ftnlen)1);
-#line 396 ""
+#line 399 ""
L7:
/* Next blank is at position ib. Later, if ia=1, must check for Pc" " ; */
/* i.e., look for '"' between P and blank */
-#line 401 ""
+#line 404 ""
if (ia == 4) {
/* Check for terminal repeat. Note if there's a term rpt, there can't be any */
/* others. Also, must process repeats LAST, after m's and 'V's */
-#line 406 ""
+#line 409 ""
for (ic = ib + 1; ic <= 128; ++ic) {
/* If any subsequent character on this line is neither blank nor "/", get out */
-#line 410 ""
+#line 413 ""
if (i_indx(" /", line + (ic - 1), (ftnlen)2, (
ftnlen)1) == 0) {
-#line 410 ""
+#line 413 ""
goto L9;
-#line 410 ""
+#line 413 ""
}
-#line 411 ""
+#line 414 ""
if (*(unsigned char *)&line[ic - 1] == '/') {
-#line 412 ""
+#line 415 ""
termrpt = TRUE_;
-#line 413 ""
+#line 416 ""
i__1 = ib - 3;
-#line 413 ""
+#line 416 ""
s_copy(termsym, line + i__1, (ftnlen)2, ib -
1 - i__1);
/* Process the line as if there were no "R" */
-#line 417 ""
+#line 420 ""
goto L10;
-#line 418 ""
+#line 421 ""
}
-#line 419 ""
+#line 422 ""
/* L8: */
-#line 419 ""
+#line 422 ""
}
/* +++ 060812 */
/* If here, all chars after "R" symbol are blanks, so process the line normally, */
/* but only IF next line is not the M-Tx line " /" */
-#line 425 ""
+#line 428 ""
s_rsfe(&io___73);
-#line 425 ""
+#line 428 ""
do_fio(&c__1, templine, (ftnlen)128);
-#line 425 ""
+#line 428 ""
e_rsfe();
-#line 426 ""
+#line 429 ""
if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0)
{
-#line 427 ""
+#line 430 ""
al__1.aerr = 0;
-#line 427 ""
+#line 430 ""
al__1.aunit = 10;
-#line 427 ""
+#line 430 ""
f_back(&al__1);
/* and flow out */
-#line 428 ""
+#line 431 ""
} else {
/* We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, */
/* and proceed as above */
/* Writing concatenation */
-#line 433 ""
+#line 436 ""
i__3[0] = ib, a__1[0] = line;
-#line 433 ""
+#line 436 ""
i__3[1] = 1, a__1[1] = "/";
-#line 433 ""
+#line 436 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 434 ""
+#line 437 ""
lenline += 2;
-#line 435 ""
+#line 438 ""
termrpt = TRUE_;
-#line 436 ""
+#line 439 ""
i__1 = ib - 3;
-#line 436 ""
+#line 439 ""
s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 -
i__1);
-#line 437 ""
+#line 440 ""
goto L10;
-#line 438 ""
+#line 441 ""
}
/* +++ 060812 */
-#line 441 ""
+#line 444 ""
} else if (ia == 1) {
-#line 442 ""
+#line 445 ""
idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1);
-#line 443 ""
+#line 446 ""
if (idxq > idxa && idxq < ib) {
/* Quote is between P and next blank. Find 2nd quote, starting at the blank. */
-#line 447 ""
+#line 450 ""
idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128,
(ftnlen)1);
-#line 448 ""
+#line 451 ""
i__1 = idxq2;
-#line 448 ""
+#line 451 ""
if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 +
1 - i__1, (ftnlen)1) != 0) {
-#line 449 ""
+#line 452 ""
s_wsle(&io___77);
-#line 449 ""
+#line 452 ""
e_wsle();
-#line 450 ""
+#line 453 ""
s_wsle(&io___78);
-#line 450 ""
+#line 453 ""
do_lio(&c__9, &c__1, "Error copying P with q"\
"uotes, idxq2:", (ftnlen)35);
-#line 450 ""
+#line 453 ""
do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen)
sizeof(integer));
-#line 450 ""
+#line 453 ""
e_wsle();
-#line 451 ""
+#line 454 ""
s_wsle(&io___79);
-#line 451 ""
+#line 454 ""
do_lio(&c__9, &c__1, line, (ftnlen)60);
-#line 451 ""
+#line 454 ""
e_wsle();
-#line 452 ""
+#line 455 ""
s_stop("1", (ftnlen)1);
-#line 453 ""
+#line 456 ""
}
-#line 454 ""
+#line 457 ""
ib = idxq2 + 1;
-#line 455 ""
+#line 458 ""
}
/* Do not transfer P into parts. */
-#line 459 ""
+#line 462 ""
goto L12;
-#line 460 ""
+#line 463 ""
} else if (ia == 9) {
/* Start Saving a macro. After leaving here, a symbol will be sent to all parts, */
/* If all on this line, set ib to end and exit normally. */
-#line 465 ""
+#line 468 ""
i__1 = ib;
-#line 465 ""
+#line 468 ""
ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1)
;
-#line 466 ""
+#line 469 ""
i__1 = ib + ndxm - 2;
-#line 466 ""
+#line 469 ""
if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1
- i__1, (ftnlen)1) == 0) {
/* Macro ends on this line */
-#line 470 ""
+#line 473 ""
ib = ib + ndxm + 1;
-#line 471 ""
+#line 474 ""
} else {
/* Save leading part of current line */
-#line 475 ""
+#line 478 ""
lenhold = idxa - 1;
-#line 476 ""
+#line 479 ""
if (lenhold > 0) {
-#line 476 ""
+#line 479 ""
s_copy(holdln, line, (ftnlen)128, lenhold);
-#line 476 ""
+#line 479 ""
}
/* Transfer rest of line */
-#line 480 ""
+#line 483 ""
i__1 = 129 - idxa;
-#line 480 ""
+#line 483 ""
allparts_(line + (idxa - 1), &i__1, 128 - (idxa -
1));
/* Read next line */
-#line 484 ""
+#line 487 ""
L20:
-#line 484 ""
+#line 487 ""
s_rsfe(&io___82);
-#line 484 ""
+#line 487 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 484 ""
+#line 487 ""
e_rsfe();
/* Check for comment, transfer and loop if so */
/* if (line(1:1) .eq.'%') then */
-#line 489 ""
+#line 492 ""
L23:
-#line 489 ""
+#line 492 ""
if (*(unsigned char *)line == '%') {
/* call allparts(line,128) */
/* go to 20 */
-#line 492 ""
+#line 495 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 493 ""
+#line 496 ""
goto L23;
-#line 494 ""
+#line 497 ""
}
/* Look for terminal ' M' */
-#line 498 ""
+#line 501 ""
if (*(unsigned char *)line == 'M') {
-#line 499 ""
+#line 502 ""
ndxm = 1;
-#line 500 ""
+#line 503 ""
} else {
-#line 501 ""
+#line 504 ""
ndxm = i_indx(line, " M", (ftnlen)128, (
ftnlen)2);
-#line 502 ""
+#line 505 ""
if (ndxm > 0) {
-#line 502 ""
+#line 505 ""
++ndxm;
-#line 502 ""
+#line 505 ""
}
-#line 503 ""
+#line 506 ""
}
-#line 504 ""
+#line 507 ""
if (ndxm > 0) {
/* Set parameters, exit normally (but later check for leading part of 1st line */
-#line 508 ""
+#line 511 ""
idxa = 1;
-#line 509 ""
+#line 512 ""
ib = ndxm + 1;
-#line 510 ""
+#line 513 ""
} else {
/* No "M", transfer entire line, loop */
-#line 514 ""
+#line 517 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 515 ""
+#line 518 ""
goto L20;
-#line 516 ""
+#line 519 ""
}
-#line 517 ""
+#line 520 ""
}
-#line 518 ""
+#line 521 ""
} else if (ia == 10) {
/* Do not transfer MIDI command into parts */
-#line 522 ""
+#line 525 ""
goto L12;
-#line 523 ""
+#line 526 ""
} else if (ia == 5) {
/* First check for "AS", but S may come after other "A" options */
-#line 527 ""
+#line 530 ""
i__1 = idxa;
-#line 527 ""
+#line 530 ""
idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1);
-#line 528 ""
+#line 531 ""
if (idxs > 0) {
/* Get rid of the string. First check if that's all there is in A. */
-#line 532 ""
+#line 535 ""
if (ib - idxa == nv + 2) {
-#line 532 ""
+#line 535 ""
goto L12;
-#line 532 ""
+#line 535 ""
}
-#line 533 ""
+#line 536 ""
i__1 = idxa + idxs + nv;
/* Writing concatenation */
-#line 533 ""
+#line 536 ""
i__3[0] = idxa + idxs - 1, a__1[0] = line;
-#line 533 ""
+#line 536 ""
i__3[1] = ib - i__1, a__1[1] = line + i__1;
-#line 533 ""
+#line 536 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 534 ""
+#line 537 ""
}
/* Check for user-defined part file name. Must start in column 1 and have */
@@ -1404,353 +1407,353 @@ L23:
/* ib is position of the next blank after "A" */
/* Don't allow any blanks in user */
-#line 542 ""
+#line 545 ""
i__1 = idxa;
-#line 542 ""
+#line 545 ""
if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen)
1) != 0) {
-#line 542 ""
+#line 545 ""
goto L9;
-#line 542 ""
+#line 545 ""
}
/* bail out */
-#line 543 ""
+#line 546 ""
if (idxa != 1) {
-#line 544 ""
+#line 547 ""
s_wsle(&io___84);
-#line 544 ""
+#line 547 ""
e_wsle();
-#line 545 ""
+#line 548 ""
s_wsle(&io___85);
-#line 545 ""
+#line 548 ""
do_lio(&c__9, &c__1, "You entered \"AN...\" some"\
"where beyond first column; stopping.", (
ftnlen)60);
-#line 545 ""
+#line 548 ""
e_wsle();
-#line 547 ""
+#line 550 ""
s_stop("1", (ftnlen)1);
-#line 548 ""
+#line 551 ""
}
/* pmxa already checked for valid one- or 2-digit number, so get it */
-#line 552 ""
+#line 555 ""
if (*(unsigned char *)&line[3] == '"') {
/* Single digit instrument number */
-#line 556 ""
+#line 559 ""
s_rsfi(&io___86);
-#line 556 ""
+#line 559 ""
do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
integer));
-#line 556 ""
+#line 559 ""
e_rsfi();
-#line 557 ""
+#line 560 ""
idxstartname = 5;
-#line 558 ""
+#line 561 ""
} else {
-#line 559 ""
+#line 562 ""
s_rsfi(&io___89);
-#line 559 ""
+#line 562 ""
do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof(
integer));
-#line 559 ""
+#line 562 ""
e_rsfi();
-#line 560 ""
+#line 563 ""
idxstartname = 6;
-#line 561 ""
+#line 564 ""
}
-#line 562 ""
+#line 565 ""
ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1),
"\"", 128 - (idxstartname - 1), (ftnlen)1) -
1;
-#line 563 ""
+#line 566 ""
if (ludpfn[iudpfn - 1] < 0) {
-#line 564 ""
+#line 567 ""
s_wsle(&io___90);
-#line 564 ""
+#line 567 ""
e_wsle();
-#line 565 ""
+#line 568 ""
s_wsle(&io___91);
-#line 565 ""
+#line 568 ""
do_lio(&c__9, &c__1, "User-defined part file nam"\
"e must be in quotes", (ftnlen)45);
-#line 565 ""
+#line 568 ""
e_wsle();
-#line 566 ""
+#line 569 ""
s_stop("1", (ftnlen)1);
-#line 567 ""
+#line 570 ""
}
-#line 568 ""
+#line 571 ""
idxendname = idxstartname + ludpfn[iudpfn - 1] - 1;
-#line 569 ""
+#line 572 ""
s_copy(udpfnq + (iudpfn - 1 << 7), line + (
idxstartname - 1), (ftnlen)128, idxendname - (
idxstartname - 1));
/* Get a new line! */
-#line 573 ""
+#line 576 ""
goto L4;
-#line 574 ""
+#line 577 ""
} else if (ia == 8) {
/* Key change/transposition. */
/* If not instrument specific, copy to all parts */
-#line 579 ""
+#line 582 ""
i__1 = idxa;
-#line 579 ""
+#line 582 ""
if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen)
1) != 0) {
-#line 579 ""
+#line 582 ""
goto L9;
-#line 579 ""
+#line 582 ""
}
/* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */
-#line 583 ""
+#line 586 ""
ibb = idxa + 2;
/* Starts on digit after 'i' */
-#line 584 ""
+#line 587 ""
L40:
-#line 585 ""
+#line 588 ""
ici__1.icierr = 0;
-#line 585 ""
+#line 588 ""
ici__1.iciend = 0;
-#line 585 ""
+#line 588 ""
ici__1.icirnum = 1;
-#line 585 ""
+#line 588 ""
ici__1.icirlen = 1;
-#line 585 ""
+#line 588 ""
ici__1.iciunit = line + (ibb - 1);
-#line 585 ""
+#line 588 ""
ici__1.icifmt = "(i1)";
-#line 585 ""
+#line 588 ""
s_rsfi(&ici__1);
-#line 585 ""
+#line 588 ""
do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer)
);
-#line 585 ""
+#line 588 ""
e_rsfi();
/* 1st digit of iinst */
-#line 586 ""
+#line 589 ""
i__1 = ibb;
-#line 586 ""
+#line 589 ""
itemp = i_indx("01234567890", line + i__1, (ftnlen)11,
ibb + 1 - i__1);
-#line 587 ""
+#line 590 ""
if (itemp > 0) {
-#line 588 ""
+#line 591 ""
++ibb;
-#line 589 ""
+#line 592 ""
iiinst = iiinst * 10 + itemp - 1;
-#line 590 ""
+#line 593 ""
}
-#line 591 ""
+#line 594 ""
++ibb;
/* now at first +/-. Need end of 2nd number */
-#line 592 ""
+#line 595 ""
i__1 = ibb;
-#line 592 ""
+#line 595 ""
itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1)
;
/* Rel pos'n of next 'i' */
-#line 593 ""
+#line 596 ""
if (itemp > 0) {
-#line 594 ""
+#line 597 ""
iend = ibb + itemp - 1;
-#line 595 ""
+#line 598 ""
} else {
-#line 596 ""
+#line 599 ""
iend = ib - 1;
-#line 597 ""
+#line 600 ""
}
-#line 598 ""
+#line 601 ""
io___98.ciunit = all_1.iorig[iiinst - 1] + 10;
-#line 598 ""
+#line 601 ""
s_wsfe(&io___98);
/* Writing concatenation */
-#line 598 ""
+#line 601 ""
i__3[0] = 3, a__1[0] = "Ki1";
-#line 598 ""
+#line 601 ""
i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1)
;
-#line 598 ""
+#line 601 ""
s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131);
-#line 598 ""
+#line 601 ""
do_fio(&c__1, ch__6, iend - (ibb - 1) + 3);
-#line 598 ""
+#line 601 ""
e_wsfe();
-#line 599 ""
+#line 602 ""
if (itemp > 0) {
-#line 600 ""
+#line 603 ""
ibb = iend + 2;
-#line 601 ""
+#line 604 ""
goto L40;
-#line 602 ""
+#line 605 ""
}
-#line 603 ""
+#line 606 ""
goto L12;
/* Remove K command from string, go to next ia */
-#line 604 ""
+#line 607 ""
}
-#line 605 ""
+#line 608 ""
L9:
-#line 606 ""
+#line 609 ""
i__1 = ib - idxa;
-#line 606 ""
+#line 609 ""
allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1));
-#line 607 ""
+#line 610 ""
L12:
/* Remove the string from line */
-#line 611 ""
+#line 614 ""
if (idxa == 1) {
-#line 612 ""
+#line 615 ""
s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib
- 1));
-#line 613 ""
+#line 616 ""
} else {
/* Writing concatenation */
-#line 614 ""
+#line 617 ""
i__3[0] = idxa - 1, a__1[0] = line;
-#line 614 ""
+#line 617 ""
i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1);
-#line 614 ""
+#line 617 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 615 ""
+#line 618 ""
}
-#line 616 ""
+#line 619 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
/* Loop if only blanks are left */
-#line 620 ""
+#line 623 ""
if (lenline == 0) {
-#line 620 ""
+#line 623 ""
goto L4;
-#line 620 ""
+#line 623 ""
}
/* Must check for multiple "I" commands, so go to just after start of ia loop */
-#line 624 ""
+#line 627 ""
if (ia == 10) {
-#line 624 ""
+#line 627 ""
goto L24;
-#line 624 ""
+#line 627 ""
}
/* Tack on front part from 1st line of saved macro */
-#line 628 ""
+#line 631 ""
if (lenhold > 0) {
/* Writing concatenation */
-#line 629 ""
+#line 632 ""
i__4[0] = lenhold, a__2[0] = holdln;
-#line 629 ""
+#line 632 ""
i__4[1] = 1, a__2[1] = " ";
-#line 629 ""
+#line 632 ""
i__4[2] = lenline, a__2[2] = line;
-#line 629 ""
+#line 632 ""
s_cat(line, a__2, i__4, &c__3, (ftnlen)128);
-#line 630 ""
+#line 633 ""
lenhold = 0;
-#line 631 ""
+#line 634 ""
}
-#line 632 ""
+#line 635 ""
}
-#line 633 ""
+#line 636 ""
/* L5: */
-#line 633 ""
+#line 636 ""
}
-#line 634 ""
+#line 637 ""
}
-#line 634 ""
+#line 637 ""
}
/* Now a special loop to deal with 'X'. If it was %[n]X..., will have been */
/* copied into part [n] already. If no "B" or "P", remove. If "P", just */
/* remove the "P" so pmxa/b will process. If "B". do nothing. */
-#line 640 ""
+#line 643 ""
L10:
-#line 641 ""
+#line 644 ""
nchk = 1;
-#line 642 ""
+#line 645 ""
L13:
-#line 642 ""
+#line 645 ""
ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), (
ftnlen)1);
-#line 643 ""
+#line 646 ""
if (ntinx > nchk - 1) {
/* There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. */
-#line 647 ""
+#line 650 ""
if (ntinx > 1) {
-#line 648 ""
+#line 651 ""
i__1 = ntinx - 2;
-#line 648 ""
+#line 651 ""
if (s_cmp(line + i__1, " ", ntinx - 1 - i__1, (ftnlen)1) != 0) {
/* The X is not 1st char of PMX command. Advance starting point, loop. */
-#line 652 ""
+#line 655 ""
nchk = ntinx + 1;
-#line 653 ""
+#line 656 ""
goto L13;
-#line 654 ""
+#line 657 ""
}
-#line 655 ""
+#line 658 ""
}
/* We now know the X at ntinx starts a PMX command. Find next blank */
-#line 659 ""
+#line 662 ""
i__1 = ntinx;
-#line 659 ""
+#line 662 ""
ib = ntinx + i_indx(line + i__1, " ", 128 - i__1, (ftnlen)1);
/* There must be a blank to right of "X", so ib>ntinx */
/* locp = nchk-1+index(line(nchk:ib),'P') */
-#line 664 ""
+#line 667 ""
i__1 = ntinx;
-#line 664 ""
+#line 667 ""
locp = ntinx + i_indx(line + i__1, "P", ib - i__1, (ftnlen)1);
/* Did not need to use ntindex because we already know bounds of PMX command. */
/* if (locp .gt. nchk-1) then */
-#line 669 ""
+#line 672 ""
if (locp > ntinx) {
/* Strip out the 'P' */
-#line 673 ""
+#line 676 ""
s_copy(templine, line, (ftnlen)128, locp - 1);
-#line 674 ""
+#line 677 ""
i__1 = locp;
/* Writing concatenation */
-#line 674 ""
+#line 677 ""
i__3[0] = locp - 1, a__1[0] = templine;
-#line 674 ""
+#line 677 ""
i__3[1] = lenline - i__1, a__1[1] = line + i__1;
-#line 674 ""
+#line 677 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 675 ""
+#line 678 ""
--lenline;
-#line 676 ""
+#line 679 ""
--ib;
-#line 677 ""
+#line 680 ""
}
-#line 678 ""
+#line 681 ""
if (i_indx(line + (ntinx - 1), ":", ib - (ntinx - 1), (ftnlen)1) > 0
|| i_indx(line + (ntinx - 1), "S", ib - (ntinx - 1), (ftnlen)
1) > 0 || i_indx(line + (ntinx - 1), "B", ib - (ntinx - 1), (
@@ -1758,177 +1761,177 @@ L13:
/* The X command is a shift, "Both", or "Part". Do not remove. */
-#line 684 ""
+#line 687 ""
nchk = ib + 1;
-#line 685 ""
+#line 688 ""
goto L13;
-#line 686 ""
+#line 689 ""
}
/* Remove the X command. */
-#line 690 ""
+#line 693 ""
if (ntinx == 1) {
-#line 691 ""
+#line 694 ""
if (ib < lenline) {
-#line 692 ""
+#line 695 ""
i__1 = ib;
-#line 692 ""
+#line 695 ""
s_copy(line, line + i__1, (ftnlen)128, lenline - i__1);
-#line 693 ""
+#line 696 ""
} else {
/* line contains ONLY the "X" command, so get a new line */
-#line 697 ""
+#line 700 ""
goto L4;
-#line 698 ""
+#line 701 ""
}
-#line 699 ""
+#line 702 ""
} else {
-#line 700 ""
+#line 703 ""
s_copy(templine, line, (ftnlen)128, ntinx - 1);
-#line 701 ""
+#line 704 ""
if (ib < lenline) {
-#line 702 ""
+#line 705 ""
i__1 = ib;
/* Writing concatenation */
-#line 702 ""
+#line 705 ""
i__3[0] = ntinx - 1, a__1[0] = templine;
-#line 702 ""
+#line 705 ""
i__3[1] = lenline - i__1, a__1[1] = line + i__1;
-#line 702 ""
+#line 705 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 703 ""
+#line 706 ""
} else {
-#line 704 ""
+#line 707 ""
s_copy(line, templine, (ftnlen)128, ntinx - 1);
-#line 705 ""
+#line 708 ""
}
-#line 706 ""
+#line 709 ""
}
/* Recompute lenline */
-#line 710 ""
+#line 713 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
/* Resume checking after location of removed command. */
-#line 714 ""
+#line 717 ""
nchk = ntinx;
-#line 715 ""
+#line 718 ""
goto L13;
-#line 716 ""
+#line 719 ""
}
/* End of loop for X-checks */
-#line 720 ""
+#line 723 ""
oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0;
-#line 721 ""
+#line 724 ""
if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[
lenline - 1] == '/') {
/* Must add a terminal repeat before the slash */
-#line 726 ""
+#line 729 ""
if (oneof2) {
-#line 726 ""
+#line 729 ""
--lenline;
-#line 726 ""
+#line 729 ""
}
-#line 727 ""
+#line 730 ""
if (lenline > 1) {
-#line 727 ""
+#line 730 ""
io___103.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 727 ""
+#line 730 ""
s_wsfe(&io___103);
-#line 727 ""
+#line 730 ""
do_fio(&c__1, line, lenline - 1);
-#line 727 ""
+#line 730 ""
e_wsfe();
-#line 727 ""
+#line 730 ""
}
-#line 728 ""
+#line 731 ""
if (! oneof2) {
/* Writing concatenation */
-#line 729 ""
+#line 732 ""
i__3[0] = 2, a__1[0] = termsym;
-#line 729 ""
+#line 732 ""
i__3[1] = 2, a__1[1] = " /";
-#line 729 ""
+#line 732 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 730 ""
+#line 733 ""
lenline = 4;
-#line 731 ""
+#line 734 ""
} else {
/* Writing concatenation */
-#line 732 ""
+#line 735 ""
i__3[0] = 2, a__1[0] = termsym;
-#line 732 ""
+#line 735 ""
i__3[1] = 3, a__1[1] = " //";
-#line 732 ""
+#line 735 ""
s_cat(line, a__1, i__3, &c__2, (ftnlen)128);
-#line 733 ""
+#line 736 ""
lenline = 5;
-#line 734 ""
+#line 737 ""
}
-#line 735 ""
+#line 738 ""
}
-#line 736 ""
+#line 739 ""
if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' &&
iv == all_1.nvnow) {
-#line 736 ""
+#line 739 ""
termrpt = FALSE_;
-#line 736 ""
+#line 739 ""
}
-#line 738 ""
+#line 741 ""
io___104.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 738 ""
+#line 741 ""
s_wsfe(&io___104);
-#line 738 ""
+#line 741 ""
do_fio(&c__1, line, lenline);
-#line 738 ""
+#line 741 ""
e_wsfe();
-#line 739 ""
+#line 742 ""
if (oneof2) {
-#line 740 ""
+#line 743 ""
frstln = FALSE_;
-#line 741 ""
+#line 744 ""
} else if (! frstln) {
-#line 742 ""
+#line 745 ""
frstln = TRUE_;
-#line 743 ""
+#line 746 ""
}
/* if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */
-#line 745 ""
+#line 748 ""
if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line,
"//", (ftnlen)128, (ftnlen)2) == 0) {
-#line 746 ""
+#line 749 ""
iv = iv % all_1.nvnow + 1;
-#line 747 ""
+#line 750 ""
iinst = all_1.instnum[iv - 1];
-#line 748 ""
+#line 751 ""
}
-#line 749 ""
+#line 752 ""
goto L4;
-#line 750 ""
+#line 753 ""
L999:
-#line 751 ""
+#line 754 ""
cl__1.cerr = 0;
-#line 751 ""
+#line 754 ""
cl__1.cunit = 10;
-#line 751 ""
+#line 754 ""
cl__1.csta = 0;
-#line 751 ""
+#line 754 ""
f_clos(&cl__1);
/* In the mbrest checks, must run through ALL noinst files (not just noinow) */
-#line 755 ""
+#line 758 ""
i__1 = all_1.noinst;
-#line 755 ""
+#line 758 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
/* cc+++ */
/* c */
@@ -1948,28 +1951,28 @@ L999:
/* 51 continue */
/* close(40) */
/* cc+++ */
-#line 774 ""
+#line 777 ""
if (all_1.nvi[iinst - 1] == 1) {
-#line 775 ""
+#line 778 ""
mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + (
iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
-#line 776 ""
+#line 779 ""
} else {
/* Send a signal with ljob to bypass most mbrest processing */
-#line 780 ""
+#line 783 ""
i__2 = -ljob;
-#line 780 ""
+#line 783 ""
mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + (
iinst - 1 << 7), (ftnlen)27, (ftnlen)128);
-#line 781 ""
+#line 784 ""
}
-#line 782 ""
+#line 785 ""
/* L11: */
-#line 782 ""
+#line 785 ""
}
-#line 783 ""
+#line 786 ""
return 0;
} /* MAIN__ */
@@ -1978,21 +1981,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
/* System generated locals */
integer ret_val;
-#line 786 ""
+#line 789 ""
for (ret_val = *n; ret_val >= 1; --ret_val) {
-#line 787 ""
+#line 790 ""
if (*(unsigned char *)&string[ret_val - 1] != ' ') {
-#line 787 ""
+#line 790 ""
return ret_val;
-#line 787 ""
+#line 790 ""
}
-#line 788 ""
+#line 791 ""
/* L1: */
-#line 788 ""
+#line 791 ""
}
-#line 789 ""
+#line 792 ""
ret_val = 0;
-#line 790 ""
+#line 793 ""
return ret_val;
} /* lenstr_ */
@@ -2013,33 +2016,33 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
static cilist io___107 = { 0, 0, 0, "(a)", 0 };
-#line 798 ""
+#line 801 ""
len = lenstr_(string, n, string_len);
-#line 799 ""
+#line 802 ""
if (len == 0) {
-#line 800 ""
+#line 803 ""
len = 1;
-#line 801 ""
+#line 804 ""
s_copy(string, " ", string_len, (ftnlen)1);
-#line 802 ""
+#line 805 ""
}
-#line 803 ""
+#line 806 ""
i__1 = all_1.noinow;
-#line 803 ""
+#line 806 ""
for (iinst = 1; iinst <= i__1; ++iinst) {
-#line 804 ""
+#line 807 ""
io___107.ciunit = all_1.iorig[iinst - 1] + 10;
-#line 804 ""
+#line 807 ""
s_wsfe(&io___107);
-#line 804 ""
+#line 807 ""
do_fio(&c__1, string, len);
-#line 804 ""
+#line 807 ""
e_wsfe();
-#line 805 ""
+#line 808 ""
/* L1: */
-#line 805 ""
+#line 808 ""
}
-#line 806 ""
+#line 809 ""
return 0;
} /* allparts_ */
@@ -2123,731 +2126,731 @@ integer lenstr_(char *string, integer *n, ftnlen string_len)
static cilist io___162 = { 0, 40, 0, "(a)", 0 };
-#line 816 ""
+#line 819 ""
type4 = FALSE_;
-#line 817 ""
+#line 820 ""
*(unsigned char *)sq = '\\';
-#line 818 ""
+#line 821 ""
alldone = FALSE_;
-#line 819 ""
+#line 822 ""
al__1.aerr = 0;
-#line 819 ""
+#line 822 ""
al__1.aunit = *iv + 10;
-#line 819 ""
+#line 822 ""
f_rew(&al__1);
-#line 820 ""
+#line 823 ""
if (*iv < 10) {
-#line 821 ""
+#line 824 ""
*(unsigned char *)partq = (char) (*iv + 48);
-#line 822 ""
+#line 825 ""
lpart = 1;
-#line 823 ""
+#line 826 ""
} else {
-#line 824 ""
+#line 827 ""
lpart = 2;
-#line 825 ""
+#line 828 ""
if (*iv < 20) {
/* Writing concatenation */
-#line 826 ""
+#line 829 ""
i__1[0] = 1, a__1[0] = "1";
-#line 826 ""
+#line 829 ""
*(unsigned char *)&ch__1[0] = *iv + 38;
-#line 826 ""
+#line 829 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 826 ""
+#line 829 ""
s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
-#line 827 ""
+#line 830 ""
} else {
/* Writing concatenation */
-#line 828 ""
+#line 831 ""
i__1[0] = 1, a__1[0] = "2";
-#line 828 ""
+#line 831 ""
*(unsigned char *)&ch__1[0] = *iv + 28;
-#line 828 ""
+#line 831 ""
i__1[1] = 1, a__1[1] = ch__1;
-#line 828 ""
+#line 831 ""
s_cat(partq, a__1, i__1, &c__2, (ftnlen)2);
-#line 829 ""
+#line 832 ""
}
-#line 830 ""
+#line 833 ""
}
/* 130327 */
/* open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') */
-#line 833 ""
+#line 836 ""
if (*ludpfn == 0) {
-#line 834 ""
+#line 837 ""
o__1.oerr = 0;
-#line 834 ""
+#line 837 ""
o__1.ounit = 40;
-#line 834 ""
+#line 837 ""
o__1.ofnmlen = abs(*ljob) + lpart + 4;
/* Writing concatenation */
-#line 834 ""
+#line 837 ""
i__2[0] = abs(*ljob), a__2[0] = jobname;
-#line 834 ""
+#line 837 ""
i__2[1] = lpart, a__2[1] = partq;
-#line 834 ""
+#line 837 ""
i__2[2] = 4, a__2[2] = ".pmx";
-#line 834 ""
+#line 837 ""
s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18);
-#line 834 ""
+#line 837 ""
o__1.ofnm = ch__2;
-#line 834 ""
+#line 837 ""
o__1.orl = 0;
-#line 834 ""
+#line 837 ""
o__1.osta = 0;
-#line 834 ""
+#line 837 ""
o__1.oacc = 0;
-#line 834 ""
+#line 837 ""
o__1.ofm = 0;
-#line 834 ""
+#line 837 ""
o__1.oblnk = 0;
-#line 834 ""
+#line 837 ""
f_open(&o__1);
-#line 835 ""
+#line 838 ""
} else {
-#line 836 ""
+#line 839 ""
o__1.oerr = 0;
-#line 836 ""
+#line 839 ""
o__1.ounit = 40;
-#line 836 ""
+#line 839 ""
o__1.ofnmlen = *ludpfn + 4;
/* Writing concatenation */
-#line 836 ""
+#line 839 ""
i__1[0] = *ludpfn, a__1[0] = udpfnq;
-#line 836 ""
+#line 839 ""
i__1[1] = 4, a__1[1] = ".pmx";
-#line 836 ""
+#line 839 ""
s_cat(ch__3, a__1, i__1, &c__2, (ftnlen)132);
-#line 836 ""
+#line 839 ""
o__1.ofnm = ch__3;
-#line 836 ""
+#line 839 ""
o__1.orl = 0;
-#line 836 ""
+#line 839 ""
o__1.osta = 0;
-#line 836 ""
+#line 839 ""
o__1.oacc = 0;
-#line 836 ""
+#line 839 ""
o__1.ofm = 0;
-#line 836 ""
+#line 839 ""
o__1.oblnk = 0;
-#line 836 ""
+#line 839 ""
f_open(&o__1);
-#line 837 ""
+#line 840 ""
}
-#line 838 ""
+#line 841 ""
for (i__ = 1; i__ <= 10000; ++i__) {
-#line 839 ""
+#line 842 ""
io___114.ciunit = *iv + 10;
-#line 839 ""
+#line 842 ""
s_rsfe(&io___114);
-#line 839 ""
+#line 842 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 839 ""
+#line 842 ""
e_rsfe();
-#line 840 ""
+#line 843 ""
if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3,
(ftnlen)3) == 0 || type4) {
-#line 842 ""
+#line 845 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 843 ""
+#line 846 ""
if (len > 0) {
-#line 844 ""
+#line 847 ""
s_wsfe(&io___117);
-#line 844 ""
+#line 847 ""
do_fio(&c__1, line, len);
-#line 844 ""
+#line 847 ""
e_wsfe();
-#line 845 ""
+#line 848 ""
} else {
-#line 846 ""
+#line 849 ""
s_wsfe(&io___118);
-#line 846 ""
+#line 849 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 846 ""
+#line 849 ""
e_wsfe();
-#line 847 ""
+#line 850 ""
}
-#line 848 ""
+#line 851 ""
if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) {
-#line 848 ""
+#line 851 ""
type4 = ! type4;
-#line 848 ""
+#line 851 ""
}
-#line 849 ""
+#line 852 ""
} else {
-#line 850 ""
+#line 853 ""
goto L11;
-#line 851 ""
+#line 854 ""
}
-#line 852 ""
+#line 855 ""
/* L10: */
-#line 852 ""
+#line 855 ""
}
-#line 853 ""
+#line 856 ""
s_wsle(&io___119);
-#line 853 ""
+#line 856 ""
do_lio(&c__9, &c__1, "You should not be here in scor2prt. Call Dr. Don",
(ftnlen)49);
-#line 853 ""
+#line 856 ""
e_wsle();
-#line 854 ""
+#line 857 ""
s_stop("", (ftnlen)0);
-#line 855 ""
+#line 858 ""
L11:
/* Finished reading opening type4 TeX and comments. Next line to be read */
/* will contain the first of the input numbers */
-#line 860 ""
+#line 863 ""
dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128);
-#line 861 ""
+#line 864 ""
for (i__ = 1; i__ <= 10000; ++i__) {
-#line 862 ""
+#line 865 ""
L13:
-#line 862 ""
+#line 865 ""
io___122.ciunit = *iv + 10;
-#line 862 ""
+#line 865 ""
i__3 = s_rsfe(&io___122);
-#line 862 ""
+#line 865 ""
if (i__3 != 0) {
-#line 862 ""
+#line 865 ""
goto L999;
-#line 862 ""
+#line 865 ""
}
-#line 862 ""
+#line 865 ""
i__3 = do_fio(&c__1, line, (ftnlen)128);
-#line 862 ""
+#line 865 ""
if (i__3 != 0) {
-#line 862 ""
+#line 865 ""
goto L999;
-#line 862 ""
+#line 865 ""
}
-#line 862 ""
+#line 865 ""
i__3 = e_rsfe();
-#line 862 ""
+#line 865 ""
if (i__3 != 0) {
-#line 862 ""
+#line 865 ""
goto L999;
-#line 862 ""
+#line 865 ""
}
-#line 863 ""
+#line 866 ""
L7:
-#line 863 ""
+#line 866 ""
len = lenstr_(line, &c__128, (ftnlen)128);
/* Pass-through (and copy into part file) if instrumnet has >1 voice. */
-#line 867 ""
+#line 870 ""
if (*ljob < 0) {
-#line 867 ""
+#line 870 ""
goto L2;
-#line 867 ""
+#line 870 ""
}
-#line 868 ""
+#line 871 ""
if (i_indx("TtTiTch+h-h l ", line, (ftnlen)14, (ftnlen)2) > 0) {
/* Traps titles, instruments, composers, headers, lower strings. Read 2 lines. */
-#line 872 ""
+#line 875 ""
s_wsfe(&io___123);
-#line 872 ""
+#line 875 ""
do_fio(&c__1, line, len);
-#line 872 ""
+#line 875 ""
e_wsfe();
-#line 873 ""
+#line 876 ""
io___124.ciunit = *iv + 10;
-#line 873 ""
+#line 876 ""
s_rsfe(&io___124);
-#line 873 ""
+#line 876 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 873 ""
+#line 876 ""
e_rsfe();
-#line 874 ""
+#line 877 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 875 ""
+#line 878 ""
goto L2;
-#line 876 ""
+#line 879 ""
}
-#line 877 ""
+#line 880 ""
if (i__ == 1 || i__ > 5 && *(unsigned char *)&line[0] == 'm') {
/* Either just starting, or a new meter is defined. */
/* NOTE! The above test may be bogus. */
-#line 882 ""
+#line 885 ""
if (*(unsigned char *)&line[0] == '%') {
-#line 883 ""
+#line 886 ""
s_wsfe(&io___125);
-#line 883 ""
+#line 886 ""
do_fio(&c__1, line, len);
-#line 883 ""
+#line 886 ""
e_wsfe();
-#line 884 ""
+#line 887 ""
goto L13;
-#line 885 ""
+#line 888 ""
}
-#line 886 ""
+#line 889 ""
if (i__ != 1) {
/* New meter. Check for slashes (new meter change syntax) */
-#line 890 ""
+#line 893 ""
idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1);
-#line 891 ""
+#line 894 ""
idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
-#line 892 ""
+#line 895 ""
newmtr = idxs > 0 && (idxb == 0 || idxs < idxb);
-#line 893 ""
+#line 896 ""
if (! newmtr) {
/* Old way, no slashes, uses 'o' for lonesome '1' */
-#line 897 ""
+#line 900 ""
icden = 3;
-#line 898 ""
+#line 901 ""
if (*(unsigned char *)&line[1] == 'o') {
-#line 899 ""
+#line 902 ""
mtrnum = 1;
-#line 900 ""
+#line 903 ""
} else {
-#line 901 ""
+#line 904 ""
mtrnum = *(unsigned char *)&line[1] - 48;
-#line 902 ""
+#line 905 ""
if (mtrnum == 1) {
-#line 903 ""
+#line 906 ""
icden = 4;
-#line 904 ""
+#line 907 ""
mtrnum = *(unsigned char *)&line[2] - 38;
-#line 905 ""
+#line 908 ""
}
-#line 906 ""
+#line 909 ""
}
-#line 907 ""
+#line 910 ""
mtrden = *(unsigned char *)&line[icden - 1] - 48;
-#line 908 ""
+#line 911 ""
} else {
/* New way with slashes: idxs is index of 1st slash! */
-#line 912 ""
+#line 915 ""
ici__1.icierr = 0;
-#line 912 ""
+#line 915 ""
ici__1.iciend = 0;
-#line 912 ""
+#line 915 ""
ici__1.icirnum = 1;
-#line 912 ""
+#line 915 ""
ici__1.icirlen = idxs - 2;
-#line 912 ""
+#line 915 ""
ici__1.iciunit = line + 1;
/* Writing concatenation */
-#line 912 ""
+#line 915 ""
i__2[0] = 2, a__2[0] = "(i";
-#line 912 ""
+#line 915 ""
*(unsigned char *)&ch__1[0] = idxs + 46;
-#line 912 ""
+#line 915 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 912 ""
+#line 915 ""
i__2[2] = 1, a__2[2] = ")";
-#line 912 ""
+#line 915 ""
ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
4), ch__4);
-#line 912 ""
+#line 915 ""
s_rsfi(&ici__1);
-#line 912 ""
+#line 915 ""
do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer));
-#line 912 ""
+#line 915 ""
e_rsfi();
-#line 913 ""
+#line 916 ""
i__3 = idxs;
-#line 913 ""
+#line 916 ""
idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1);
-#line 914 ""
+#line 917 ""
i__3 = idxs;
-#line 914 ""
+#line 917 ""
ici__1.icierr = 0;
-#line 914 ""
+#line 917 ""
ici__1.iciend = 0;
-#line 914 ""
+#line 917 ""
ici__1.icirnum = 1;
-#line 914 ""
+#line 917 ""
ici__1.icirlen = idxs + idxb - 1 - i__3;
-#line 914 ""
+#line 917 ""
ici__1.iciunit = line + i__3;
/* Writing concatenation */
-#line 914 ""
+#line 917 ""
i__2[0] = 2, a__2[0] = "(i";
-#line 914 ""
+#line 917 ""
*(unsigned char *)&ch__1[0] = idxb + 47;
-#line 914 ""
+#line 917 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 914 ""
+#line 917 ""
i__2[2] = 1, a__2[2] = ")";
-#line 914 ""
+#line 917 ""
ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen)
4), ch__4);
-#line 914 ""
+#line 917 ""
s_rsfi(&ici__1);
-#line 914 ""
+#line 917 ""
do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer));
-#line 914 ""
+#line 917 ""
e_rsfi();
-#line 916 ""
+#line 919 ""
}
-#line 917 ""
+#line 920 ""
}
-#line 918 ""
+#line 921 ""
lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1);
-#line 919 ""
+#line 922 ""
lenmult = 1;
-#line 920 ""
+#line 923 ""
if (mtrden == 2) {
-#line 921 ""
+#line 924 ""
lenbeat = 16;
-#line 922 ""
+#line 925 ""
lenmult = 2;
-#line 923 ""
+#line 926 ""
}
-#line 924 ""
+#line 927 ""
lenbar = lenmult * mtrnum * lenbeat;
-#line 925 ""
+#line 928 ""
fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3);
-#line 926 ""
+#line 929 ""
}
/* Finished setting up meter stuff and defining whole-bar rest symbols */
-#line 930 ""
+#line 933 ""
ip1 = 0;
-#line 931 ""
+#line 934 ""
s_copy(line1, line, (ftnlen)128, (ftnlen)128);
-#line 932 ""
+#line 935 ""
i__3 = nwbrs;
-#line 932 ""
+#line 935 ""
for (iw = 0; iw <= i__3; ++iw) {
-#line 933 ""
+#line 936 ""
if (iw > 0) {
-#line 934 ""
+#line 937 ""
idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128,
lwbrs);
-#line 935 ""
+#line 938 ""
if (idx > 0) {
/* Check for blank or shifted rest, discount it if it's there */
-#line 939 ""
+#line 942 ""
i__4 = idx + lwbrs - 1;
-#line 939 ""
+#line 942 ""
if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen)
1) != 0) {
-#line 939 ""
+#line 942 ""
idx = 0;
-#line 939 ""
+#line 942 ""
}
-#line 940 ""
+#line 943 ""
}
-#line 941 ""
+#line 944 ""
} else {
-#line 942 ""
+#line 945 ""
idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2);
/* Check for raised rest */
-#line 946 ""
+#line 949 ""
if (idx > 0) {
-#line 947 ""
+#line 950 ""
i__4 = idx + 1;
-#line 947 ""
+#line 950 ""
if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) !=
0) {
-#line 947 ""
+#line 950 ""
idx = 0;
-#line 947 ""
+#line 950 ""
}
-#line 948 ""
+#line 951 ""
}
-#line 949 ""
+#line 952 ""
}
-#line 950 ""
+#line 953 ""
if (idx > 0) {
-#line 951 ""
+#line 954 ""
if (ip1 == 0) {
-#line 952 ""
+#line 955 ""
ip1 = idx;
-#line 953 ""
+#line 956 ""
} else {
-#line 954 ""
+#line 957 ""
ip1 = min(ip1,idx);
/* Maybe allows e.g. r0 rp ... */
-#line 955 ""
+#line 958 ""
}
-#line 956 ""
+#line 959 ""
}
-#line 957 ""
+#line 960 ""
/* L3: */
-#line 957 ""
+#line 960 ""
}
/* Writing concatenation */
-#line 958 ""
+#line 961 ""
i__1[0] = 1, a__1[0] = sq;
-#line 958 ""
+#line 961 ""
i__1[1] = 1, a__1[1] = sq;
-#line 958 ""
+#line 961 ""
s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)2);
-#line 958 ""
+#line 961 ""
if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__5,
(ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) {
-#line 958 ""
+#line 961 ""
goto L2;
-#line 958 ""
+#line 961 ""
}
/* Switch to multibar rest search mode!!! Start forward in line(1) */
-#line 963 ""
+#line 966 ""
rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0;
-#line 964 ""
+#line 967 ""
iline = 1;
-#line 965 ""
+#line 968 ""
nmbr = 1;
-#line 966 ""
+#line 969 ""
if (rpfirst) {
-#line 967 ""
+#line 970 ""
lwbrsx = 2;
-#line 968 ""
+#line 971 ""
} else {
-#line 969 ""
+#line 972 ""
lwbrsx = lwbrs;
-#line 970 ""
+#line 973 ""
}
-#line 971 ""
+#line 974 ""
ipe = ip1 + lwbrsx - 1;
/* ip at end of 1st wbrsym */
-#line 972 ""
+#line 975 ""
L4:
-#line 972 ""
+#line 975 ""
if (ipe == len) {
/* Need a new line */
-#line 976 ""
+#line 979 ""
++iline;
-#line 977 ""
+#line 980 ""
L6:
-#line 977 ""
+#line 980 ""
io___145.ciunit = *iv + 10;
-#line 977 ""
+#line 980 ""
i__3 = s_rsfe(&io___145);
-#line 977 ""
+#line 980 ""
if (i__3 != 0) {
-#line 977 ""
+#line 980 ""
goto L998;
-#line 977 ""
+#line 980 ""
}
-#line 977 ""
+#line 980 ""
i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128);
-#line 977 ""
+#line 980 ""
if (i__3 != 0) {
-#line 977 ""
+#line 980 ""
goto L998;
-#line 977 ""
+#line 980 ""
}
-#line 977 ""
+#line 980 ""
i__3 = e_rsfe();
-#line 977 ""
+#line 980 ""
if (i__3 != 0) {
-#line 977 ""
+#line 980 ""
goto L998;
-#line 977 ""
+#line 980 ""
}
-#line 978 ""
+#line 981 ""
len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
-#line 979 ""
+#line 982 ""
if (*(unsigned char *)&line[(iline - 1) * 128] == '%') {
-#line 980 ""
+#line 983 ""
s_wsfe(&io___146);
-#line 980 ""
+#line 983 ""
do_fio(&c__1, "% Following comment has been moved forward", (
ftnlen)42);
-#line 980 ""
+#line 983 ""
e_wsfe();
-#line 981 ""
+#line 984 ""
s_wsfe(&io___147);
-#line 981 ""
+#line 984 ""
do_fio(&c__1, line + (iline - 1 << 7), len);
-#line 981 ""
+#line 984 ""
e_wsfe();
-#line 982 ""
+#line 985 ""
goto L6;
-#line 983 ""
+#line 986 ""
}
-#line 984 ""
+#line 987 ""
ipe = 0;
-#line 985 ""
+#line 988 ""
goto L4;
-#line 986 ""
+#line 989 ""
L998:
/* No more input left */
-#line 990 ""
+#line 993 ""
s_wsle(&io___148);
-#line 990 ""
+#line 993 ""
do_lio(&c__9, &c__1, "All done!", (ftnlen)9);
-#line 990 ""
+#line 993 ""
e_wsle();
-#line 991 ""
+#line 994 ""
alldone = TRUE_;
-#line 992 ""
+#line 995 ""
ipe = 0;
-#line 993 ""
+#line 996 ""
--iline;
-#line 994 ""
+#line 997 ""
len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128);
-#line 995 ""
+#line 998 ""
goto L4;
-#line 996 ""
+#line 999 ""
} else {
-#line 997 ""
+#line 1000 ""
if (alldone) {
-#line 998 ""
+#line 1001 ""
*(unsigned char *)sym = ' ';
-#line 999 ""
+#line 1002 ""
} else {
/* ipe<len here, so it's ok to get a symbol */
-#line 1003 ""
+#line 1006 ""
nextsym_(line + (iline - 1 << 7), &len, &ipe, &ipenew, sym, &
lsym, (ftnlen)128, (ftnlen)80);
-#line 1004 ""
+#line 1007 ""
}
/* Check for end of block or bar line symbol */
-#line 1008 ""
+#line 1011 ""
if (i_indx("/|", sym, (ftnlen)2, (ftnlen)1) > 0) {
-#line 1009 ""
+#line 1012 ""
ipe = ipenew;
-#line 1010 ""
+#line 1013 ""
goto L4;
-#line 1011 ""
+#line 1014 ""
} else {
-#line 1012 ""
+#line 1015 ""
wbrest = FALSE_;
-#line 1013 ""
+#line 1016 ""
if (alldone) {
-#line 1013 ""
+#line 1016 ""
goto L12;
-#line 1013 ""
+#line 1016 ""
}
-#line 1014 ""
+#line 1017 ""
i__3 = nwbrs;
-#line 1014 ""
+#line 1017 ""
for (iw = 1; iw <= i__3; ++iw) {
-#line 1015 ""
+#line 1018 ""
wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym,
lwbrs) == 0;
-#line 1016 ""
+#line 1019 ""
/* L5: */
-#line 1016 ""
+#line 1019 ""
}
-#line 1017 ""
+#line 1020 ""
wbrest = wbrest || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 &&
lwbrs == 2 || s_cmp(sym, "rd", lsym, (ftnlen)2) == 0
&& lwbrs == 3 || s_cmp(sym, "rp", lsym, (ftnlen)2) ==
0 || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && rpfirst;
-#line 1021 ""
+#line 1024 ""
L12:
-#line 1021 ""
+#line 1024 ""
if (wbrest) {
-#line 1022 ""
+#line 1025 ""
ipe = ipenew;
-#line 1023 ""
+#line 1026 ""
++nmbr;
-#line 1024 ""
+#line 1027 ""
goto L4;
-#line 1025 ""
+#line 1028 ""
} else {
/* AHA! Failed prev. test, so last symbol was *not* mbr. */
/* It must be saved, and its starting position is ipenew-lsym+1 */
-#line 1030 ""
+#line 1033 ""
if (nmbr > 1) {
/* Write stuff up to start of mbr */
-#line 1034 ""
+#line 1037 ""
if (ip1 > 1) {
-#line 1034 ""
+#line 1037 ""
s_wsfe(&io___153);
-#line 1034 ""
+#line 1037 ""
do_fio(&c__1, line, ip1 - 1);
-#line 1034 ""
+#line 1037 ""
e_wsfe();
-#line 1034 ""
+#line 1037 ""
}
/* Insert mbr symbol. Always end with a slash just in case next sym must be */
/* at start of block. May think this causes undefined octaves, but */
/* probably not since it's a single voice. */
-#line 1040 ""
+#line 1043 ""
r__1 = nmbr + .01f;
-#line 1040 ""
+#line 1043 ""
ndig = (integer) r_lg10(&r__1) + 1;
-#line 1041 ""
+#line 1044 ""
s_wsle(&io___155);
-#line 1041 ""
+#line 1044 ""
do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", (
ftnlen)22);
-#line 1041 ""
+#line 1044 ""
do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof(
integer));
-#line 1041 ""
+#line 1044 ""
do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof(
integer));
-#line 1041 ""
+#line 1044 ""
e_wsle();
-#line 1042 ""
+#line 1045 ""
ci__1.cierr = 0;
-#line 1042 ""
+#line 1045 ""
ci__1.ciunit = 40;
/* Writing concatenation */
-#line 1042 ""
+#line 1045 ""
i__2[0] = 5, a__2[0] = "(a2,i";
-#line 1042 ""
+#line 1045 ""
*(unsigned char *)&ch__1[0] = ndig + 48;
-#line 1042 ""
+#line 1045 ""
i__2[1] = 1, a__2[1] = ch__1;
-#line 1042 ""
+#line 1045 ""
i__2[2] = 4, a__2[2] = ",a2)";
-#line 1042 ""
+#line 1045 ""
ci__1.cifmt = (s_cat(ch__6, a__2, i__2, &c__3, (
ftnlen)10), ch__6);
-#line 1042 ""
+#line 1045 ""
s_wsfe(&ci__1);
-#line 1042 ""
+#line 1045 ""
do_fio(&c__1, "rm", (ftnlen)2);
-#line 1042 ""
+#line 1045 ""
do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer));
-#line 1042 ""
+#line 1045 ""
do_fio(&c__1, " /", (ftnlen)2);
-#line 1042 ""
+#line 1045 ""
e_wsfe();
-#line 1043 ""
+#line 1046 ""
if (alldone) {
-#line 1043 ""
+#line 1046 ""
goto L999;
-#line 1043 ""
+#line 1046 ""
}
-#line 1044 ""
+#line 1047 ""
ipc = ipenew - lsym + 1;
-#line 1045 ""
+#line 1048 ""
s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), (
ftnlen)128, len - (ipc - 1));
-#line 1046 ""
+#line 1049 ""
} else {
/* Write old stuff up to end of original lonesome wbr, save the rest. */
@@ -2857,112 +2860,112 @@ L12:
/* non-comment line; then revert to normal mode on that. In 3rd case must */
/* split line. */
-#line 1055 ""
+#line 1058 ""
if (alldone) {
-#line 1056 ""
+#line 1059 ""
s_wsfe(&io___157);
-#line 1056 ""
+#line 1059 ""
do_fio(&c__1, line, len);
-#line 1056 ""
+#line 1059 ""
e_wsfe();
-#line 1057 ""
+#line 1060 ""
goto L999;
-#line 1058 ""
+#line 1061 ""
} else if (iline > 1) {
-#line 1059 ""
+#line 1062 ""
i__3 = iline - 1;
-#line 1059 ""
+#line 1062 ""
for (il = 1; il <= i__3; ++il) {
-#line 1060 ""
+#line 1063 ""
len = lenstr_(line + (il - 1 << 7), &c__128, (
ftnlen)128);
-#line 1061 ""
+#line 1064 ""
s_wsfe(&io___159);
-#line 1061 ""
+#line 1064 ""
do_fio(&c__1, line + (il - 1 << 7), len);
-#line 1061 ""
+#line 1064 ""
e_wsfe();
-#line 1062 ""
+#line 1065 ""
/* L9: */
-#line 1062 ""
+#line 1065 ""
}
-#line 1063 ""
+#line 1066 ""
s_copy(line, line + (iline - 1 << 7), (ftnlen)128,
(ftnlen)128);
-#line 1064 ""
+#line 1067 ""
} else {
/* Since iline = 1 the wbr is not the last sym, so must split */
-#line 1068 ""
+#line 1071 ""
s_wsfe(&io___160);
-#line 1068 ""
+#line 1071 ""
do_fio(&c__1, line, ip1 + lwbrsx - 1);
-#line 1068 ""
+#line 1071 ""
e_wsfe();
-#line 1069 ""
+#line 1072 ""
i__3 = ip1 + lwbrsx;
-#line 1069 ""
+#line 1072 ""
s_copy(line, line + i__3, (ftnlen)128, len - i__3)
;
-#line 1070 ""
+#line 1073 ""
}
-#line 1071 ""
+#line 1074 ""
}
/* Exit multibar mode */
-#line 1075 ""
+#line 1078 ""
goto L7;
-#line 1076 ""
+#line 1079 ""
}
-#line 1077 ""
+#line 1080 ""
}
-#line 1078 ""
+#line 1081 ""
}
-#line 1079 ""
+#line 1082 ""
L2:
-#line 1080 ""
+#line 1083 ""
if (len > 0) {
-#line 1081 ""
+#line 1084 ""
s_wsfe(&io___161);
-#line 1081 ""
+#line 1084 ""
do_fio(&c__1, line, len);
-#line 1081 ""
+#line 1084 ""
e_wsfe();
-#line 1082 ""
+#line 1085 ""
} else {
-#line 1083 ""
+#line 1086 ""
s_wsfe(&io___162);
-#line 1083 ""
+#line 1086 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 1083 ""
+#line 1086 ""
e_wsfe();
-#line 1084 ""
+#line 1087 ""
}
-#line 1085 ""
+#line 1088 ""
/* L1: */
-#line 1085 ""
+#line 1088 ""
}
-#line 1086 ""
+#line 1089 ""
L999:
-#line 1087 ""
+#line 1090 ""
cl__1.cerr = 0;
-#line 1087 ""
+#line 1090 ""
cl__1.cunit = *iv + 10;
-#line 1087 ""
+#line 1090 ""
cl__1.csta = 0;
-#line 1087 ""
+#line 1090 ""
f_clos(&cl__1);
-#line 1088 ""
+#line 1091 ""
cl__1.cerr = 0;
-#line 1088 ""
+#line 1091 ""
cl__1.cunit = 40;
-#line 1088 ""
+#line 1091 ""
cl__1.csta = 0;
-#line 1088 ""
+#line 1091 ""
f_clos(&cl__1);
-#line 1089 ""
+#line 1092 ""
return 0;
} /* mbrests_ */
@@ -2980,54 +2983,54 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
static cilist io___163 = { 0, 6, 0, 0, 0 };
-#line 1093 ""
+#line 1096 ""
if (*idur == 6) {
-#line 1094 ""
+#line 1097 ""
ret_val = 1;
-#line 1095 ""
+#line 1098 ""
} else if (*idur == 3) {
-#line 1096 ""
+#line 1099 ""
ret_val = 2;
-#line 1097 ""
+#line 1100 ""
} else if (*idur == 1 || *idur == 16) {
-#line 1098 ""
+#line 1101 ""
ret_val = 4;
-#line 1099 ""
+#line 1102 ""
} else if (*idur == 8) {
-#line 1100 ""
+#line 1103 ""
ret_val = 8;
-#line 1101 ""
+#line 1104 ""
} else if (*idur == 4) {
-#line 1102 ""
+#line 1105 ""
ret_val = 16;
-#line 1103 ""
+#line 1106 ""
} else if (*idur == 2) {
-#line 1104 ""
+#line 1107 ""
ret_val = 32;
-#line 1105 ""
+#line 1108 ""
} else if (*idur == 0) {
-#line 1106 ""
+#line 1109 ""
ret_val = 64;
-#line 1107 ""
+#line 1110 ""
} else {
-#line 1108 ""
+#line 1111 ""
s_wsle(&io___163);
-#line 1108 ""
+#line 1111 ""
do_lio(&c__9, &c__1, "You entered an invalid note-length value", (
ftnlen)40);
-#line 1108 ""
+#line 1111 ""
e_wsle();
-#line 1109 ""
+#line 1112 ""
s_stop("", (ftnlen)0);
-#line 1110 ""
+#line 1113 ""
}
-#line 1111 ""
+#line 1114 ""
if (*(unsigned char *)dotq == 'd') {
-#line 1111 ""
+#line 1114 ""
ret_val = ret_val * 3 / 2;
-#line 1111 ""
+#line 1114 ""
}
-#line 1112 ""
+#line 1115 ""
return ret_val;
} /* ifnodur_ */
@@ -3039,79 +3042,82 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Fortran I/O blocks */
- static cilist io___164 = { 0, 6, 0, "(33H Any whole-bar rests of duratio"
- "n ,i3, 26H/64 will not be recognized)", 0 };
+ static cilist io___164 = { 0, 6, 0, "(a33,i3,a26)", 0 };
-#line 1116 ""
+#line 1119 ""
/* Parameter adjustments */
-#line 1116 ""
+#line 1119 ""
wbrsym -= 3;
-#line 1116 ""
+#line 1119 ""
-#line 1116 ""
+#line 1119 ""
/* Function Body */
-#line 1116 ""
+#line 1119 ""
*nwbrs = 1;
-#line 1117 ""
+#line 1120 ""
*lwbrs = 2;
-#line 1118 ""
+#line 1121 ""
if (*lenbar == 16) {
-#line 1119 ""
+#line 1122 ""
s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2);
-#line 1120 ""
+#line 1123 ""
} else if (*lenbar == 32) {
-#line 1121 ""
+#line 1124 ""
s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2);
-#line 1122 ""
+#line 1125 ""
} else if (*lenbar == 64) {
-#line 1123 ""
+#line 1126 ""
s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2);
-#line 1124 ""
+#line 1127 ""
} else if (*lenbar == 8) {
-#line 1125 ""
+#line 1128 ""
s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2);
-#line 1126 ""
+#line 1129 ""
} else if (*lenbar == 128) {
-#line 1127 ""
+#line 1130 ""
s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2);
-#line 1128 ""
+#line 1131 ""
} else {
-#line 1129 ""
+#line 1132 ""
*nwbrs = 2;
-#line 1130 ""
+#line 1133 ""
*lwbrs = 3;
-#line 1131 ""
+#line 1134 ""
if (*lenbar == 24) {
-#line 1132 ""
+#line 1135 ""
s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3);
-#line 1133 ""
+#line 1136 ""
s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3);
-#line 1134 ""
+#line 1137 ""
} else if (*lenbar == 48) {
-#line 1135 ""
+#line 1138 ""
s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3);
-#line 1136 ""
+#line 1139 ""
s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3);
-#line 1137 ""
+#line 1140 ""
} else if (*lenbar == 96) {
-#line 1138 ""
+#line 1141 ""
s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3);
-#line 1139 ""
+#line 1142 ""
s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3);
-#line 1140 ""
+#line 1143 ""
} else {
-#line 1141 ""
+#line 1144 ""
s_wsfe(&io___164);
-#line 1141 ""
+#line 1144 ""
+ do_fio(&c__1, " Any whole-bar rests of duration", (ftnlen)32);
+#line 1144 ""
do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer));
-#line 1141 ""
+#line 1144 ""
+ do_fio(&c__1, "/64 will not be recognized", (ftnlen)26);
+#line 1144 ""
e_wsfe();
-#line 1143 ""
+#line 1146 ""
}
-#line 1144 ""
+#line 1147 ""
}
-#line 1145 ""
+#line 1148 ""
return 0;
} /* fwbrsym_ */
@@ -3141,104 +3147,104 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len)
/* Know its the last symbol if on return ipenew = len!. So should never */
/* be called when ipstart=len. */
-#line 1154 ""
+#line 1157 ""
if (*ipeold >= *len) {
-#line 1155 ""
+#line 1158 ""
s_wsle(&io___165);
-#line 1155 ""
+#line 1158 ""
do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33);
-#line 1155 ""
+#line 1158 ""
e_wsle();
-#line 1156 ""
+#line 1159 ""
s_wsle(&io___166);
-#line 1156 ""
+#line 1159 ""
do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons@logicon.com", (
ftnlen)44);
-#line 1156 ""
+#line 1159 ""
e_wsle();
-#line 1157 ""
+#line 1160 ""
s_stop("", (ftnlen)0);
-#line 1158 ""
+#line 1161 ""
}
-#line 1159 ""
+#line 1162 ""
i__1 = *len;
-#line 1159 ""
+#line 1162 ""
for (ip = *ipeold + 1; ip <= i__1; ++ip) {
-#line 1160 ""
+#line 1163 ""
if (*(unsigned char *)&line[ip - 1] != ' ') {
/* symbol starts here (ip). We're committed to exit the loop. */
-#line 1164 ""
+#line 1167 ""
if (ip < *len) {
-#line 1165 ""
+#line 1168 ""
i__2 = *len;
-#line 1165 ""
+#line 1168 ""
for (iip = ip + 1; iip <= i__2; ++iip) {
-#line 1166 ""
+#line 1169 ""
if (*(unsigned char *)&line[iip - 1] != ' ') {
-#line 1166 ""
+#line 1169 ""
goto L2;
-#line 1166 ""
+#line 1169 ""
}
/* iip is the space after the symbol */
-#line 1170 ""
+#line 1173 ""
*ipenew = iip - 1;
-#line 1171 ""
+#line 1174 ""
*lsym = *ipenew - ip + 1;
-#line 1172 ""
+#line 1175 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip -
1));
-#line 1173 ""
+#line 1176 ""
return 0;
-#line 1174 ""
+#line 1177 ""
L2:
-#line 1174 ""
+#line 1177 ""
;
-#line 1174 ""
+#line 1177 ""
}
/* Have len>=2 and ends on len */
-#line 1178 ""
+#line 1181 ""
*ipenew = *len;
-#line 1179 ""
+#line 1182 ""
*lsym = *ipenew - ip + 1;
-#line 1180 ""
+#line 1183 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1));
-#line 1181 ""
+#line 1184 ""
return 0;
-#line 1182 ""
+#line 1185 ""
} else {
/* ip = len */
-#line 1186 ""
+#line 1189 ""
*ipenew = *len;
-#line 1187 ""
+#line 1190 ""
*lsym = 1;
-#line 1188 ""
+#line 1191 ""
s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1);
-#line 1189 ""
+#line 1192 ""
return 0;
-#line 1190 ""
+#line 1193 ""
}
-#line 1191 ""
+#line 1194 ""
}
-#line 1192 ""
+#line 1195 ""
/* L1: */
-#line 1192 ""
+#line 1195 ""
}
-#line 1193 ""
+#line 1196 ""
s_wsle(&io___169);
-#line 1193 ""
+#line 1196 ""
do_lio(&c__9, &c__1, "Error #3. Send files to Dr. Don at dsimons@logico"\
"n.com", (ftnlen)55);
-#line 1193 ""
+#line 1196 ""
e_wsle();
-#line 1194 ""
+#line 1197 ""
return 0;
} /* nextsym_ */
@@ -3278,158 +3284,158 @@ integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len)
/* Use a temporary string to store the input and test, so can zap D"..." */
-#line 1209 ""
+#line 1212 ""
s_copy(tline, line, (ftnlen)128, (ftnlen)128);
-#line 1210 ""
+#line 1213 ""
ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len);
/* Return point below for rechecks after zapping D" " */
-#line 1214 ""
+#line 1217 ""
L2:
-#line 1215 ""
+#line 1218 ""
ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1);
-#line 1216 ""
+#line 1219 ""
if (ndxbs > 0) {
/* Special check in case \ is inside D"..." */
-#line 1220 ""
+#line 1223 ""
ndxdq1 = i_indx(tline, "D\"", (ftnlen)128, (ftnlen)2);
/* If the following test fails, flow out of if block; else loop up to 2. */
-#line 1224 ""
+#line 1227 ""
if (ndxdq1 > 0) {
/* Find end of D"..." */
-#line 1228 ""
+#line 1231 ""
i__1 = ndxdq1 + 1;
-#line 1228 ""
+#line 1231 ""
ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, (
ftnlen)1);
-#line 1229 ""
+#line 1232 ""
if (ndxdq2 == ndxdq1 + 1) {
-#line 1230 ""
+#line 1233 ""
s_wsle(&io___175);
-#line 1230 ""
+#line 1233 ""
do_lio(&c__9, &c__1, "Something is really wierd here", (
ftnlen)30);
-#line 1230 ""
+#line 1233 ""
e_wsle();
-#line 1231 ""
+#line 1234 ""
s_stop("", (ftnlen)0);
-#line 1232 ""
+#line 1235 ""
}
-#line 1233 ""
+#line 1236 ""
s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1);
-#line 1234 ""
+#line 1237 ""
i__1 = ndxdq2;
-#line 1234 ""
+#line 1237 ""
for (ic = ndxdq1; ic <= i__1; ++ic) {
/* Writing concatenation */
-#line 1235 ""
+#line 1238 ""
i__2[0] = ic - 1, a__1[0] = tline;
-#line 1235 ""
+#line 1238 ""
i__2[1] = 1, a__1[1] = " ";
-#line 1235 ""
+#line 1238 ""
s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
-#line 1236 ""
+#line 1239 ""
/* L3: */
-#line 1236 ""
+#line 1239 ""
}
-#line 1237 ""
+#line 1240 ""
i__1 = ndxdq2;
/* Writing concatenation */
-#line 1237 ""
+#line 1240 ""
i__2[0] = ndxdq2, a__1[0] = tline;
-#line 1237 ""
+#line 1240 ""
i__2[1] = 128 - i__1, a__1[1] = line + i__1;
-#line 1237 ""
+#line 1240 ""
s_cat(tline, a__1, i__2, &c__2, (ftnlen)128);
-#line 1238 ""
+#line 1241 ""
goto L2;
-#line 1239 ""
+#line 1242 ""
}
-#line 1240 ""
+#line 1243 ""
}
-#line 1241 ""
+#line 1244 ""
if (ndxbs == 0 || ndxs2 < ndxbs) {
-#line 1242 ""
+#line 1245 ""
ret_val = ndxs2;
/* print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */
-#line 1244 ""
+#line 1247 ""
} else {
/* There are both bs and s2q, and bs is to the left of sq2. So check bs's to */
/* right of first: End is '\ ', start is ' \' */
-#line 1249 ""
+#line 1252 ""
len = lenstr_(tline, &c__128, (ftnlen)128);
-#line 1250 ""
+#line 1253 ""
intex = TRUE_;
/* print*,'intex+>',intex */
-#line 1252 ""
+#line 1255 ""
i__1 = len;
-#line 1252 ""
+#line 1255 ""
for (ic = ndxbs + 1; ic <= i__1; ++ic) {
-#line 1253 ""
+#line 1256 ""
if (ic == ndxs2) {
-#line 1254 ""
+#line 1257 ""
if (intex) {
-#line 1255 ""
+#line 1258 ""
ret_val = 0;
-#line 1256 ""
+#line 1259 ""
i__3 = ic;
-#line 1256 ""
+#line 1259 ""
ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) +
ic;
/* print*,'ndxs2 =>',ndxs2 */
-#line 1258 ""
+#line 1261 ""
} else {
-#line 1259 ""
+#line 1262 ""
ret_val = ndxs2;
-#line 1260 ""
+#line 1263 ""
return ret_val;
-#line 1261 ""
+#line 1264 ""
}
/* print*,'Internal exit, intex, ntindex:',intex,ntindex */
-#line 1263 ""
+#line 1266 ""
} else /* if(complicated condition) */ {
-#line 1263 ""
+#line 1266 ""
i__3 = ic;
-#line 1263 ""
+#line 1266 ""
if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, (
ftnlen)2) == 0) {
-#line 1264 ""
+#line 1267 ""
intex = FALSE_;
/* print*,'intex+>',intex */
-#line 1266 ""
+#line 1269 ""
} else /* if(complicated condition) */ {
-#line 1266 ""
+#line 1269 ""
i__3 = ic;
-#line 1266 ""
+#line 1269 ""
if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, (
ftnlen)2) == 0) {
-#line 1268 ""
+#line 1271 ""
intex = TRUE_;
/* print*,'intex+>',intex */
-#line 1270 ""
+#line 1273 ""
}
-#line 1270 ""
+#line 1273 ""
}
-#line 1270 ""
+#line 1273 ""
}
-#line 1271 ""
+#line 1274 ""
/* L1: */
-#line 1271 ""
+#line 1274 ""
}
/* print*,'Out end of loop 1' */
-#line 1273 ""
+#line 1276 ""
}
/* print*,'Exiting ntindex at the end???' */
-#line 1275 ""
+#line 1278 ""
return ret_val;
} /* ntindex_ */
@@ -3447,23 +3453,23 @@ L2:
/* Gets the next character out of line*128. If pointer iccount=128 on entry, */
/* then reads in a new line. Resets iccount to position of the new character. */
-#line 1284 ""
+#line 1287 ""
if (*iccount == 128) {
-#line 1285 ""
+#line 1288 ""
s_rsfe(&io___179);
-#line 1285 ""
+#line 1288 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1285 ""
+#line 1288 ""
e_rsfe();
-#line 1286 ""
+#line 1289 ""
*iccount = 0;
-#line 1287 ""
+#line 1290 ""
}
-#line 1288 ""
+#line 1291 ""
++(*iccount);
-#line 1289 ""
+#line 1292 ""
*(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1];
-#line 1290 ""
+#line 1293 ""
return 0;
} /* getchar_ */
@@ -3515,167 +3521,167 @@ doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen
/* 4 musicsize 20 */
/* 5 fracondent 0.05 */
-#line 1315 ""
+#line 1318 ""
L4:
-#line 1315 ""
+#line 1318 ""
if (*iccount == 128) {
-#line 1316 ""
+#line 1319 ""
s_rsfe(&io___180);
-#line 1316 ""
+#line 1319 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1316 ""
+#line 1319 ""
e_rsfe();
-#line 1317 ""
+#line 1320 ""
if (all_1.replacing) {
-#line 1317 ""
+#line 1320 ""
all_1.replacing = FALSE_;
-#line 1317 ""
+#line 1320 ""
}
-#line 1318 ""
+#line 1321 ""
chkcom_(line, &goto999, (ftnlen)128);
-#line 1319 ""
+#line 1322 ""
*iccount = 0;
-#line 1320 ""
+#line 1323 ""
}
-#line 1321 ""
+#line 1324 ""
++(*iccount);
/* Find next non-blank or end of line */
-#line 1325 ""
+#line 1328 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
-#line 1326 ""
+#line 1329 ""
if (*(unsigned char *)&line[*iccount - 1] != ' ') {
-#line 1326 ""
+#line 1329 ""
goto L3;
-#line 1326 ""
+#line 1329 ""
}
-#line 1327 ""
+#line 1330 ""
/* L2: */
-#line 1327 ""
+#line 1330 ""
}
/* If here, need to get a new line */
-#line 1331 ""
+#line 1334 ""
*iccount = 128;
-#line 1332 ""
+#line 1335 ""
goto L4;
-#line 1333 ""
+#line 1336 ""
L3:
/* iccount now points to start of number to read */
-#line 1337 ""
+#line 1340 ""
i1 = *iccount;
-#line 1338 ""
+#line 1341 ""
L5:
-#line 1338 ""
+#line 1341 ""
getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar first increments iccount, *then* reads a character. */
-#line 1342 ""
+#line 1345 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 1342 ""
+#line 1345 ""
goto L5;
-#line 1342 ""
+#line 1345 ""
}
-#line 1343 ""
+#line 1346 ""
i2 = *iccount - 1;
-#line 1344 ""
+#line 1347 ""
if (i2 < i1) {
-#line 1345 ""
+#line 1348 ""
s_wsle(&io___185);
/* Writing concatenation */
-#line 1345 ""
+#line 1348 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 1345 ""
+#line 1348 ""
i__1[1] = 1, a__1[1] = durq;
-#line 1345 ""
+#line 1348 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 1345 ""
+#line 1348 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 1345 ""
+#line 1348 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 1345 ""
+#line 1348 ""
e_wsle();
-#line 1346 ""
+#line 1349 ""
s_stop("1", (ftnlen)1);
-#line 1347 ""
+#line 1350 ""
}
-#line 1348 ""
+#line 1351 ""
icf = i2 - i1 + 49;
-#line 1349 ""
+#line 1352 ""
ici__1.icierr = 0;
-#line 1349 ""
+#line 1352 ""
ici__1.iciend = 0;
-#line 1349 ""
+#line 1352 ""
ici__1.icirnum = 1;
-#line 1349 ""
+#line 1352 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 1349 ""
+#line 1352 ""
ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
-#line 1349 ""
+#line 1352 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 1349 ""
+#line 1352 ""
*(unsigned char *)&ch__3[0] = icf;
-#line 1349 ""
+#line 1352 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 1349 ""
+#line 1352 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 1349 ""
+#line 1352 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 1349 ""
+#line 1352 ""
s_rsfi(&ici__1);
-#line 1349 ""
+#line 1352 ""
do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real));
-#line 1349 ""
+#line 1352 ""
e_rsfi();
-#line 1350 ""
+#line 1353 ""
if (! all_1.replacing) {
-#line 1351 ""
+#line 1354 ""
if (*iread == 0) {
-#line 1352 ""
+#line 1355 ""
i__2 = i2 - i1 + 1;
-#line 1352 ""
+#line 1355 ""
allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1));
-#line 1353 ""
+#line 1356 ""
} else if (*iread == 1) {
-#line 1354 ""
+#line 1357 ""
allparts_("-999", &c__4, (ftnlen)4);
-#line 1355 ""
+#line 1358 ""
} else if (*iread == 2) {
-#line 1356 ""
+#line 1359 ""
allparts_("1", &c__1, (ftnlen)1);
-#line 1357 ""
+#line 1360 ""
} else if (*iread == 3) {
-#line 1358 ""
+#line 1361 ""
allparts_("-998", &c__4, (ftnlen)4);
-#line 1359 ""
+#line 1362 ""
} else if (*iread == 4) {
-#line 1360 ""
+#line 1363 ""
allparts_("20", &c__2, (ftnlen)2);
-#line 1361 ""
+#line 1364 ""
} else if (*iread == 5) {
-#line 1362 ""
+#line 1365 ""
allparts_(".05", &c__3, (ftnlen)3);
-#line 1363 ""
+#line 1366 ""
} else if (*iread != -1) {
-#line 1364 ""
+#line 1367 ""
s_wsle(&io___187);
-#line 1364 ""
+#line 1367 ""
do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26);
-#line 1364 ""
+#line 1367 ""
e_wsle();
-#line 1365 ""
+#line 1368 ""
s_stop("", (ftnlen)0);
-#line 1366 ""
+#line 1369 ""
}
-#line 1367 ""
+#line 1370 ""
}
-#line 1368 ""
+#line 1371 ""
return ret_val;
} /* readin_ */
@@ -3710,217 +3716,217 @@ L5:
/* Assume that line has just been read. No need to change iccount since we only */
/* process full lines. */
-#line 1380 ""
+#line 1383 ""
*goto999 = FALSE_;
-#line 1381 ""
+#line 1384 ""
L1:
-#line 1381 ""
+#line 1384 ""
if (*(unsigned char *)line != '%') {
-#line 1381 ""
+#line 1384 ""
return 0;
-#line 1381 ""
+#line 1384 ""
}
/* If here, line has some sort of comment */
-#line 1385 ""
+#line 1388 ""
if (*(unsigned char *)&line[1] == '%') {
-#line 1386 ""
+#line 1389 ""
if (! all_1.insetup) {
/* Suck up a line, then flow out of "if" block to get another and loop */
-#line 1390 ""
+#line 1393 ""
s_rsfe(&io___188);
-#line 1390 ""
+#line 1393 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1390 ""
+#line 1393 ""
e_rsfe();
/* ++VV */
/* UNLESS (a) it has a score-only "M" and changes # of inst's. */
-#line 1396 ""
+#line 1399 ""
if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) {
-#line 1397 ""
+#line 1400 ""
idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1);
-#line 1398 ""
+#line 1401 ""
idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1);
-#line 1399 ""
+#line 1402 ""
idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1);
-#line 1400 ""
+#line 1403 ""
idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1);
-#line 1401 ""
+#line 1404 ""
if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb))
{
-#line 1403 ""
+#line 1406 ""
i__1 = idxn;
-#line 1403 ""
+#line 1406 ""
all_1.noinow = *(unsigned char *)&line[i__1] - 48;
-#line 1404 ""
+#line 1407 ""
clefpend = TRUE_;
/* Next noinow digits are original inst. #'s of new inst. set. Next noinow */
/* char's after that are clefs */
-#line 1409 ""
+#line 1412 ""
all_1.nvnow = 0;
-#line 1410 ""
+#line 1413 ""
i__1 = all_1.noinow;
-#line 1410 ""
+#line 1413 ""
for (j = 1; j <= i__1; ++j) {
-#line 1411 ""
+#line 1414 ""
i__2 = idxn + 1 + j - 1;
-#line 1411 ""
+#line 1414 ""
all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] -
48;
-#line 1412 ""
+#line 1415 ""
iposc0 = idxn + 1 + all_1.noinow;
-#line 1413 ""
+#line 1416 ""
i__2 = all_1.nvi[all_1.iorig[j - 1] - 1];
-#line 1413 ""
+#line 1416 ""
for (k = 1; k <= i__2; ++k) {
-#line 1414 ""
+#line 1417 ""
++all_1.nvnow;
/* clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */
-#line 1416 ""
+#line 1419 ""
all_1.instnum[all_1.nvnow - 1] = j;
-#line 1417 ""
+#line 1420 ""
all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1;
-#line 1418 ""
+#line 1421 ""
/* L25: */
-#line 1418 ""
+#line 1421 ""
}
-#line 1419 ""
+#line 1422 ""
/* L24: */
-#line 1419 ""
+#line 1422 ""
}
-#line 1420 ""
+#line 1423 ""
}
-#line 1421 ""
+#line 1424 ""
}
/* or if it's "h" or "l", need to suck up one more line */
-#line 1425 ""
+#line 1428 ""
if (*(unsigned char *)line == 'h' && i_indx("+- ", line + 1, (
ftnlen)3, (ftnlen)1) > 0 || *(unsigned char *)line == 'T'
|| s_cmp(line, "l ", (ftnlen)2, (ftnlen)2) == 0) {
-#line 1425 ""
+#line 1428 ""
s_rsfe(&io___197);
-#line 1425 ""
+#line 1428 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1425 ""
+#line 1428 ""
e_rsfe();
-#line 1425 ""
+#line 1428 ""
}
/* 4/29/00 check for T string also */
-#line 1431 ""
+#line 1434 ""
} else {
/* In setup mode. Set flag, flow out and do use following line */
-#line 1435 ""
+#line 1438 ""
all_1.replacing = TRUE_;
-#line 1436 ""
+#line 1439 ""
}
-#line 1437 ""
+#line 1440 ""
} else if (*(unsigned char *)&line[1] == '!') {
/* Copy to all parts */
-#line 1441 ""
+#line 1444 ""
allparts_(line + 2, &c__125, (ftnlen)126);
-#line 1442 ""
+#line 1445 ""
} else {
/* Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise */
/* c Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise */
-#line 1447 ""
+#line 1450 ""
ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, (
ftnlen)1);
/* Only treat as part-specific pmx line if number .le. noinst */
-#line 1451 ""
+#line 1454 ""
if (ivq < 1 || ivq > all_1.noinst) {
/* Simple comment. */
-#line 1455 ""
+#line 1458 ""
allparts_(line, &c__128, (ftnlen)128);
-#line 1456 ""
+#line 1459 ""
} else {
/* Instrument comment, copy only to part */
-#line 1460 ""
+#line 1463 ""
lenline = lenstr_(line, &c__128, (ftnlen)128);
-#line 1461 ""
+#line 1464 ""
if (lenline > 2) {
-#line 1462 ""
+#line 1465 ""
io___200.ciunit = ivq + 10;
-#line 1462 ""
+#line 1465 ""
s_wsfe(&io___200);
-#line 1462 ""
+#line 1465 ""
do_fio(&c__1, line + 2, lenline - 2);
-#line 1462 ""
+#line 1465 ""
e_wsfe();
-#line 1463 ""
+#line 1466 ""
} else {
/* Transferring blank line */
-#line 1467 ""
+#line 1470 ""
io___201.ciunit = ivq + 10;
-#line 1467 ""
+#line 1470 ""
s_wsfe(&io___201);
-#line 1467 ""
+#line 1470 ""
do_fio(&c__1, " ", (ftnlen)1);
-#line 1467 ""
+#line 1470 ""
e_wsfe();
-#line 1468 ""
+#line 1471 ""
}
-#line 1469 ""
+#line 1472 ""
}
-#line 1470 ""
+#line 1473 ""
}
-#line 1471 ""
+#line 1474 ""
i__1 = s_rsfe(&io___202);
-#line 1471 ""
+#line 1474 ""
if (i__1 != 0) {
-#line 1471 ""
+#line 1474 ""
goto L2;
-#line 1471 ""
+#line 1474 ""
}
-#line 1471 ""
+#line 1474 ""
i__1 = do_fio(&c__1, line, (ftnlen)128);
-#line 1471 ""
+#line 1474 ""
if (i__1 != 0) {
-#line 1471 ""
+#line 1474 ""
goto L2;
-#line 1471 ""
+#line 1474 ""
}
-#line 1471 ""
+#line 1474 ""
i__1 = e_rsfe();
-#line 1471 ""
+#line 1474 ""
if (i__1 != 0) {
-#line 1471 ""
+#line 1474 ""
goto L2;
-#line 1471 ""
+#line 1474 ""
}
-#line 1472 ""
+#line 1475 ""
zapbl_(line, &c__128, (ftnlen)128);
-#line 1473 ""
+#line 1476 ""
goto L1;
-#line 1474 ""
+#line 1477 ""
L2:
-#line 1475 ""
+#line 1478 ""
*goto999 = TRUE_;
-#line 1476 ""
+#line 1479 ""
return 0;
} /* chkcom_ */
@@ -3962,128 +3968,128 @@ L2:
/* iset(9) (npages) will be replaced with (nsyst-1)/12+1 */
/* iset(2), if negative, will be followed by extra numbers to be transf. */
-#line 1495 ""
+#line 1498 ""
iccount = 0;
-#line 1496 ""
+#line 1499 ""
for (iset = 1; iset <= 12; ++iset) {
-#line 1497 ""
+#line 1500 ""
partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
-#line 1498 ""
+#line 1501 ""
if (iset == 2) {
-#line 1499 ""
+#line 1502 ""
if (xdata > 0.f) {
-#line 1500 ""
+#line 1503 ""
s_wsfe(&io___206);
-#line 1500 ""
+#line 1503 ""
i__1 = (integer) (xdata + .1f);
-#line 1500 ""
+#line 1503 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1500 ""
+#line 1503 ""
e_wsfe();
-#line 1501 ""
+#line 1504 ""
} else {
-#line 1502 ""
+#line 1505 ""
noi = -xdata + .1f;
-#line 1503 ""
+#line 1506 ""
s_wsfe(&io___208);
-#line 1503 ""
+#line 1506 ""
do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer));
-#line 1503 ""
+#line 1506 ""
e_wsfe();
-#line 1504 ""
+#line 1507 ""
i__1 = noi;
-#line 1504 ""
+#line 1507 ""
for (ioi = 1; ioi <= i__1; ++ioi) {
-#line 1505 ""
+#line 1508 ""
partnum_(iv, &iccount, line, &xdata, (ftnlen)128);
-#line 1506 ""
+#line 1509 ""
s_wsfe(&io___210);
-#line 1506 ""
+#line 1509 ""
i__2 = (integer) (xdata + .1f);
-#line 1506 ""
+#line 1509 ""
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
-#line 1506 ""
+#line 1509 ""
e_wsfe();
-#line 1507 ""
+#line 1510 ""
/* L2: */
-#line 1507 ""
+#line 1510 ""
}
-#line 1508 ""
+#line 1511 ""
}
/* else if (iset.ne.8 .and. xdata.lt.0) then */
-#line 1510 ""
+#line 1513 ""
} else if (iset != 8 && iset != 5 && xdata < 0.f) {
/* Must be either nv or npages */
-#line 1514 ""
+#line 1517 ""
if ((integer) (-xdata + .1f) == 999) {
/* It's nv */
-#line 1518 ""
+#line 1521 ""
s_wsfe(&io___211);
-#line 1518 ""
+#line 1521 ""
do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof(
integer));
-#line 1518 ""
+#line 1521 ""
e_wsfe();
-#line 1519 ""
+#line 1522 ""
} else {
/* npages must be computed */
-#line 1523 ""
+#line 1526 ""
s_wsfe(&io___212);
-#line 1523 ""
+#line 1526 ""
i__1 = (all_1.nsyst - 1) / 12 + 1;
-#line 1523 ""
+#line 1526 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1523 ""
+#line 1526 ""
e_wsfe();
-#line 1524 ""
+#line 1527 ""
}
-#line 1525 ""
+#line 1528 ""
} else if (iset != 7 && iset != 12) {
/* write integer */
-#line 1529 ""
+#line 1532 ""
s_wsfe(&io___213);
-#line 1529 ""
+#line 1532 ""
i__1 = i_nint(&xdata);
-#line 1529 ""
+#line 1532 ""
do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer));
-#line 1529 ""
+#line 1532 ""
e_wsfe();
-#line 1530 ""
+#line 1533 ""
} else {
/* write floating number */
-#line 1534 ""
+#line 1537 ""
s_wsfe(&io___214);
-#line 1534 ""
+#line 1537 ""
do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real));
-#line 1534 ""
+#line 1537 ""
e_wsfe();
-#line 1535 ""
+#line 1538 ""
}
-#line 1536 ""
+#line 1539 ""
if (iset == 3) {
-#line 1537 ""
+#line 1540 ""
*mtrnum = i_nint(&xdata);
-#line 1538 ""
+#line 1541 ""
} else if (iset == 4) {
-#line 1539 ""
+#line 1542 ""
*mtrden = i_nint(&xdata);
-#line 1540 ""
+#line 1543 ""
}
-#line 1541 ""
+#line 1544 ""
/* L1: */
-#line 1541 ""
+#line 1544 ""
}
-#line 1542 ""
+#line 1545 ""
return 0;
} /* dosetup_ */
@@ -4121,131 +4127,131 @@ L2:
/* Simplified number parsing. Only looks for comment lines and numbers. */
-#line 1550 ""
+#line 1553 ""
L2:
-#line 1550 ""
+#line 1553 ""
if (*iccount == 128) {
-#line 1551 ""
+#line 1554 ""
io___215.ciunit = *iv + 10;
-#line 1551 ""
+#line 1554 ""
s_rsfe(&io___215);
-#line 1551 ""
+#line 1554 ""
do_fio(&c__1, line, (ftnlen)128);
-#line 1551 ""
+#line 1554 ""
e_rsfe();
-#line 1552 ""
+#line 1555 ""
if (*(unsigned char *)line == '%') {
-#line 1553 ""
+#line 1556 ""
len = lenstr_(line, &c__128, (ftnlen)128);
-#line 1554 ""
+#line 1557 ""
s_wsfe(&io___217);
-#line 1554 ""
+#line 1557 ""
do_fio(&c__1, line, len);
-#line 1554 ""
+#line 1557 ""
e_wsfe();
-#line 1555 ""
+#line 1558 ""
goto L2;
-#line 1556 ""
+#line 1559 ""
}
-#line 1557 ""
+#line 1560 ""
*iccount = 0;
-#line 1558 ""
+#line 1561 ""
}
-#line 1559 ""
+#line 1562 ""
++(*iccount);
/* Find next non-blank or end of line */
-#line 1563 ""
+#line 1566 ""
for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) {
-#line 1564 ""
+#line 1567 ""
if (*(unsigned char *)&line[*iccount - 1] != ' ') {
-#line 1564 ""
+#line 1567 ""
goto L3;
-#line 1564 ""
+#line 1567 ""
}
-#line 1565 ""
+#line 1568 ""
/* L4: */
-#line 1565 ""
+#line 1568 ""
}
/* If here, iccount=128 and need to get a new line */
-#line 1569 ""
+#line 1572 ""
goto L2;
-#line 1570 ""
+#line 1573 ""
L3:
/* iccount now points to start of number to read */
-#line 1574 ""
+#line 1577 ""
i1 = *iccount;
-#line 1575 ""
+#line 1578 ""
L5:
-#line 1575 ""
+#line 1578 ""
getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1);
/* Remember that getchar first increments iccount, *then* reads a character. */
-#line 1579 ""
+#line 1582 ""
if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) {
-#line 1579 ""
+#line 1582 ""
goto L5;
-#line 1579 ""
+#line 1582 ""
}
-#line 1580 ""
+#line 1583 ""
i2 = *iccount - 1;
-#line 1581 ""
+#line 1584 ""
if (i2 < i1) {
-#line 1582 ""
+#line 1585 ""
s_wsle(&io___221);
/* Writing concatenation */
-#line 1582 ""
+#line 1585 ""
i__1[0] = 7, a__1[0] = "Found \"";
-#line 1582 ""
+#line 1585 ""
i__1[1] = 1, a__1[1] = durq;
-#line 1582 ""
+#line 1585 ""
i__1[2] = 19, a__1[2] = "\" instead of number";
-#line 1582 ""
+#line 1585 ""
s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27);
-#line 1582 ""
+#line 1585 ""
do_lio(&c__9, &c__1, ch__1, (ftnlen)27);
-#line 1582 ""
+#line 1585 ""
e_wsle();
-#line 1583 ""
+#line 1586 ""
s_stop("1", (ftnlen)1);
-#line 1584 ""
+#line 1587 ""
}
-#line 1585 ""
+#line 1588 ""
icf = i2 - i1 + 49;
-#line 1586 ""
+#line 1589 ""
ici__1.icierr = 0;
-#line 1586 ""
+#line 1589 ""
ici__1.iciend = 0;
-#line 1586 ""
+#line 1589 ""
ici__1.icirnum = 1;
-#line 1586 ""
+#line 1589 ""
ici__1.icirlen = i2 - (i1 - 1);
-#line 1586 ""
+#line 1589 ""
ici__1.iciunit = line + (i1 - 1);
/* Writing concatenation */
-#line 1586 ""
+#line 1589 ""
i__1[0] = 2, a__1[0] = "(f";
-#line 1586 ""
+#line 1589 ""
*(unsigned char *)&ch__3[0] = icf;
-#line 1586 ""
+#line 1589 ""
i__1[1] = 1, a__1[1] = ch__3;
-#line 1586 ""
+#line 1589 ""
i__1[2] = 3, a__1[2] = ".0)";
-#line 1586 ""
+#line 1589 ""
ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2);
-#line 1586 ""
+#line 1589 ""
s_rsfi(&ici__1);
-#line 1586 ""
+#line 1589 ""
do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real));
-#line 1586 ""
+#line 1589 ""
e_rsfi();
-#line 1587 ""
+#line 1590 ""
return 0;
} /* partnum_ */
@@ -4261,40 +4267,40 @@ L5:
/* Local variables */
static integer i__;
-#line 1599 ""
+#line 1602 ""
i__1 = *len;
-#line 1599 ""
+#line 1602 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 1600 ""
+#line 1603 ""
if (*(unsigned char *)&string[i__ - 1] == ' ') {
-#line 1600 ""
+#line 1603 ""
goto L1;
-#line 1600 ""
+#line 1603 ""
}
-#line 1601 ""
+#line 1604 ""
if (i__ == 1) {
-#line 1601 ""
+#line 1604 ""
return 0;
-#line 1601 ""
+#line 1604 ""
}
-#line 1602 ""
+#line 1605 ""
goto L2;
-#line 1603 ""
+#line 1606 ""
L1:
-#line 1603 ""
+#line 1606 ""
;
-#line 1603 ""
+#line 1606 ""
}
/* If line is all blank, leave it alone */
-#line 1607 ""
+#line 1610 ""
return 0;
-#line 1608 ""
+#line 1611 ""
L2:
-#line 1609 ""
+#line 1612 ""
s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1));
-#line 1610 ""
+#line 1613 ""
return 0;
} /* zapbl_ */
@@ -4311,25 +4317,25 @@ L2:
/* This counts number of double quotes in lineq up to position indx-1, then */
/* sets yesodd according to whether number is odd or even */
-#line 1619 ""
+#line 1622 ""
numdqs = 0;
-#line 1620 ""
+#line 1623 ""
i__1 = *indx - 1;
-#line 1620 ""
+#line 1623 ""
for (i__ = 1; i__ <= i__1; ++i__) {
-#line 1621 ""
+#line 1624 ""
if (*(unsigned char *)&lineq[i__ - 1] == '"') {
-#line 1621 ""
+#line 1624 ""
++numdqs;
-#line 1621 ""
+#line 1624 ""
}
-#line 1622 ""
+#line 1625 ""
/* L1: */
-#line 1622 ""
+#line 1625 ""
}
-#line 1623 ""
+#line 1626 ""
*yesodd = numdqs % 2 == 1;
-#line 1624 ""
+#line 1627 ""
return 0;
} /* oddquotesbefore_ */
diff --git a/Build/source/utils/pmx/pmx-src/scor2prt.for b/Build/source/utils/pmx/pmx-src/scor2prt.for
index a88f634d383..35839bd8803 100644
--- a/Build/source/utils/pmx/pmx-src/scor2prt.for
+++ b/Build/source/utils/pmx/pmx-src/scor2prt.for
@@ -1,1630 +1,1633 @@
-cccccccccccccccccccccccccc
-cc
-cc scor2prt 2/19/16 for PMX 2.74
-cccccccccccccccccccccccccc
-c This program, developed by Don Simons (dsimons@roadrunner.com), is
-c part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert
-c with MusiXTeX and TeX, the purpose of PMX is to allow the user to create
-c high-quality typeset musical scores by including a sequence of PMX commands
-c in an ASCII input file. Scor2prt is an auxiliary program that creates PMX
-c input files for individual parts from the PMX input file for the score.
-c
-c This program is free software: you can redistribute it and/or modify
-c it under the terms of the GNU General Public License as published by
-c the Free Software Foundation, either version 3 of the License, or
-c (at your option) any later version.
-c
-c This program is distributed in the hope that it will be useful,
-c but WITHOUT ANY WARRANTY; without even the implied warranty of
-c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-c GNU General Public License for more details.
-c
-c You should have received a copy of the GNU General Public License
-c along with this program. If not, see <http://www.gnu.org/licenses/>.
-c
-c 2/19/16
-c Exit gracefully when last input line is comment, with mods in
-c subroutine chkcom, adding logical argument goto999
-c which is set to .true. in that case, causing input file to
-c be closed after exiting.
-c 4/9/12
-c Add logical declarations to subroutine dosetup
-c 8/8/11
-c Copy & mod Ki into parts when after beginning.
-c 7/18/11
-c Start to fix up for AS..., also Ki was done a little earlier.
-c 7/5/10
-c Modify Manual to explain extended hex numbering for part-specific comments
-c 5/16/10
-c Extend part-specific comments for up to 24 parts (subroutine chkcom)
-c Allow files 11-34 for parts
-c Change file 30 to 40
-c 6/1/08 es2p
-c noimax = 24
-c
-c To do
-c Override fracindent, musicsize?
-c Deal with midbar R?
-c 2/29/04
-c Check for special character being in quoted string.
-c 10/20/02 PMX 2.407
-c Interpret AN[n]"[used-defined-part-file-name]"
-c 1/21/02
-c Deals with rm in multiple parts.
-c s2p15
-c Get right non-tex index even if there's "\" inside D"..."
-c s2p14
-c 10/29/00 fix transfer to parts of negative mtrdnp
-c 4/29/00 screen for "%%" followed by "T"
-c Restore change from "Version 2.1a, 21 Dec"
-c s2p13
-c Allow whole-bar double-whole rests.
-c Bypass MIDI commands "I..." achar(10)="I"
-c s2p12
-c Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla
-c only taken as such if ? represents a hex digit .le. noinst, otherwise it's
-c a simple comment. This lessens incompatibility.
-c In subroutine mbrest, properly open parts 10-12 if needed
-c s2p11
-c Ignore leading blanks
-c Fix undefined linelength in mbrest at very end of comments.
-c s2p10
-c Fix non-transfer of P..c" "
-c Allow "%%" and "%"n anywhere
-c Version 1.43
-c Fix bug with P in TeX string.
-c Ignore shifted whole-bar rests when consolidating whole-bar rests
-c Copy type 4 TeX into all parts.
-c Deal with XB and XP.
-c Permit transfer of blank line into parts
-c Change staves/inst in 'M' command.
-c Arbitrary staves/inst.
-c Recognize m1/2/3/4 syntax.
-c Enable comment and one-voice syntax in instrument names
-c
-c Changes since 1.1
-c Deal with saved macros.
-c Revise setup readin, to admit comments.
-c Do not copy 'X' into parts
-c
-cccccccccccccccccccccccccccccccccccccccccccccccc
- parameter (noimax=24)
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- integer*4 ludpfn(noimax)
- character*1 sq,achar(10)
- character*2 termsym
- character*27 jobname,infileq
- character*128 instrum(noimax),udpfnq(noimax)
- character*128 line,holdln,templine
- logical termrpt,isachar,frstln,oneof2,botv,clefpend,fexist,
- * insetup,replacing,gotname,yesodd,goto999
- character*1 dumq
- data achar /'P','m','V','R','A','h','w','K','M','I'/
- clefpend = .false.
- insetup = .true.
- replacing = .false.
- frstln = .true.
- lenhold = 0
- sq = char(92)
- print*,'This is scor2prt for PMX 2.74, 19 February 2016'
- numargs = iargc()
- if (numargs .eq. 0) then
- print*,'You could have entered a jobname on the command line,'
- print*,' but you may enter one now:'
- read(*,'(a)')jobname
- numargs = 1
- else
-c call getarg(1,jobname,idum) ! May need to replace this w/ next line
- call getarg(1,jobname)
- end if
- ljob = lenstr(jobname,27)
- if (ljob .eq. 0) then
- print*,'No was jobname entered. Restart and try again.'
- stop
- end if
-c
-c Strip ".pmx" if necessary
-c
- ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
- if (ndxpmx .gt. 0) then
- jobname = jobname(1:ndxpmx-1)
- ljob = ljob-4
- end if
-c
-c Check for existence of input file
-c
- infileq = jobname(1:ljob)//'.pmx'
- inquire(file=infileq,EXIST=fexist)
- if (.not.fexist) then
- print*,'Cannot find file '//infileq
- stop
- end if
- open(10,file=jobname(1:ljob)//'.pmx')
-c
-c Open all instrument files now for allparts stuff. Later disgard those >nv
-c
- do 19 iv = 1 , noimax
- iorig(iv) = iv
- open(10+iv,status='SCRATCH')
- ludpfn(iv) = 0
-19 continue
- read(10,'(a)')line
- call chkcom(line,goto999)
- if (line(1:3) .eq. '---') then
- call allparts(line,128)
-31 read(10,'(a)')line
- if (line(1:3) .ne. '---') then
- call allparts(line,128)
- go to 31
- end if
- call allparts(line,128)
- read(10,'(a)')line
- call chkcom(line,goto999)
- end if
- iccount = 0
- nv = readin(line,iccount,1)+.1
- noinst = readin(line,iccount,2)+.1
- if (noinst .gt. 0) then
- nvi(1) = nv-noinst+1
- else
- noinst = 1-noinst
- do 21 iinst = 1 , noinst
- nvi(iinst) = readin(line,iccount,-1)+.1
-21 continue
- end if
- noinow = noinst
- insnow = 1
-c
-c ivlast is last iv in current inst. instnum(iv) is iinst for current voice.
-c
- ivlast = nvi(1)
- do 22 iv = 1 , nv
- instnum(iv) = insnow
- if (iv .eq. ivlast) then
- if (iv .lt. nv) botv(iv+1) = .true.
-c
-c The previous stmt will set botv true only for bot voice of iinst>1. It is
-c used when writing termrpts, but the one in voice one is handled differently,
-c so botv(1) is left .false.
-c
- if (insnow .lt. noinst) then
- insnow = insnow+1
- ivlast = ivlast+nvi(insnow)
- end if
- end if
-22 continue
- mtrnuml = readin(line,iccount,0)+.1
- mtrdenl = readin(line,iccount,0)+.1
- mtrnmp = readin(line,iccount,0)+.1
- mtrdnp = readin(line,iccount,0)+.1
- xmtrnum0 = readin(line,iccount,0)
- isig = readin(line,iccount,0)+.1
- npages = readin(line,iccount,3)+.1
- nsyst = readin(line,iccount,0)+.1
- musicsize = readin(line,iccount,4)+.1
- fracindent = readin(line,iccount,5)
- if (npages .eq. 0) then
- print*,
- *'You entered npages=0, which means nsyst is not the total number'
- print*,
- *'of systems. Scor2prt has to know the total number of systems.'
- print*,
- *'Please set npages and nsyst to their real values.'
- stop
- end if
-c
-c Must leave insetup=.true. else could bypass ALL instrument names.
-c
- read(10,'(a)')line
- call chkcom(line,goto999)
- backspace(10)
-c
-c Normally this puts pointer at start of line with 1st inst name
-c Check if prior line was "%%"
-c
- backspace(10)
- read(10,'(a)')line
- if (line(1:2) .eq. '%%') backspace(10)
- do 14 iv = 1 , noinst
- gotname = .false.
-16 read(10,'(a)') instrum(iv)
- if (instrum(iv)(1:2) .eq. '%%') then
- read(10,'(a)')line
- go to 16
- else if (instrum(iv)(1:1) .eq. '%') then
- ivq = ichar(instrum(iv)(2:2))-48
- if (ivq.ne.iv) then
-c
-c It's really a comment. Copy to parts, then get another trial name.
-c
- call allparts(instrum(iv),128)
- go to 16
- else
- line = instrum(iv)(3:)
- instrum(iv) = line
- gotname = .true.
- end if
- else
- gotname = .true.
- end if
-cc
-cc The following checks for macro that write original C-clef as part of
-cc instrument name. See pmx.tex
-cc
-c if (index(instrum(iv),'namewpc') .eq. 0) then
-c write(10+iv,'(a)')' '
-c else
-c inm1 = index(instrum(iv),'{')+1
-c inm2 = index(instrum(iv),'}')-1
-c read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2
-c write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'//
-c * char(iy1+49)//char(iy2+49)
-c instrum(iv) = instrum(iv)(inm1:inm2)
-c end if
- if (.not.gotname) then
- print*,'You must provide a replacement instrument name'
- stop
- end if
- write(10+iv,'(a)')' '
-14 continue
- replacing = .false.
- nvnow = nv
-c
-c Clef string: Note insetup is still T, so "%%" will be treated specially
-c
- read(10,'(a)')line
- call chkcom(line,goto999)
- if (replacing) then
-c
-c If here, we have next line after "%%", containing score's clef string
-c Assume all clefs are handled with instrument comments.
-c
- read(10,'(a)')line
- call chkcom(line,goto999)
- backspace(10)
- else
-c
-c If here, line has the clef string in it. Handle the old way
-c
- kvstart = 1
- kvend = nvi(1)
- do 2 inst = 1 , noinst
- write(10+inst,'(a'//char(48+nvi(inst))//')')
- * line(kvstart:kvend)
- if (inst .lt. noinst) then
- kvstart = kvend+1
- kvend = kvstart+nvi(inst+1)-1
- end if
-2 continue
- end if
- replacing = .false.
- insetup = .false.
-c
-c *****NOTE*****This comment applies to stuff done earlier!
-c Before starting the big loop, copy initial instnum and staffnum stuff
-c into working values. Latter may change if noinst changes. Also make
-c list of current inst nums relative to original ones. In addition to those
-c below, must redo instnum(iv) and botv(iv) when we change noinst.
-c
-c Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS!
-c
-18 read(10,'(a)') line
- if (line(1:1) .eq. '%') then
- call allparts(line,128)
- go to 18
- end if
- call allparts(line,128)
-c
-c Write instrument names. Will be blank if later part of a score.
-c
- if (instrum(1)(1:1) .ne. ' ') then
- do 3 iv = 1 , noinst
- len = lenstr(instrum(iv),79)
- write(10+iv,'(a2/a)')'Ti',instrum(iv)(1:len)
-3 continue
- end if
-c
-c The big loop. Except for '%%', put all comment lines in all parts.
-c Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts
-c If a line starts with %!, put the rest of it in each part.
-c If a line starts with %[n], put the rest of it in part [n].
-c Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes.
-c Assume they only come at top of block, except terminal repeat needs
-c special handling.
-c Check for "P"; ignore in parts.
-c Check for consecutive full-bar rests; if found, replace with rm[nn]
-c
- iv = 1
- iinst = 1
- termrpt = .false.
-4 continue
- read(10,'(a)',end=999)line
- lenline = lenstr(line,128)
- if (lenline .eq. 0) go to 4
- call zapbl(line,128)
- call chkcom(line,goto999)
- if (goto999) go to 999
- lenline = lenstr(line,128)
- if (lenline .eq. 0) go to 4
- if (line(1:1) .eq. 'T') then
- call allparts(line,128)
- read(10,'(a)')line
- call allparts(line,128)
- go to 4
- else if (line(1:2) .eq. sq//sq) then
- call allparts(line,128)
- go to 4
- else if (index('hl',line(1:1)).gt.0 .and.
- * index(' +-',line(2:2)) .gt. 0) then
- call allparts(line,128)
- read(10,'(a)')line
- call allparts(line,128)
- go to 4
- else if (iv .eq. 1) then
- do 5 ia = 1 , 10
-24 continue
- idxa = ntindex(line,achar(ia))
- isachar = idxa .gt. 0
- if (idxa.gt.1) isachar = line(idxa-1:idxa-1).eq.' '
-c
-c 1 2 3 4 5 6 7 8 9 10
-c data achar /'P','m','V','R','A','h','w','K','M','I'/
-c
- if (ia .eq. 9) isachar =
- * isachar .and. line(idxa+1:idxa+1).eq.'S'
- if (isachar) then
-c
-c Check whether character is inside a quoted string by counting
-c how many quotes precede it in the line
-c
-
- call OddQuotesBefore(line,idxa,yesodd)
- if (yesodd) isachar=.false.
- end if
- if (isachar) then
-c
-c Find next blank
-c
- do 6 ib = idxa+1 , 128
- if (line(ib:ib) .eq. ' ') go to 7
-6 continue
- print*,'Problem with "V,R,m,P,A,h,MS, or w"'
- print*,
- * 'Send files to Dr. Don at dsimons at roadrunner dot com'
- stop 1
-7 continue
-c
-c Next blank is at position ib. Later, if ia=1, must check for Pc" " ;
-c i.e., look for '"' between P and blank
-c
- if (ia .eq. 4) then
-c
-c Check for terminal repeat. Note if there's a term rpt, there can't be any
-c others. Also, must process repeats LAST, after m's and 'V's
-c
- do 8 ic = ib+1 , 128
-c
-c If any subsequent character on this line is neither blank nor "/", get out
-c
- if (index(' /',line(ic:ic)) .eq. 0) go to 9
- if (line(ic:ic) .eq. '/') then
- termrpt = .true.
- termsym = line(ib-2:ib-1)
-c
-c Process the line as if there were no "R"
-c
- go to 10
- end if
-8 continue
-c
-c +++ 060812
-c If here, all chars after "R" symbol are blanks, so process the line normally,
-c but only IF next line is not the M-Tx line " /"
-c
- read(10,'(a)')templine
- if (templine(1:2) .ne. ' /') then
- backspace(10) ! and flow out
- else
-c
-c We have the M-Tx case where one line ends with R? and next is " /". Add / to the line,
-c and proceed as above
-c
- line = line(1:ib)//'/'
- lenline = lenline+2
- termrpt = .true.
- termsym = line(ib-2:ib-1)
- go to 10
- end if
-c +++ 060812
-c
- else if (ia .eq. 1) then
- idxq = ntindex(line,'"')
- if (idxq.gt.idxa .and. idxq.lt.ib) then
-c
-c Quote is between P and next blank. Find 2nd quote, starting at the blank.
-c
- idxq2 = ib-1+ntindex(line,'"')
- if (idxq.eq.0 .or. line(idxq2+1:idxq2+1).ne.' ') then
- print*
- print*,'Error copying P with quotes, idxq2:',idxq2
- print*,line(1:60)
- stop 1
- end if
- ib = idxq2+1
- end if
-c
-c Do not transfer P into parts.
-c
- go to 12
- else if (ia .eq. 9) then
-c
-c Start Saving a macro. After leaving here, a symbol will be sent to all parts,
-c If all on this line, set ib to end and exit normally.
-c
- ndxm = index(line(ib+1:128),'M')
- if (ndxm.gt.0 .and. line(ib+ndxm-1:ib+ndxm-1).eq.' ') then
-c
-c Macro ends on this line
-c
- ib = ib+ndxm+1
- else
-c
-c Save leading part of current line
-c
- lenhold = idxa-1
- if (lenhold .gt. 0) holdln = line(1:lenhold)
-c
-c Transfer rest of line
-c
- call allparts(line(idxa:128),129-idxa)
-c
-c Read next line
-c
-20 read(10,'(a)')line
-c
-c Check for comment, transfer and loop if so
-c
-c if (line(1:1) .eq.'%') then
-23 if (line(1:1) .eq.'%') then
-c call allparts(line,128)
-c go to 20
- call chkcom(line,goto999)
- go to 23
- end if
-c
-c Look for terminal ' M'
-c
- if (line(1:1) .eq. 'M') then
- ndxm = 1
- else
- ndxm = index(line,' M')
- if (ndxm .gt. 0) ndxm = ndxm+1
- end if
- if (ndxm .gt. 0) then
-c
-c Set parameters, exit normally (but later check for leading part of 1st line
-c
- idxa = 1
- ib = ndxm+1
- else
-c
-c No "M", transfer entire line, loop
-c
- call allparts(line,128)
- go to 20
- end if
- end if
- else if (ia .eq. 10) then
-c
-c Do not transfer MIDI command into parts
-c
- go to 12
- else if (ia .eq. 5) then
-c
-c First check for "AS", but S may come after other "A" options
-c
- idxS = index(line(idxa+1:ib),'S')
- if (idxS .gt. 0) then
-c
-c Get rid of the string. First check if that's all there is in A.
-c
- if (ib-idxa .eq. nv+2) go to 12
- line = line(1:idxa+idxS-1)//line(idxa+idxS+nv+1:ib)
- end if
-c
-c Check for user-defined part file name. Must start in column 1 and have
-c AN[n]"userfilename".
-c idxa is position of "A"
-c ib is position of the next blank after "A"
-c Don't allow any blanks in user
-c
- if (line(idxa+1:idxa+1) .ne. 'N') go to 9 ! bail out
- if (idxa .ne. 1) then
- print*
- print*,
- * 'You entered "AN..." somewhere beyond first column; stopping.'
- stop 1
- end if
-c
-c pmxa already checked for valid one- or 2-digit number, so get it
-c
- if (line(4:4) .eq. '"') then
-c
-c Single digit instrument number
-c
- read(line(3:3),'(i1)')iudpfn
- idxstartname = 5
- else
- read(line(3:4),'(i2)')iudpfn
- idxstartname = 6
- end if
- ludpfn(iudpfn) = index(line(idxstartname:128),'"')-1
- if (ludpfn(iudpfn) .lt. 0) then
- print*
- print*,'User-defined part file name must be in quotes'
- stop 1
- end if
- idxendname = idxstartname+ludpfn(iudpfn)-1
- udpfnq(iudpfn) = line(idxstartname:idxendname)
-c
-c Get a new line!
-c
- go to 4
- else if (ia .eq. 8) then
-c
-c Key change/transposition.
-c If not instrument specific, copy to all parts
-c
- if (line(idxa+1:idxa+1).ne.'i') go to 9
-c
-c Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]...
-c
- ibb = idxa+2 ! Starts on digit after 'i'
-40 continue
- read(line(ibb:ibb),'(i1)')iiinst ! 1st digit of iinst
- itemp = (index('01234567890',line(ibb+1:ibb+1)))
- if (itemp.gt.0) then
- ibb = ibb+1
- iiinst = 10*iiinst+itemp-1
- end if
- ibb = ibb+1 ! now at first +/-. Need end of 2nd number
- itemp = index(line(ibb+1:ib),'i') ! Rel pos'n of next 'i' or 0
- if (itemp .gt. 0) then
- iend = ibb+itemp-1
- else
- iend = ib-1
- end if
- write(10+iorig(iiinst),'(a)')'Ki1'//line(ibb:iend)
- if (itemp .gt. 0) then
- ibb = iend+2
- go to 40
- end if
- go to 12 ! Remove K command from string, go to next ia
- end if
-9 continue
- call allparts(line(idxa:ib-1),ib-idxa)
-12 continue
-c
-c Remove the string from line
-c
- if (idxa .eq. 1) then
- line = line(ib:128)
- else
- line = line(1:idxa-1)//line(ib:128)
- end if
- lenline = lenstr(line,128)
-c
-c Loop if only blanks are left
-c
- if (lenline .eq. 0) go to 4
-c
-c Must check for multiple "I" commands, so go to just after start of ia loop
-c
- if (ia .eq. 10) go to 24
-c
-c Tack on front part from 1st line of saved macro
-c
- if (lenhold .gt. 0) then
- line = holdln(1:lenhold)//' '//line(1:lenline)
- lenhold = 0
- end if
- end if
-5 continue
- end if
-c
-c Now a special loop to deal with 'X'. If it was %[n]X..., will have been
-c copied into part [n] already. If no "B" or "P", remove. If "P", just
-c remove the "P" so pmxa/b will process. If "B". do nothing.
-c
-10 continue
- nchk = 1
-13 ntinx = nchk-1+ntindex(line(nchk:),'X')
- if (ntinx .gt. nchk-1) then
-c
-c There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank.
-c
- if (ntinx.gt.1) then
- if (line(ntinx-1:ntinx-1).ne.' ') then
-c
-c The X is not 1st char of PMX command. Advance starting point, loop.
-c
- nchk = ntinx+1
- go to 13
- end if
- end if
-c
-c We now know the X at ntinx starts a PMX command. Find next blank
-c
- ib = ntinx+index(line(ntinx+1:),' ')
-c
-c There must be a blank to right of "X", so ib>ntinx
-c
-c locp = nchk-1+index(line(nchk:ib),'P')
- locp = ntinx+index(line(ntinx+1:ib),'P')
-c
-c Did not need to use ntindex because we already know bounds of PMX command.
-c
-c if (locp .gt. nchk-1) then
- if (locp .gt. ntinx) then
-c
-c Strip out the 'P'
-c
- templine = line(1:locp-1)
- line = templine(1:locp-1)//line(locp+1:lenline)
- lenline = lenline-1
- ib = ib-1
- end if
- if (index(line(ntinx:ib),':').gt.0 .or.
- * index(line(ntinx:ib),'S').gt.0 .or.
- * index(line(ntinx:ib),'B').gt.0 .or. locp.gt.ntinx) then
-c
-c The X command is a shift, "Both", or "Part". Do not remove.
-c
- nchk = ib+1
- go to 13
- end if
-c
-c Remove the X command.
-c
- if (ntinx .eq. 1) then
- if (ib .lt. lenline) then
- line = line(ib+1:lenline)
- else
-c
-c line contains ONLY the "X" command, so get a new line
-c
- go to 4
- end if
- else
- templine = line(1:ntinx-1)
- if (ib .lt. lenline) then
- line = templine(1:ntinx-1)//line(ib+1:lenline)
- else
- line = templine(1:ntinx-1)
- end if
- end if
-c
-c Recompute lenline
-c
- lenline = lenstr(line,128)
-c
-c Resume checking after location of removed command.
-c
- nchk = ntinx
- go to 13
- end if
-c
-c End of loop for X-checks
-c
- oneof2 = ntindex(line,'//') .gt. 0
- if (termrpt .and. botv(iv) .and. frstln .and.
- * line(lenline:lenline).eq.'/') then
-c
-c Must add a terminal repeat before the slash
-c
- if (oneof2) lenline = lenline-1
- if (lenline.gt.1) write(10+iorig(iinst),'(a)')line(1:lenline-1)
- if (.not. oneof2) then
- line = termsym//' /'
- lenline = 4
- else
- line = termsym//' //'
- lenline = 5
- end if
- end if
- if (termrpt .and. frstln .and. line(lenline:lenline).eq.'/' .and.
- * iv.eq.nvnow) termrpt = .false.
- write(10+iorig(iinst),'(a)')line(1:lenline)
- if (oneof2) then
- frstln = .false.
- else if (.not.frstln) then
- frstln = .true.
- end if
-c if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then
- if (ntindex(line,'/').gt.0 .and. ntindex(line,'//').eq.0) then
- iv = 1+mod(iv,nvnow)
- iinst = instnum(iv)
- end if
- go to 4
-999 continue
- close(10)
-c
-c In the mbrest checks, must run through ALL noinst files (not just noinow)
-c
- do 11 iinst = 1 , noinst
-ccc+++
-cc
-cc Temporarily transfer entire scratch file to real file
-cc
-c rewind(10+iinst)
-c open(40,file='s2pout'//char(48+iinst)//'.pmx')
-c do 50 m = 1 , 10000
-c read(10+iinst,'(a)',end=51)line
-c lenline = lenstr(line,128)
-c if (lenline .ge. 1) then
-c write(40,'(a)')line(1:lenline)
-c else
-c write(40,'(a)')' '
-c end if
-c50 continue
-c51 continue
-c close(40)
-ccc+++
- if (nvi(iinst) .eq. 1) then
- call mbrests(iinst,jobname,ljob,ludpfn(iinst),udpfnq(iinst))
- else
-c
-c Send a signal with ljob to bypass most mbrest processing
-c
- call mbrests(iinst,jobname,-ljob,ludpfn(iinst),udpfnq(iinst))
- end if
-11 continue
- end
- function lenstr(string,n)
- character*(*) string
- do 1 lenstr = n , 1 , -1
- if (string(lenstr:lenstr) .ne. ' ') return
-1 continue
- lenstr = 0
- return
- end
- subroutine allparts(string,n)
- parameter (noimax=24)
- character*(*) string
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- logical insetup,replacing,botv
- len = lenstr(string,n)
- if (len .eq. 0) then
- len = 1
- string = ' '
- end if
- do 1 iinst = 1 , noinow
- write(10+iorig(iinst),'(a)')string(1:len)
-1 continue
- return
- end
- subroutine mbrests(iv,jobname,ljob,ludpfn,udpfnq)
- character*128 line(50),line1,udpfnq
- character*80 sym
- character*12 jobname
- character*3 wbrsym(2)
- character*2 partq
- character*1 sq
- logical wbrest,alldone,rpfirst,newmtr,type4
- type4 = .false.
- sq = char(92)
- alldone = .false.
- rewind(10+iv)
- if (iv .lt. 10) then
- partq(1:1) = char(48+iv)
- lpart = 1
- else
- lpart = 2
- if (iv .lt. 20) then
- partq = '1'//char(38+iv)
- else
- partq = '2'//char(28+iv)
- end if
- end if
-c 130327
-c open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx')
- if (ludpfn .eq. 0) then
- open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx')
- else
- open(40,file=udpfnq(1:ludpfn)//'.pmx')
- end if
- do 10 i = 1 , 10000
- read(10+iv,'(a)')line(1)
- if (line(1)(1:1).eq.'%' .or. line(1)(1:3).eq.'---'
- * .or. type4) then
- len = lenstr(line(1),128)
- if (len .gt. 0) then
- write(40,'(a)')line(1)(1:len)
- else
- write(40,'(a)')' '
- end if
- if (line(1)(1:3).eq.'---') type4 = .not.type4
- else
- go to 11
- end if
-10 continue
- print*,'You should not be here in scor2prt. Call Dr. Don'
- stop
-11 continue
-c
-c Finished reading opening type4 TeX and comments. Next line to be read
-c will contain the first of the input numbers
-c
- call dosetup(iv,line(1),mtrnum,mtrden)
- do 1 i = 1 , 10000
-13 read(10+iv,'(a)',end=999)line(1)
-7 len = lenstr(line(1),128)
-c
-c Pass-through (and copy into part file) if instrumnet has >1 voice.
-c
- if (ljob .lt. 0) go to 2
- if (index('TtTiTch+h-h l ',line(1)(1:2)) .gt. 0) then
-c
-c Traps titles, instruments, composers, headers, lower strings. Read 2 lines.
-c
- write(40,'(a)')line(1)(1:len)
- read(10+iv,'(a)')line(1)
- len = lenstr(line(1),128)
- go to 2
- end if
- if (i.eq.1 .or. (i.gt.5.and.line(1)(1:1).eq.'m')) then
-c
-c Either just starting, or a new meter is defined.
-c NOTE! The above test may be bogus.
-c
- if (line(1)(1:1) .eq. '%') then
- write(40,'(a)')line(1)(1:len)
- go to 13
- end if
- if (i .ne. 1) then
-c
-c New meter. Check for slashes (new meter change syntax)
-c
- idxs = index(line(1),'/')
- idxb = index(line(1),' ')
- newmtr = idxs.gt.0 .and. (idxb.eq.0 .or. idxs.lt.idxb)
- if (.not.newmtr) then
-c
-c Old way, no slashes, uses 'o' for lonesome '1'
-c
- icden = 3
- if (line(1)(2:2) .eq. 'o') then
- mtrnum = 1
- else
- mtrnum = ichar(line(1)(2:2))-48
- if (mtrnum .eq. 1) then
- icden = 4
- mtrnum = 10+ichar(line(1)(3:3))-48
- end if
- end if
- mtrden = ichar(line(1)(icden:icden))-48
- else
-c
-c New way with slashes: idxs is index of 1st slash!
-c
- read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum
- idxb = index(line(1)(idxs+1:),'/')
- read(line(1)(idxs+1:idxs+idxb-1),
- * '(i'//char(48+idxb-1)//')')mtrden
- end if
- end if
- lenbeat = ifnodur(mtrden,'x')
- lenmult = 1
- if (mtrden .eq. 2) then
- lenbeat = 16
- lenmult = 2
- end if
- lenbar = lenmult*mtrnum*lenbeat
- call fwbrsym(lenbar,nwbrs,wbrsym,lwbrs)
- end if
-c
-c Finished setting up meter stuff and defining whole-bar rest symbols
-c
- ip1 = 0
- line1 = line(1)
- do 3 iw = 0 , nwbrs
- if (iw .gt. 0) then
- idx = ntindex(line1,wbrsym(iw)(1:lwbrs))
- if (idx .gt. 0) then
-c
-c Check for blank or shifted rest, discount it if it's there
-c
- if (line1(idx+lwbrs:idx+lwbrs).ne.' ') idx = 0
- end if
- else
- idx = ntindex(line1,'rp')
-c
-c Check for raised rest
-c
- if (idx.gt.0) then
- if (line1(idx+2:idx+2).ne.' ') idx = 0
- end if
- end if
- if (idx .gt. 0) then
- if (ip1 .eq. 0) then
- ip1 = idx
- else
- ip1 = min(ip1,idx) ! Maybe allows e.g. r0 rp ...
- end if
- end if
-3 continue
- if (i.lt.5 .or. line(1)(1:1).eq.'%' .or. line(1)(1:2).eq.sq//sq
- * .or. ip1.eq.0) go to 2
-c
-c Switch to multibar rest search mode!!! Start forward in line(1)
-c
- rpfirst = line1(ip1:ip1+1) .eq. 'rp'
- iline = 1
- nmbr = 1
- if (rpfirst) then
- lwbrsx = 2
- else
- lwbrsx = lwbrs
- end if
- ipe = ip1+lwbrsx-1 ! ip at end of 1st wbrsym
-4 if (ipe .eq. len) then
-c
-c Need a new line
-c
- iline = iline+1
-6 read(10+iv,'(a)',end=998)line(iline)
- len = lenstr(line(iline),128)
- if (line(iline)(1:1).eq.'%' ) then
- write(40,'(a)')'% Following comment has been moved forward'
- write(40,'(a)')line(iline)(1:len)
- go to 6
- end if
- ipe = 0
- go to 4
-998 continue
-c
-c No more input left
-c
- print*,'All done!'
- alldone = .true.
- ipe = 0
- iline = iline-1
- len = lenstr(line(iline),128)
- go to 4
- else
- if (alldone) then
- sym(1:1) = ' '
- else
-c
-c ipe<len here, so it's ok to get a symbol
-c
- call nextsym(line(iline),len,ipe,ipenew,sym,lsym)
- end if
-c
-c Check for end of block or bar line symbol
-c
- if (index('/|',sym(1:1)) .gt. 0) then
- ipe = ipenew
- go to 4
- else
- wbrest = .false.
- if (alldone) go to 12
- do 5 iw = 1 , nwbrs
- wbrest = wbrest .or. sym(1:lsym).eq.wbrsym(iw)(1:lwbrs)
-5 continue
- wbrest = wbrest .or. (sym(1:lsym).eq.'r'.and.lwbrs.eq.2)
- * .or. (sym(1:lsym).eq.'rd'.and.lwbrs.eq.3)
- * .or. (sym(1:lsym).eq.'rp')
- * .or. (sym(1:lsym).eq.'r' .and. rpfirst)
-12 if (wbrest) then
- ipe = ipenew
- nmbr = nmbr+1
- go to 4
- else
-c
-c AHA! Failed prev. test, so last symbol was *not* mbr.
-c It must be saved, and its starting position is ipenew-lsym+1
-c
- if (nmbr .gt. 1) then
-c
-c Write stuff up to start of mbr
-c
- if (ip1 .gt. 1) write(40,'(a)')line(1)(1:ip1-1)
-c
-c Insert mbr symbol. Always end with a slash just in case next sym must be
-c at start of block. May think this causes undefined octaves, but
-c probably not since it's a single voice.
-c
- ndig = int(alog10(nmbr+.01))+1
- print*,'Inserting rm, iv,nmbr:',iv,nmbr
- write(40,'(a2,i'//char(48+ndig)//',a2)')'rm',nmbr,' /'
- if (alldone) go to 999
- ipc = ipenew-lsym+1
- line(1) = line(iline)(ipc:len)
- else
-c
-c Write old stuff up to end of original lonesome wbr, save the rest.
-c 4 cases: (wbr /) , (wbr line-end) , (wbr followed by other non-/ symbols) ,
-c alldone.
-c In 1st 2 will have gotten some other lines, so write all up to one b4 last
-c non-comment line; then revert to normal mode on that. In 3rd case must
-c split line.
-c
- if (alldone) then
- write(40,'(a)')line(1)(1:len)
- go to 999
- else if (iline .gt. 1) then
- do 9 il = 1 , iline-1
- len = lenstr(line(il),128)
- write(40,'(a)')line(il)(1:len)
-9 continue
- line(1) = line(iline)
- else
-c
-c Since iline = 1 the wbr is not the last sym, so must split
-c
- write(40,'(a)')line(1)(1:ip1+lwbrsx-1)
- line(1) = line(1)(ip1+lwbrsx+1:len)
- end if
- end if
-c
-c Exit multibar mode
-c
- go to 7
- end if
- end if
- end if
-2 continue
- if (len .gt. 0) then
- write(40,'(a)')line(1)(1:len)
- else
- write(40,'(a)')' '
- end if
-1 continue
-999 continue
- close(10+iv)
- close(40)
- return
- end
- function ifnodur(idur,dotq)
- character*1 dotq
- if (idur .eq. 6) then
- ifnodur=1
- else if (idur .eq. 3) then
- ifnodur=2
- else if (idur.eq.1 .or. idur.eq.16) then
- ifnodur=4
- else if (idur .eq. 8) then
- ifnodur=8
- else if (idur .eq. 4) then
- ifnodur=16
- else if (idur .eq. 2) then
- ifnodur=32
- else if (idur .eq. 0) then
- ifnodur=64
- else
- print*,'You entered an invalid note-length value'
- stop
- end if
- if (dotq .eq. 'd') ifnodur = ifnodur*3/2
- return
- end
- subroutine fwbrsym(lenbar,nwbrs,wbrsym,lwbrs)
- character*3 wbrsym(2)
- nwbrs = 1
- lwbrs = 2
- if (lenbar .eq. 16) then
- wbrsym(1) = 'r4'
- else if (lenbar .eq. 32) then
- wbrsym(1) = 'r2'
- else if (lenbar .eq. 64) then
- wbrsym(1) = 'r0'
- else if (lenbar .eq. 8) then
- wbrsym(1) = 'r8'
- else if (lenbar .eq. 128) then
- wbrsym(1) = 'r9'
- else
- nwbrs = 2
- lwbrs = 3
- if (lenbar .eq. 24) then
- wbrsym(1) = 'rd4'
- wbrsym(2) = 'r4d'
- else if (lenbar .eq. 48) then
- wbrsym(1) = 'rd2'
- wbrsym(2) = 'r2d'
- else if (lenbar .eq. 96) then
- wbrsym(1) = 'rd0'
- wbrsym(2) = 'r0d'
- else
- write(*,'(33H Any whole-bar rests of duration ,i3,
- * 26H/64 will not be recognized)') lenbar
- end if
- end if
- return
- end
- subroutine nextsym(line,len,ipeold,ipenew,sym,lsym)
-c
-c Know its the last symbol if on return ipenew = len!. So should never
-c be called when ipstart=len.
-c
- character*128 line
- character*80 sym
- if (ipeold .ge. len) then
- print*,'Called nextsym with ipstart>=len '
- print*,'Send files to Dr. Don at dsimons@logicon.com'
- stop
- end if
- do 1 ip = ipeold+1 , len
- if (line(ip:ip) .ne. ' ') then
-c
-c symbol starts here (ip). We're committed to exit the loop.
-c
- if (ip .lt. len) then
- do 2 iip = ip+1 , len
- if (line(iip:iip) .ne. ' ') go to 2
-c
-c iip is the space after the symbol
-c
- ipenew = iip-1
- lsym = ipenew-ip+1
- sym = line(ip:ipenew)
- return
-2 continue
-c
-c Have len>=2 and ends on len
-c
- ipenew = len
- lsym = ipenew-ip+1
- sym = line(ip:ipenew)
- return
- else
-c
-c ip = len
-c
- ipenew = len
- lsym = 1
- sym = line(ip:ip)
- return
- end if
- end if
-1 continue
- print*,'Error #3. Send files to Dr. Don at dsimons@logicon.com'
- end
- function ntindex(line,s2q)
-c
-c Returns index(line,s2q) if NOT in TeX string, 0 otherwise
-c
- character*(*) s2q
- character*128 line,tline
- logical intex
-c
-c print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below'
-c print*,line(1:79)
-c
-c
-c Use a temporary string to store the input and test, so can zap D"..."
-c
- tline = line
- ndxs2 = index(tline,s2q)
-c
-c Return point below for rechecks after zapping D" "
-c
-2 continue
- ndxbs = index(tline,char(92))
- if (ndxbs .gt. 0) then
-c
-c Special check in case \ is inside D"..."
-c
- ndxDq1 = index(tline,'D"')
-c
-c If the following test fails, flow out of if block; else loop up to 2.
-c
- if (ndxDq1 .gt. 0) then
-c
-c Find end of D"..."
-c
- ndxDq2 = ndxDq1+1+index(tline(ndxDq1+2:128),'"')
- if (ndxDq2 .eq. ndxDq1+1) then
- print*,'Something is really wierd here'
- stop
- end if
- tline = tline(1:ndxDq1-1)
- do 3 ic = ndxDq1 , ndxDq2
- tline = tline(1:ic-1)//' '
-3 continue
- tline = tline(1:ndxDq2)//line(ndxDq2+1:128)
- go to 2
- end if
- end if
- if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then
- ntindex = ndxs2
-c print*,'No bs, or char is left of 1st bs, ntindex:',ntindex
- else
-c
-c There are both bs and s2q, and bs is to the left of sq2. So check bs's to
-c right of first: End is '\ ', start is ' \'
-c
- len = lenstr(tline,128)
- intex = .true.
-c print*,'intex+>',intex
- do 1 ic = ndxbs+1 , len
- if (ic .eq. ndxs2) then
- if (intex) then
- ntindex = 0
- ndxs2 = index(tline(ic+1:len),s2q)+ic
-c print*,'ndxs2 =>',ndxs2
- else
- ntindex = ndxs2
- return
- end if
-c print*,'Internal exit, intex, ntindex:',intex,ntindex
- else if (intex .and. tline(ic+1:ic+2).eq.char(92)//' ') then
- intex = .false.
-c print*,'intex+>',intex
- else if (.not.intex .and. tline(ic+1:ic+2).eq.' '//char(92))
- * then
- intex = .true.
-c print*,'intex+>',intex
- end if
-1 continue
-c print*,'Out end of loop 1'
- end if
-c print*,'Exiting ntindex at the end???'
- return
- end
- subroutine getchar(line,iccount,charq)
-c
-c Gets the next character out of line*128. If pointer iccount=128 on entry,
-c then reads in a new line. Resets iccount to position of the new character.
-c
- character*1 charq
- character*128 line
- if (iccount .eq. 128) then
- read(10,'(a)')line
- iccount = 0
- end if
- iccount = iccount+1
- charq = line(iccount:iccount)
- return
- end
- function readin(line,iccount,iread)
- parameter (noimax=24)
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- logical insetup,replacing,botv,goto999
-c
-c Reads a piece of setup data from line, gets a new line from
-c file 10 (jobname.pmx) if needed, Transfers comment lines into all parts.
-c
-c iread controls copying of values into scratch files for parts, but only
-c if not replacing.
-c
-c iread input value written
-c -1 nvi nothing (only used when noinst<0 initially)
-c 0 various value read
-c 1 nv -1 , replace later with nvi(i)
-c 2 noinst 1
-c 3 np -2 , replace later with (nsyst-1)/12+1
-c 4 musicsize 20
-c 5 fracondent 0.05
-c
- character*128 line
- character*1 durq
-4 if (iccount .eq. 128) then
- read(10,'(a)')line
- if (replacing) replacing = .false.
- call chkcom(line,goto999)
- iccount = 0
- end if
- iccount = iccount+1
-c
-c Find next non-blank or end of line
-c
- do 2 iccount = iccount , 127
- if (line(iccount:iccount) .ne. ' ') go to 3
-2 continue
-c
-c If here, need to get a new line
-c
- iccount = 128
- go to 4
-3 continue
-c
-c iccount now points to start of number to read
-c
- i1 = iccount
-5 call getchar(line,iccount,durq)
-c
-c Remember that getchar first increments iccount, *then* reads a character.
-c
- if (index('0123456789.-',durq) .gt. 0) go to 5
- i2 = iccount-1
- if (i2 .lt. i1) then
- print*,'Found "'//durq//'" instead of number'
- stop 1
- end if
- icf = i2-i1+49
- read(line(i1:i2),'(f'//char(icf)//'.0)')readin
- if (.not.replacing) then
- if (iread .eq. 0) then
- call allparts(line(i1:i2),i2-i1+1)
- else if (iread .eq. 1) then
- call allparts('-999',4)
- else if (iread .eq. 2) then
- call allparts('1',1)
- else if (iread .eq. 3) then
- call allparts('-998',4)
- else if (iread .eq. 4) then
- call allparts('20',2)
- else if (iread .eq. 5) then
- call allparts('.05',3)
- else if (iread .ne. -1) then
- print*,'Error with iread in readin'
- stop
- end if
- end if
- return
- end
- subroutine chkcom(line,goto999)
- parameter (noimax=24)
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- logical insetup,replacing,clefpend,botv,goto999
- character*128 line
-c
-c Assume that line has just been read. No need to change iccount since we only
-c process full lines.
-c
- goto999 = .false.
-1 if (line(1:1) .ne. '%') return
-c
-c If here, line has some sort of comment
-c
- if (line(2:2) .eq. '%') then
- if (.not. insetup) then
-c
-c Suck up a line, then flow out of "if" block to get another and loop
-c
- read(10,'(a)')line
-
-c++VV
-c
-c UNLESS (a) it has a score-only "M" and changes # of inst's.
-c
- if (index(line,'M') .gt. 0) then
- idxL = index(line,'L')
- idxM = index(line,'M')
- idxn = index(line,'n')
- idxb = index(line,' ')
- if (idxL.lt.idxM .and. idxM.lt.idxn .and.
- * (idxb.eq.0 .or. idxn.lt.idxb)) then
- noinow = ichar(line(idxn+1:idxn+1))-48
- clefpend = .true.
-c
-c Next noinow digits are original inst. #'s of new inst. set. Next noinow
-c char's after that are clefs
-c
- nvnow = 0
- do 24 j = 1 , noinow
- iorig(j) = ichar(line(idxn+1+j:idxn+1+j))-48
- iposc0 = idxn+1+noinow
- do 25 k = 1 , nvi(iorig(j))
- nvnow = nvnow+1
-c clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow)
- instnum(nvnow) = j
- botv(nvnow) = k.eq.1 .and. j.ne.1
-25 continue
-24 continue
- end if
- end if
-c
-c or if it's "h" or "l", need to suck up one more line
-c
- if ((line(1:1).eq.'h'.and.index('+- ',line(2:2)).gt.0) .or.
-c
-c 4/29/00 check for T string also
-c
- * line(1:1).eq.'T' .or.
- * line(1:2).eq.'l ') read(10,'(a)')line
- else
-c
-c In setup mode. Set flag, flow out and do use following line
-c
- replacing = .true.
- end if
- else if (line(2:2) .eq. '!') then
-c
-c Copy to all parts
-c
- call allparts(line(3:128),125)
- else
-c
-c Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise
-cc Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise
-c
- ivq = index('123456789abcdefghijklmno',line(2:2))
-c
-c Only treat as part-specific pmx line if number .le. noinst
-c
- if (ivq.lt.1 .or. ivq.gt.noinst) then
-c
-c Simple comment.
-c
- call allparts(line,128)
- else
-c
-c Instrument comment, copy only to part
-c
- lenline = lenstr(line,128)
- if (lenline .gt. 2) then
- write(10+ivq,'(a)')line(3:lenline)
- else
-c
-c Transferring blank line
-c
- write(10+ivq,'(a)')' '
- end if
- end if
- end if
- read(10,'(a)',end=2)line
- call zapbl(line,128)
- go to 1
-2 continue
- goto999 = .true.
- return
- end
- subroutine dosetup(iv,line,mtrnum,mtrden)
- parameter (noimax=24)
-c
-c Transfers setup data from scratch file to real one for one instrument
-c Data may be mixed with comments, but on entry 1st item is a number.
-c Write a comment when encountered, as it comes.
-c Write numbers one per line.
-c Three input data require special handling:
-c If not already replaced, i.e., if negative, then
-c iset(1) (nv) will be replaced with nvi(i)
-c iset(9) (npages) will be replaced with (nsyst-1)/12+1
-c iset(2), if negative, will be followed by extra numbers to be transf.
-c
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- character*128 line
- logical insetup,replacing,botv
- iccount = 0
- do 1 iset = 1 , 12
- call partnum(iv,iccount,line,xdata)
- if (iset .eq. 2) then
- if (xdata .gt. 0) then
- write(40,'(i5)')int(xdata+.1)
- else
- noi = -xdata+.1
- write(40,'(i5)')noi
- do 2 ioi = 1 , noi
- call partnum(iv,iccount,line,xdata)
- write(40,'(i5)')int(xdata+.1)
-2 continue
- end if
-c else if (iset.ne.8 .and. xdata.lt.0) then
- else if (iset.ne.8 .and. iset.ne.5 .and. xdata.lt.0) then
-c
-c Must be either nv or npages
-c
- if (int(-xdata+.1) .eq. 999) then
-c
-c It's nv
-c
- write(40,'(i5)')nvi(iv)
- else
-c
-c npages must be computed
-c
- write(40,'(i5)')(nsyst-1)/12+1
- end if
- else if (iset.ne.7 .and. iset.ne.12) then
-c
-c write integer
-c
- write(40,'(i5)')nint(xdata)
- else
-c
-c write floating number
-c
- write(40,'(f5.2)')xdata
- end if
- if (iset .eq. 3) then
- mtrnum = nint(xdata)
- else if (iset .eq. 4) then
- mtrden = nint(xdata)
- end if
-1 continue
- return
- end
- subroutine partnum(iv,iccount,line,xdata)
-c
-c Simplified number parsing. Only looks for comment lines and numbers.
-c
- character*128 line
- character*1 durq
-2 if (iccount .eq. 128) then
- read(10+iv,'(a)')line
- if (line(1:1) .eq. '%') then
- len = lenstr(line,128)
- write(40,'(a)')line(1:len)
- go to 2
- end if
- iccount = 0
- end if
- iccount = iccount+1
-c
-c Find next non-blank or end of line
-c
- do 4 iccount = iccount , 127
- if (line(iccount:iccount) .ne. ' ') go to 3
-4 continue
-c
-c If here, iccount=128 and need to get a new line
-c
- go to 2
-3 continue
-c
-c iccount now points to start of number to read
-c
- i1 = iccount
-5 call getchar(line,iccount,durq)
-c
-c Remember that getchar first increments iccount, *then* reads a character.
-c
- if (index('0123456789.-',durq) .gt. 0) go to 5
- i2 = iccount-1
- if (i2 .lt. i1) then
- print*,'Found "'//durq//'" instead of number'
- stop 1
- end if
- icf = i2-i1+49
- read(line(i1:i2),'(f'//char(icf)//'.0)')xdata
- return
- end
- block data
- parameter (noimax=24)
- common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
- * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
- logical insetup,replacing,botv
- data nvi /noimax*1/, noinst,noinow /2*noimax/
- data botv /noimax*.false./
- end
- subroutine zapbl(string,len)
- character*(*) string
- do 1 i = 1 , len
- if (string(i:i) .eq. ' ')go to 1
- if (i .eq. 1) return
- go to 2
-1 continue
-c
-c If line is all blank, leave it alone
-c
- return
-2 continue
- string = string(i:len)
- return
- end
- subroutine OddQuotesBefore(lineq,indx,yesodd)
-c
-c This counts number of double quotes in lineq up to position indx-1, then
-c sets yesodd according to whether number is odd or even
-c
- logical yesodd
- character*(*) lineq
- numdqs = 0
- do 1 i = 1 , indx-1
- if (lineq(i:i) .eq. '"') numdqs = numdqs+1
-1 continue
- yesodd = mod(numdqs,2) .eq. 1
- return
- end
-
-
-
-
-
+cccccccccccccccccccccccccc
+cc
+cc scor2prt 1/29/21 for PMX 2.94
+cccccccccccccccccccccccccc
+c This program, developed by Don Simons (dsimons@roadrunner.com), is
+c part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert
+c with MusiXTeX and TeX, the purpose of PMX is to allow the user to create
+c high-quality typeset musical scores by including a sequence of PMX commands
+c in an ASCII input file. Scor2prt is an auxiliary program that creates PMX
+c input files for individual parts from the PMX input file for the score.
+c
+c This program is free software: you can redistribute it and/or modify
+c it under the terms of the GNU General Public License as published by
+c the Free Software Foundation, either version 3 of the License, or
+c (at your option) any later version.
+c
+c This program is distributed in the hope that it will be useful,
+c but WITHOUT ANY WARRANTY; without even the implied warranty of
+c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+c GNU General Public License for more details.
+c
+c You should have received a copy of the GNU General Public License
+c along with this program. If not, see <http://www.gnu.org/licenses/>.
+c
+c 1/29/21
+c Reformat output statement for warning about full bar rests to
+c eliminate use of H format specifier
+c 2/19/16
+c Exit gracefully when last input line is comment, with mods in
+c subroutine chkcom, adding logical argument goto999
+c which is set to .true. in that case, causing input file to
+c be closed after exiting.
+c 4/9/12
+c Add logical declarations to subroutine dosetup
+c 8/8/11
+c Copy & mod Ki into parts when after beginning.
+c 7/18/11
+c Start to fix up for AS..., also Ki was done a little earlier.
+c 7/5/10
+c Modify Manual to explain extended hex numbering for part-specific comments
+c 5/16/10
+c Extend part-specific comments for up to 24 parts (subroutine chkcom)
+c Allow files 11-34 for parts
+c Change file 30 to 40
+c 6/1/08 es2p
+c noimax = 24
+c
+c To do
+c Override fracindent, musicsize?
+c Deal with midbar R?
+c 2/29/04
+c Check for special character being in quoted string.
+c 10/20/02 PMX 2.407
+c Interpret AN[n]"[used-defined-part-file-name]"
+c 1/21/02
+c Deals with rm in multiple parts.
+c s2p15
+c Get right non-tex index even if there's "\" inside D"..."
+c s2p14
+c 10/29/00 fix transfer to parts of negative mtrdnp
+c 4/29/00 screen for "%%" followed by "T"
+c Restore change from "Version 2.1a, 21 Dec"
+c s2p13
+c Allow whole-bar double-whole rests.
+c Bypass MIDI commands "I..." achar(10)="I"
+c s2p12
+c Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla
+c only taken as such if ? represents a hex digit .le. noinst, otherwise it's
+c a simple comment. This lessens incompatibility.
+c In subroutine mbrest, properly open parts 10-12 if needed
+c s2p11
+c Ignore leading blanks
+c Fix undefined linelength in mbrest at very end of comments.
+c s2p10
+c Fix non-transfer of P..c" "
+c Allow "%%" and "%"n anywhere
+c Version 1.43
+c Fix bug with P in TeX string.
+c Ignore shifted whole-bar rests when consolidating whole-bar rests
+c Copy type 4 TeX into all parts.
+c Deal with XB and XP.
+c Permit transfer of blank line into parts
+c Change staves/inst in 'M' command.
+c Arbitrary staves/inst.
+c Recognize m1/2/3/4 syntax.
+c Enable comment and one-voice syntax in instrument names
+c
+c Changes since 1.1
+c Deal with saved macros.
+c Revise setup readin, to admit comments.
+c Do not copy 'X' into parts
+c
+cccccccccccccccccccccccccccccccccccccccccccccccc
+ parameter (noimax=24)
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ integer*4 ludpfn(noimax)
+ character*1 sq,achar(10)
+ character*2 termsym
+ character*27 jobname,infileq
+ character*128 instrum(noimax),udpfnq(noimax)
+ character*128 line,holdln,templine
+ logical termrpt,isachar,frstln,oneof2,botv,clefpend,fexist,
+ * insetup,replacing,gotname,yesodd,goto999
+ character*1 dumq
+ data achar /'P','m','V','R','A','h','w','K','M','I'/
+ clefpend = .false.
+ insetup = .true.
+ replacing = .false.
+ frstln = .true.
+ lenhold = 0
+ sq = char(92)
+ print*,'This is scor2prt for PMX 2.94, 29 January 2021'
+ numargs = iargc()
+ if (numargs .eq. 0) then
+ print*,'You could have entered a jobname on the command line,'
+ print*,' but you may enter one now:'
+ read(*,'(a)')jobname
+ numargs = 1
+ else
+c call getarg(1,jobname,idum) ! May need to replace this w/ next line
+ call getarg(1,jobname)
+ end if
+ ljob = lenstr(jobname,27)
+ if (ljob .eq. 0) then
+ print*,'No was jobname entered. Restart and try again.'
+ stop
+ end if
+c
+c Strip ".pmx" if necessary
+c
+ ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX'))
+ if (ndxpmx .gt. 0) then
+ jobname = jobname(1:ndxpmx-1)
+ ljob = ljob-4
+ end if
+c
+c Check for existence of input file
+c
+ infileq = jobname(1:ljob)//'.pmx'
+ inquire(file=infileq,EXIST=fexist)
+ if (.not.fexist) then
+ print*,'Cannot find file '//infileq
+ stop
+ end if
+ open(10,file=jobname(1:ljob)//'.pmx')
+c
+c Open all instrument files now for allparts stuff. Later disgard those >nv
+c
+ do 19 iv = 1 , noimax
+ iorig(iv) = iv
+ open(10+iv,status='SCRATCH')
+ ludpfn(iv) = 0
+19 continue
+ read(10,'(a)')line
+ call chkcom(line,goto999)
+ if (line(1:3) .eq. '---') then
+ call allparts(line,128)
+31 read(10,'(a)')line
+ if (line(1:3) .ne. '---') then
+ call allparts(line,128)
+ go to 31
+ end if
+ call allparts(line,128)
+ read(10,'(a)')line
+ call chkcom(line,goto999)
+ end if
+ iccount = 0
+ nv = readin(line,iccount,1)+.1
+ noinst = readin(line,iccount,2)+.1
+ if (noinst .gt. 0) then
+ nvi(1) = nv-noinst+1
+ else
+ noinst = 1-noinst
+ do 21 iinst = 1 , noinst
+ nvi(iinst) = readin(line,iccount,-1)+.1
+21 continue
+ end if
+ noinow = noinst
+ insnow = 1
+c
+c ivlast is last iv in current inst. instnum(iv) is iinst for current voice.
+c
+ ivlast = nvi(1)
+ do 22 iv = 1 , nv
+ instnum(iv) = insnow
+ if (iv .eq. ivlast) then
+ if (iv .lt. nv) botv(iv+1) = .true.
+c
+c The previous stmt will set botv true only for bot voice of iinst>1. It is
+c used when writing termrpts, but the one in voice one is handled differently,
+c so botv(1) is left .false.
+c
+ if (insnow .lt. noinst) then
+ insnow = insnow+1
+ ivlast = ivlast+nvi(insnow)
+ end if
+ end if
+22 continue
+ mtrnuml = readin(line,iccount,0)+.1
+ mtrdenl = readin(line,iccount,0)+.1
+ mtrnmp = readin(line,iccount,0)+.1
+ mtrdnp = readin(line,iccount,0)+.1
+ xmtrnum0 = readin(line,iccount,0)
+ isig = readin(line,iccount,0)+.1
+ npages = readin(line,iccount,3)+.1
+ nsyst = readin(line,iccount,0)+.1
+ musicsize = readin(line,iccount,4)+.1
+ fracindent = readin(line,iccount,5)
+ if (npages .eq. 0) then
+ print*,
+ *'You entered npages=0, which means nsyst is not the total number'
+ print*,
+ *'of systems. Scor2prt has to know the total number of systems.'
+ print*,
+ *'Please set npages and nsyst to their real values.'
+ stop
+ end if
+c
+c Must leave insetup=.true. else could bypass ALL instrument names.
+c
+ read(10,'(a)')line
+ call chkcom(line,goto999)
+ backspace(10)
+c
+c Normally this puts pointer at start of line with 1st inst name
+c Check if prior line was "%%"
+c
+ backspace(10)
+ read(10,'(a)')line
+ if (line(1:2) .eq. '%%') backspace(10)
+ do 14 iv = 1 , noinst
+ gotname = .false.
+16 read(10,'(a)') instrum(iv)
+ if (instrum(iv)(1:2) .eq. '%%') then
+ read(10,'(a)')line
+ go to 16
+ else if (instrum(iv)(1:1) .eq. '%') then
+ ivq = ichar(instrum(iv)(2:2))-48
+ if (ivq.ne.iv) then
+c
+c It's really a comment. Copy to parts, then get another trial name.
+c
+ call allparts(instrum(iv),128)
+ go to 16
+ else
+ line = instrum(iv)(3:)
+ instrum(iv) = line
+ gotname = .true.
+ end if
+ else
+ gotname = .true.
+ end if
+cc
+cc The following checks for macro that write original C-clef as part of
+cc instrument name. See pmx.tex
+cc
+c if (index(instrum(iv),'namewpc') .eq. 0) then
+c write(10+iv,'(a)')' '
+c else
+c inm1 = index(instrum(iv),'{')+1
+c inm2 = index(instrum(iv),'}')-1
+c read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2
+c write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'//
+c * char(iy1+49)//char(iy2+49)
+c instrum(iv) = instrum(iv)(inm1:inm2)
+c end if
+ if (.not.gotname) then
+ print*,'You must provide a replacement instrument name'
+ stop
+ end if
+ write(10+iv,'(a)')' '
+14 continue
+ replacing = .false.
+ nvnow = nv
+c
+c Clef string: Note insetup is still T, so "%%" will be treated specially
+c
+ read(10,'(a)')line
+ call chkcom(line,goto999)
+ if (replacing) then
+c
+c If here, we have next line after "%%", containing score's clef string
+c Assume all clefs are handled with instrument comments.
+c
+ read(10,'(a)')line
+ call chkcom(line,goto999)
+ backspace(10)
+ else
+c
+c If here, line has the clef string in it. Handle the old way
+c
+ kvstart = 1
+ kvend = nvi(1)
+ do 2 inst = 1 , noinst
+ write(10+inst,'(a'//char(48+nvi(inst))//')')
+ * line(kvstart:kvend)
+ if (inst .lt. noinst) then
+ kvstart = kvend+1
+ kvend = kvstart+nvi(inst+1)-1
+ end if
+2 continue
+ end if
+ replacing = .false.
+ insetup = .false.
+c
+c *****NOTE*****This comment applies to stuff done earlier!
+c Before starting the big loop, copy initial instnum and staffnum stuff
+c into working values. Latter may change if noinst changes. Also make
+c list of current inst nums relative to original ones. In addition to those
+c below, must redo instnum(iv) and botv(iv) when we change noinst.
+c
+c Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS!
+c
+18 read(10,'(a)') line
+ if (line(1:1) .eq. '%') then
+ call allparts(line,128)
+ go to 18
+ end if
+ call allparts(line,128)
+c
+c Write instrument names. Will be blank if later part of a score.
+c
+ if (instrum(1)(1:1) .ne. ' ') then
+ do 3 iv = 1 , noinst
+ len = lenstr(instrum(iv),79)
+ write(10+iv,'(a2/a)')'Ti',instrum(iv)(1:len)
+3 continue
+ end if
+c
+c The big loop. Except for '%%', put all comment lines in all parts.
+c Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts
+c If a line starts with %!, put the rest of it in each part.
+c If a line starts with %[n], put the rest of it in part [n].
+c Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes.
+c Assume they only come at top of block, except terminal repeat needs
+c special handling.
+c Check for "P"; ignore in parts.
+c Check for consecutive full-bar rests; if found, replace with rm[nn]
+c
+ iv = 1
+ iinst = 1
+ termrpt = .false.
+4 continue
+ read(10,'(a)',end=999)line
+ lenline = lenstr(line,128)
+ if (lenline .eq. 0) go to 4
+ call zapbl(line,128)
+ call chkcom(line,goto999)
+ if (goto999) go to 999
+ lenline = lenstr(line,128)
+ if (lenline .eq. 0) go to 4
+ if (line(1:1) .eq. 'T') then
+ call allparts(line,128)
+ read(10,'(a)')line
+ call allparts(line,128)
+ go to 4
+ else if (line(1:2) .eq. sq//sq) then
+ call allparts(line,128)
+ go to 4
+ else if (index('hl',line(1:1)).gt.0 .and.
+ * index(' +-',line(2:2)) .gt. 0) then
+ call allparts(line,128)
+ read(10,'(a)')line
+ call allparts(line,128)
+ go to 4
+ else if (iv .eq. 1) then
+ do 5 ia = 1 , 10
+24 continue
+ idxa = ntindex(line,achar(ia))
+ isachar = idxa .gt. 0
+ if (idxa.gt.1) isachar = line(idxa-1:idxa-1).eq.' '
+c
+c 1 2 3 4 5 6 7 8 9 10
+c data achar /'P','m','V','R','A','h','w','K','M','I'/
+c
+ if (ia .eq. 9) isachar =
+ * isachar .and. line(idxa+1:idxa+1).eq.'S'
+ if (isachar) then
+c
+c Check whether character is inside a quoted string by counting
+c how many quotes precede it in the line
+c
+
+ call OddQuotesBefore(line,idxa,yesodd)
+ if (yesodd) isachar=.false.
+ end if
+ if (isachar) then
+c
+c Find next blank
+c
+ do 6 ib = idxa+1 , 128
+ if (line(ib:ib) .eq. ' ') go to 7
+6 continue
+ print*,'Problem with "V,R,m,P,A,h,MS, or w"'
+ print*,
+ * 'Send files to Dr. Don at dsimons at roadrunner dot com'
+ stop 1
+7 continue
+c
+c Next blank is at position ib. Later, if ia=1, must check for Pc" " ;
+c i.e., look for '"' between P and blank
+c
+ if (ia .eq. 4) then
+c
+c Check for terminal repeat. Note if there's a term rpt, there can't be any
+c others. Also, must process repeats LAST, after m's and 'V's
+c
+ do 8 ic = ib+1 , 128
+c
+c If any subsequent character on this line is neither blank nor "/", get out
+c
+ if (index(' /',line(ic:ic)) .eq. 0) go to 9
+ if (line(ic:ic) .eq. '/') then
+ termrpt = .true.
+ termsym = line(ib-2:ib-1)
+c
+c Process the line as if there were no "R"
+c
+ go to 10
+ end if
+8 continue
+c
+c +++ 060812
+c If here, all chars after "R" symbol are blanks, so process the line normally,
+c but only IF next line is not the M-Tx line " /"
+c
+ read(10,'(a)')templine
+ if (templine(1:2) .ne. ' /') then
+ backspace(10) ! and flow out
+ else
+c
+c We have the M-Tx case where one line ends with R? and next is " /". Add / to the line,
+c and proceed as above
+c
+ line = line(1:ib)//'/'
+ lenline = lenline+2
+ termrpt = .true.
+ termsym = line(ib-2:ib-1)
+ go to 10
+ end if
+c +++ 060812
+c
+ else if (ia .eq. 1) then
+ idxq = ntindex(line,'"')
+ if (idxq.gt.idxa .and. idxq.lt.ib) then
+c
+c Quote is between P and next blank. Find 2nd quote, starting at the blank.
+c
+ idxq2 = ib-1+ntindex(line,'"')
+ if (idxq.eq.0 .or. line(idxq2+1:idxq2+1).ne.' ') then
+ print*
+ print*,'Error copying P with quotes, idxq2:',idxq2
+ print*,line(1:60)
+ stop 1
+ end if
+ ib = idxq2+1
+ end if
+c
+c Do not transfer P into parts.
+c
+ go to 12
+ else if (ia .eq. 9) then
+c
+c Start Saving a macro. After leaving here, a symbol will be sent to all parts,
+c If all on this line, set ib to end and exit normally.
+c
+ ndxm = index(line(ib+1:128),'M')
+ if (ndxm.gt.0 .and. line(ib+ndxm-1:ib+ndxm-1).eq.' ') then
+c
+c Macro ends on this line
+c
+ ib = ib+ndxm+1
+ else
+c
+c Save leading part of current line
+c
+ lenhold = idxa-1
+ if (lenhold .gt. 0) holdln = line(1:lenhold)
+c
+c Transfer rest of line
+c
+ call allparts(line(idxa:128),129-idxa)
+c
+c Read next line
+c
+20 read(10,'(a)')line
+c
+c Check for comment, transfer and loop if so
+c
+c if (line(1:1) .eq.'%') then
+23 if (line(1:1) .eq.'%') then
+c call allparts(line,128)
+c go to 20
+ call chkcom(line,goto999)
+ go to 23
+ end if
+c
+c Look for terminal ' M'
+c
+ if (line(1:1) .eq. 'M') then
+ ndxm = 1
+ else
+ ndxm = index(line,' M')
+ if (ndxm .gt. 0) ndxm = ndxm+1
+ end if
+ if (ndxm .gt. 0) then
+c
+c Set parameters, exit normally (but later check for leading part of 1st line
+c
+ idxa = 1
+ ib = ndxm+1
+ else
+c
+c No "M", transfer entire line, loop
+c
+ call allparts(line,128)
+ go to 20
+ end if
+ end if
+ else if (ia .eq. 10) then
+c
+c Do not transfer MIDI command into parts
+c
+ go to 12
+ else if (ia .eq. 5) then
+c
+c First check for "AS", but S may come after other "A" options
+c
+ idxS = index(line(idxa+1:ib),'S')
+ if (idxS .gt. 0) then
+c
+c Get rid of the string. First check if that's all there is in A.
+c
+ if (ib-idxa .eq. nv+2) go to 12
+ line = line(1:idxa+idxS-1)//line(idxa+idxS+nv+1:ib)
+ end if
+c
+c Check for user-defined part file name. Must start in column 1 and have
+c AN[n]"userfilename".
+c idxa is position of "A"
+c ib is position of the next blank after "A"
+c Don't allow any blanks in user
+c
+ if (line(idxa+1:idxa+1) .ne. 'N') go to 9 ! bail out
+ if (idxa .ne. 1) then
+ print*
+ print*,
+ * 'You entered "AN..." somewhere beyond first column; stopping.'
+ stop 1
+ end if
+c
+c pmxa already checked for valid one- or 2-digit number, so get it
+c
+ if (line(4:4) .eq. '"') then
+c
+c Single digit instrument number
+c
+ read(line(3:3),'(i1)')iudpfn
+ idxstartname = 5
+ else
+ read(line(3:4),'(i2)')iudpfn
+ idxstartname = 6
+ end if
+ ludpfn(iudpfn) = index(line(idxstartname:128),'"')-1
+ if (ludpfn(iudpfn) .lt. 0) then
+ print*
+ print*,'User-defined part file name must be in quotes'
+ stop 1
+ end if
+ idxendname = idxstartname+ludpfn(iudpfn)-1
+ udpfnq(iudpfn) = line(idxstartname:idxendname)
+c
+c Get a new line!
+c
+ go to 4
+ else if (ia .eq. 8) then
+c
+c Key change/transposition.
+c If not instrument specific, copy to all parts
+c
+ if (line(idxa+1:idxa+1).ne.'i') go to 9
+c
+c Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]...
+c
+ ibb = idxa+2 ! Starts on digit after 'i'
+40 continue
+ read(line(ibb:ibb),'(i1)')iiinst ! 1st digit of iinst
+ itemp = (index('01234567890',line(ibb+1:ibb+1)))
+ if (itemp.gt.0) then
+ ibb = ibb+1
+ iiinst = 10*iiinst+itemp-1
+ end if
+ ibb = ibb+1 ! now at first +/-. Need end of 2nd number
+ itemp = index(line(ibb+1:ib),'i') ! Rel pos'n of next 'i' or 0
+ if (itemp .gt. 0) then
+ iend = ibb+itemp-1
+ else
+ iend = ib-1
+ end if
+ write(10+iorig(iiinst),'(a)')'Ki1'//line(ibb:iend)
+ if (itemp .gt. 0) then
+ ibb = iend+2
+ go to 40
+ end if
+ go to 12 ! Remove K command from string, go to next ia
+ end if
+9 continue
+ call allparts(line(idxa:ib-1),ib-idxa)
+12 continue
+c
+c Remove the string from line
+c
+ if (idxa .eq. 1) then
+ line = line(ib:128)
+ else
+ line = line(1:idxa-1)//line(ib:128)
+ end if
+ lenline = lenstr(line,128)
+c
+c Loop if only blanks are left
+c
+ if (lenline .eq. 0) go to 4
+c
+c Must check for multiple "I" commands, so go to just after start of ia loop
+c
+ if (ia .eq. 10) go to 24
+c
+c Tack on front part from 1st line of saved macro
+c
+ if (lenhold .gt. 0) then
+ line = holdln(1:lenhold)//' '//line(1:lenline)
+ lenhold = 0
+ end if
+ end if
+5 continue
+ end if
+c
+c Now a special loop to deal with 'X'. If it was %[n]X..., will have been
+c copied into part [n] already. If no "B" or "P", remove. If "P", just
+c remove the "P" so pmxa/b will process. If "B". do nothing.
+c
+10 continue
+ nchk = 1
+13 ntinx = nchk-1+ntindex(line(nchk:),'X')
+ if (ntinx .gt. nchk-1) then
+c
+c There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank.
+c
+ if (ntinx.gt.1) then
+ if (line(ntinx-1:ntinx-1).ne.' ') then
+c
+c The X is not 1st char of PMX command. Advance starting point, loop.
+c
+ nchk = ntinx+1
+ go to 13
+ end if
+ end if
+c
+c We now know the X at ntinx starts a PMX command. Find next blank
+c
+ ib = ntinx+index(line(ntinx+1:),' ')
+c
+c There must be a blank to right of "X", so ib>ntinx
+c
+c locp = nchk-1+index(line(nchk:ib),'P')
+ locp = ntinx+index(line(ntinx+1:ib),'P')
+c
+c Did not need to use ntindex because we already know bounds of PMX command.
+c
+c if (locp .gt. nchk-1) then
+ if (locp .gt. ntinx) then
+c
+c Strip out the 'P'
+c
+ templine = line(1:locp-1)
+ line = templine(1:locp-1)//line(locp+1:lenline)
+ lenline = lenline-1
+ ib = ib-1
+ end if
+ if (index(line(ntinx:ib),':').gt.0 .or.
+ * index(line(ntinx:ib),'S').gt.0 .or.
+ * index(line(ntinx:ib),'B').gt.0 .or. locp.gt.ntinx) then
+c
+c The X command is a shift, "Both", or "Part". Do not remove.
+c
+ nchk = ib+1
+ go to 13
+ end if
+c
+c Remove the X command.
+c
+ if (ntinx .eq. 1) then
+ if (ib .lt. lenline) then
+ line = line(ib+1:lenline)
+ else
+c
+c line contains ONLY the "X" command, so get a new line
+c
+ go to 4
+ end if
+ else
+ templine = line(1:ntinx-1)
+ if (ib .lt. lenline) then
+ line = templine(1:ntinx-1)//line(ib+1:lenline)
+ else
+ line = templine(1:ntinx-1)
+ end if
+ end if
+c
+c Recompute lenline
+c
+ lenline = lenstr(line,128)
+c
+c Resume checking after location of removed command.
+c
+ nchk = ntinx
+ go to 13
+ end if
+c
+c End of loop for X-checks
+c
+ oneof2 = ntindex(line,'//') .gt. 0
+ if (termrpt .and. botv(iv) .and. frstln .and.
+ * line(lenline:lenline).eq.'/') then
+c
+c Must add a terminal repeat before the slash
+c
+ if (oneof2) lenline = lenline-1
+ if (lenline.gt.1) write(10+iorig(iinst),'(a)')line(1:lenline-1)
+ if (.not. oneof2) then
+ line = termsym//' /'
+ lenline = 4
+ else
+ line = termsym//' //'
+ lenline = 5
+ end if
+ end if
+ if (termrpt .and. frstln .and. line(lenline:lenline).eq.'/' .and.
+ * iv.eq.nvnow) termrpt = .false.
+ write(10+iorig(iinst),'(a)')line(1:lenline)
+ if (oneof2) then
+ frstln = .false.
+ else if (.not.frstln) then
+ frstln = .true.
+ end if
+c if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then
+ if (ntindex(line,'/').gt.0 .and. ntindex(line,'//').eq.0) then
+ iv = 1+mod(iv,nvnow)
+ iinst = instnum(iv)
+ end if
+ go to 4
+999 continue
+ close(10)
+c
+c In the mbrest checks, must run through ALL noinst files (not just noinow)
+c
+ do 11 iinst = 1 , noinst
+ccc+++
+cc
+cc Temporarily transfer entire scratch file to real file
+cc
+c rewind(10+iinst)
+c open(40,file='s2pout'//char(48+iinst)//'.pmx')
+c do 50 m = 1 , 10000
+c read(10+iinst,'(a)',end=51)line
+c lenline = lenstr(line,128)
+c if (lenline .ge. 1) then
+c write(40,'(a)')line(1:lenline)
+c else
+c write(40,'(a)')' '
+c end if
+c50 continue
+c51 continue
+c close(40)
+ccc+++
+ if (nvi(iinst) .eq. 1) then
+ call mbrests(iinst,jobname,ljob,ludpfn(iinst),udpfnq(iinst))
+ else
+c
+c Send a signal with ljob to bypass most mbrest processing
+c
+ call mbrests(iinst,jobname,-ljob,ludpfn(iinst),udpfnq(iinst))
+ end if
+11 continue
+ end
+ function lenstr(string,n)
+ character*(*) string
+ do 1 lenstr = n , 1 , -1
+ if (string(lenstr:lenstr) .ne. ' ') return
+1 continue
+ lenstr = 0
+ return
+ end
+ subroutine allparts(string,n)
+ parameter (noimax=24)
+ character*(*) string
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ logical insetup,replacing,botv
+ len = lenstr(string,n)
+ if (len .eq. 0) then
+ len = 1
+ string = ' '
+ end if
+ do 1 iinst = 1 , noinow
+ write(10+iorig(iinst),'(a)')string(1:len)
+1 continue
+ return
+ end
+ subroutine mbrests(iv,jobname,ljob,ludpfn,udpfnq)
+ character*128 line(50),line1,udpfnq
+ character*80 sym
+ character*12 jobname
+ character*3 wbrsym(2)
+ character*2 partq
+ character*1 sq
+ logical wbrest,alldone,rpfirst,newmtr,type4
+ type4 = .false.
+ sq = char(92)
+ alldone = .false.
+ rewind(10+iv)
+ if (iv .lt. 10) then
+ partq(1:1) = char(48+iv)
+ lpart = 1
+ else
+ lpart = 2
+ if (iv .lt. 20) then
+ partq = '1'//char(38+iv)
+ else
+ partq = '2'//char(28+iv)
+ end if
+ end if
+c 130327
+c open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx')
+ if (ludpfn .eq. 0) then
+ open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx')
+ else
+ open(40,file=udpfnq(1:ludpfn)//'.pmx')
+ end if
+ do 10 i = 1 , 10000
+ read(10+iv,'(a)')line(1)
+ if (line(1)(1:1).eq.'%' .or. line(1)(1:3).eq.'---'
+ * .or. type4) then
+ len = lenstr(line(1),128)
+ if (len .gt. 0) then
+ write(40,'(a)')line(1)(1:len)
+ else
+ write(40,'(a)')' '
+ end if
+ if (line(1)(1:3).eq.'---') type4 = .not.type4
+ else
+ go to 11
+ end if
+10 continue
+ print*,'You should not be here in scor2prt. Call Dr. Don'
+ stop
+11 continue
+c
+c Finished reading opening type4 TeX and comments. Next line to be read
+c will contain the first of the input numbers
+c
+ call dosetup(iv,line(1),mtrnum,mtrden)
+ do 1 i = 1 , 10000
+13 read(10+iv,'(a)',end=999)line(1)
+7 len = lenstr(line(1),128)
+c
+c Pass-through (and copy into part file) if instrumnet has >1 voice.
+c
+ if (ljob .lt. 0) go to 2
+ if (index('TtTiTch+h-h l ',line(1)(1:2)) .gt. 0) then
+c
+c Traps titles, instruments, composers, headers, lower strings. Read 2 lines.
+c
+ write(40,'(a)')line(1)(1:len)
+ read(10+iv,'(a)')line(1)
+ len = lenstr(line(1),128)
+ go to 2
+ end if
+ if (i.eq.1 .or. (i.gt.5.and.line(1)(1:1).eq.'m')) then
+c
+c Either just starting, or a new meter is defined.
+c NOTE! The above test may be bogus.
+c
+ if (line(1)(1:1) .eq. '%') then
+ write(40,'(a)')line(1)(1:len)
+ go to 13
+ end if
+ if (i .ne. 1) then
+c
+c New meter. Check for slashes (new meter change syntax)
+c
+ idxs = index(line(1),'/')
+ idxb = index(line(1),' ')
+ newmtr = idxs.gt.0 .and. (idxb.eq.0 .or. idxs.lt.idxb)
+ if (.not.newmtr) then
+c
+c Old way, no slashes, uses 'o' for lonesome '1'
+c
+ icden = 3
+ if (line(1)(2:2) .eq. 'o') then
+ mtrnum = 1
+ else
+ mtrnum = ichar(line(1)(2:2))-48
+ if (mtrnum .eq. 1) then
+ icden = 4
+ mtrnum = 10+ichar(line(1)(3:3))-48
+ end if
+ end if
+ mtrden = ichar(line(1)(icden:icden))-48
+ else
+c
+c New way with slashes: idxs is index of 1st slash!
+c
+ read(line(1)(2:idxs-1),'(i'//char(48+idxs-2)//')')mtrnum
+ idxb = index(line(1)(idxs+1:),'/')
+ read(line(1)(idxs+1:idxs+idxb-1),
+ * '(i'//char(48+idxb-1)//')')mtrden
+ end if
+ end if
+ lenbeat = ifnodur(mtrden,'x')
+ lenmult = 1
+ if (mtrden .eq. 2) then
+ lenbeat = 16
+ lenmult = 2
+ end if
+ lenbar = lenmult*mtrnum*lenbeat
+ call fwbrsym(lenbar,nwbrs,wbrsym,lwbrs)
+ end if
+c
+c Finished setting up meter stuff and defining whole-bar rest symbols
+c
+ ip1 = 0
+ line1 = line(1)
+ do 3 iw = 0 , nwbrs
+ if (iw .gt. 0) then
+ idx = ntindex(line1,wbrsym(iw)(1:lwbrs))
+ if (idx .gt. 0) then
+c
+c Check for blank or shifted rest, discount it if it's there
+c
+ if (line1(idx+lwbrs:idx+lwbrs).ne.' ') idx = 0
+ end if
+ else
+ idx = ntindex(line1,'rp')
+c
+c Check for raised rest
+c
+ if (idx.gt.0) then
+ if (line1(idx+2:idx+2).ne.' ') idx = 0
+ end if
+ end if
+ if (idx .gt. 0) then
+ if (ip1 .eq. 0) then
+ ip1 = idx
+ else
+ ip1 = min(ip1,idx) ! Maybe allows e.g. r0 rp ...
+ end if
+ end if
+3 continue
+ if (i.lt.5 .or. line(1)(1:1).eq.'%' .or. line(1)(1:2).eq.sq//sq
+ * .or. ip1.eq.0) go to 2
+c
+c Switch to multibar rest search mode!!! Start forward in line(1)
+c
+ rpfirst = line1(ip1:ip1+1) .eq. 'rp'
+ iline = 1
+ nmbr = 1
+ if (rpfirst) then
+ lwbrsx = 2
+ else
+ lwbrsx = lwbrs
+ end if
+ ipe = ip1+lwbrsx-1 ! ip at end of 1st wbrsym
+4 if (ipe .eq. len) then
+c
+c Need a new line
+c
+ iline = iline+1
+6 read(10+iv,'(a)',end=998)line(iline)
+ len = lenstr(line(iline),128)
+ if (line(iline)(1:1).eq.'%' ) then
+ write(40,'(a)')'% Following comment has been moved forward'
+ write(40,'(a)')line(iline)(1:len)
+ go to 6
+ end if
+ ipe = 0
+ go to 4
+998 continue
+c
+c No more input left
+c
+ print*,'All done!'
+ alldone = .true.
+ ipe = 0
+ iline = iline-1
+ len = lenstr(line(iline),128)
+ go to 4
+ else
+ if (alldone) then
+ sym(1:1) = ' '
+ else
+c
+c ipe<len here, so it's ok to get a symbol
+c
+ call nextsym(line(iline),len,ipe,ipenew,sym,lsym)
+ end if
+c
+c Check for end of block or bar line symbol
+c
+ if (index('/|',sym(1:1)) .gt. 0) then
+ ipe = ipenew
+ go to 4
+ else
+ wbrest = .false.
+ if (alldone) go to 12
+ do 5 iw = 1 , nwbrs
+ wbrest = wbrest .or. sym(1:lsym).eq.wbrsym(iw)(1:lwbrs)
+5 continue
+ wbrest = wbrest .or. (sym(1:lsym).eq.'r'.and.lwbrs.eq.2)
+ * .or. (sym(1:lsym).eq.'rd'.and.lwbrs.eq.3)
+ * .or. (sym(1:lsym).eq.'rp')
+ * .or. (sym(1:lsym).eq.'r' .and. rpfirst)
+12 if (wbrest) then
+ ipe = ipenew
+ nmbr = nmbr+1
+ go to 4
+ else
+c
+c AHA! Failed prev. test, so last symbol was *not* mbr.
+c It must be saved, and its starting position is ipenew-lsym+1
+c
+ if (nmbr .gt. 1) then
+c
+c Write stuff up to start of mbr
+c
+ if (ip1 .gt. 1) write(40,'(a)')line(1)(1:ip1-1)
+c
+c Insert mbr symbol. Always end with a slash just in case next sym must be
+c at start of block. May think this causes undefined octaves, but
+c probably not since it's a single voice.
+c
+ ndig = int(alog10(nmbr+.01))+1
+ print*,'Inserting rm, iv,nmbr:',iv,nmbr
+ write(40,'(a2,i'//char(48+ndig)//',a2)')'rm',nmbr,' /'
+ if (alldone) go to 999
+ ipc = ipenew-lsym+1
+ line(1) = line(iline)(ipc:len)
+ else
+c
+c Write old stuff up to end of original lonesome wbr, save the rest.
+c 4 cases: (wbr /) , (wbr line-end) , (wbr followed by other non-/ symbols) ,
+c alldone.
+c In 1st 2 will have gotten some other lines, so write all up to one b4 last
+c non-comment line; then revert to normal mode on that. In 3rd case must
+c split line.
+c
+ if (alldone) then
+ write(40,'(a)')line(1)(1:len)
+ go to 999
+ else if (iline .gt. 1) then
+ do 9 il = 1 , iline-1
+ len = lenstr(line(il),128)
+ write(40,'(a)')line(il)(1:len)
+9 continue
+ line(1) = line(iline)
+ else
+c
+c Since iline = 1 the wbr is not the last sym, so must split
+c
+ write(40,'(a)')line(1)(1:ip1+lwbrsx-1)
+ line(1) = line(1)(ip1+lwbrsx+1:len)
+ end if
+ end if
+c
+c Exit multibar mode
+c
+ go to 7
+ end if
+ end if
+ end if
+2 continue
+ if (len .gt. 0) then
+ write(40,'(a)')line(1)(1:len)
+ else
+ write(40,'(a)')' '
+ end if
+1 continue
+999 continue
+ close(10+iv)
+ close(40)
+ return
+ end
+ function ifnodur(idur,dotq)
+ character*1 dotq
+ if (idur .eq. 6) then
+ ifnodur=1
+ else if (idur .eq. 3) then
+ ifnodur=2
+ else if (idur.eq.1 .or. idur.eq.16) then
+ ifnodur=4
+ else if (idur .eq. 8) then
+ ifnodur=8
+ else if (idur .eq. 4) then
+ ifnodur=16
+ else if (idur .eq. 2) then
+ ifnodur=32
+ else if (idur .eq. 0) then
+ ifnodur=64
+ else
+ print*,'You entered an invalid note-length value'
+ stop
+ end if
+ if (dotq .eq. 'd') ifnodur = ifnodur*3/2
+ return
+ end
+ subroutine fwbrsym(lenbar,nwbrs,wbrsym,lwbrs)
+ character*3 wbrsym(2)
+ nwbrs = 1
+ lwbrs = 2
+ if (lenbar .eq. 16) then
+ wbrsym(1) = 'r4'
+ else if (lenbar .eq. 32) then
+ wbrsym(1) = 'r2'
+ else if (lenbar .eq. 64) then
+ wbrsym(1) = 'r0'
+ else if (lenbar .eq. 8) then
+ wbrsym(1) = 'r8'
+ else if (lenbar .eq. 128) then
+ wbrsym(1) = 'r9'
+ else
+ nwbrs = 2
+ lwbrs = 3
+ if (lenbar .eq. 24) then
+ wbrsym(1) = 'rd4'
+ wbrsym(2) = 'r4d'
+ else if (lenbar .eq. 48) then
+ wbrsym(1) = 'rd2'
+ wbrsym(2) = 'r2d'
+ else if (lenbar .eq. 96) then
+ wbrsym(1) = 'rd0'
+ wbrsym(2) = 'r0d'
+ else
+ write(*,'(a33,i3,a26)')' Any whole-bar rests of duration',
+ * lenbar,'/64 will not be recognized'
+ end if
+ end if
+ return
+ end
+ subroutine nextsym(line,len,ipeold,ipenew,sym,lsym)
+c
+c Know its the last symbol if on return ipenew = len!. So should never
+c be called when ipstart=len.
+c
+ character*128 line
+ character*80 sym
+ if (ipeold .ge. len) then
+ print*,'Called nextsym with ipstart>=len '
+ print*,'Send files to Dr. Don at dsimons@logicon.com'
+ stop
+ end if
+ do 1 ip = ipeold+1 , len
+ if (line(ip:ip) .ne. ' ') then
+c
+c symbol starts here (ip). We're committed to exit the loop.
+c
+ if (ip .lt. len) then
+ do 2 iip = ip+1 , len
+ if (line(iip:iip) .ne. ' ') go to 2
+c
+c iip is the space after the symbol
+c
+ ipenew = iip-1
+ lsym = ipenew-ip+1
+ sym = line(ip:ipenew)
+ return
+2 continue
+c
+c Have len>=2 and ends on len
+c
+ ipenew = len
+ lsym = ipenew-ip+1
+ sym = line(ip:ipenew)
+ return
+ else
+c
+c ip = len
+c
+ ipenew = len
+ lsym = 1
+ sym = line(ip:ip)
+ return
+ end if
+ end if
+1 continue
+ print*,'Error #3. Send files to Dr. Don at dsimons@logicon.com'
+ end
+ function ntindex(line,s2q)
+c
+c Returns index(line,s2q) if NOT in TeX string, 0 otherwise
+c
+ character*(*) s2q
+ character*128 line,tline
+ logical intex
+c
+c print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below'
+c print*,line(1:79)
+c
+c
+c Use a temporary string to store the input and test, so can zap D"..."
+c
+ tline = line
+ ndxs2 = index(tline,s2q)
+c
+c Return point below for rechecks after zapping D" "
+c
+2 continue
+ ndxbs = index(tline,char(92))
+ if (ndxbs .gt. 0) then
+c
+c Special check in case \ is inside D"..."
+c
+ ndxDq1 = index(tline,'D"')
+c
+c If the following test fails, flow out of if block; else loop up to 2.
+c
+ if (ndxDq1 .gt. 0) then
+c
+c Find end of D"..."
+c
+ ndxDq2 = ndxDq1+1+index(tline(ndxDq1+2:128),'"')
+ if (ndxDq2 .eq. ndxDq1+1) then
+ print*,'Something is really wierd here'
+ stop
+ end if
+ tline = tline(1:ndxDq1-1)
+ do 3 ic = ndxDq1 , ndxDq2
+ tline = tline(1:ic-1)//' '
+3 continue
+ tline = tline(1:ndxDq2)//line(ndxDq2+1:128)
+ go to 2
+ end if
+ end if
+ if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then
+ ntindex = ndxs2
+c print*,'No bs, or char is left of 1st bs, ntindex:',ntindex
+ else
+c
+c There are both bs and s2q, and bs is to the left of sq2. So check bs's to
+c right of first: End is '\ ', start is ' \'
+c
+ len = lenstr(tline,128)
+ intex = .true.
+c print*,'intex+>',intex
+ do 1 ic = ndxbs+1 , len
+ if (ic .eq. ndxs2) then
+ if (intex) then
+ ntindex = 0
+ ndxs2 = index(tline(ic+1:len),s2q)+ic
+c print*,'ndxs2 =>',ndxs2
+ else
+ ntindex = ndxs2
+ return
+ end if
+c print*,'Internal exit, intex, ntindex:',intex,ntindex
+ else if (intex .and. tline(ic+1:ic+2).eq.char(92)//' ') then
+ intex = .false.
+c print*,'intex+>',intex
+ else if (.not.intex .and. tline(ic+1:ic+2).eq.' '//char(92))
+ * then
+ intex = .true.
+c print*,'intex+>',intex
+ end if
+1 continue
+c print*,'Out end of loop 1'
+ end if
+c print*,'Exiting ntindex at the end???'
+ return
+ end
+ subroutine getchar(line,iccount,charq)
+c
+c Gets the next character out of line*128. If pointer iccount=128 on entry,
+c then reads in a new line. Resets iccount to position of the new character.
+c
+ character*1 charq
+ character*128 line
+ if (iccount .eq. 128) then
+ read(10,'(a)')line
+ iccount = 0
+ end if
+ iccount = iccount+1
+ charq = line(iccount:iccount)
+ return
+ end
+ function readin(line,iccount,iread)
+ parameter (noimax=24)
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ logical insetup,replacing,botv,goto999
+c
+c Reads a piece of setup data from line, gets a new line from
+c file 10 (jobname.pmx) if needed, Transfers comment lines into all parts.
+c
+c iread controls copying of values into scratch files for parts, but only
+c if not replacing.
+c
+c iread input value written
+c -1 nvi nothing (only used when noinst<0 initially)
+c 0 various value read
+c 1 nv -1 , replace later with nvi(i)
+c 2 noinst 1
+c 3 np -2 , replace later with (nsyst-1)/12+1
+c 4 musicsize 20
+c 5 fracondent 0.05
+c
+ character*128 line
+ character*1 durq
+4 if (iccount .eq. 128) then
+ read(10,'(a)')line
+ if (replacing) replacing = .false.
+ call chkcom(line,goto999)
+ iccount = 0
+ end if
+ iccount = iccount+1
+c
+c Find next non-blank or end of line
+c
+ do 2 iccount = iccount , 127
+ if (line(iccount:iccount) .ne. ' ') go to 3
+2 continue
+c
+c If here, need to get a new line
+c
+ iccount = 128
+ go to 4
+3 continue
+c
+c iccount now points to start of number to read
+c
+ i1 = iccount
+5 call getchar(line,iccount,durq)
+c
+c Remember that getchar first increments iccount, *then* reads a character.
+c
+ if (index('0123456789.-',durq) .gt. 0) go to 5
+ i2 = iccount-1
+ if (i2 .lt. i1) then
+ print*,'Found "'//durq//'" instead of number'
+ stop 1
+ end if
+ icf = i2-i1+49
+ read(line(i1:i2),'(f'//char(icf)//'.0)')readin
+ if (.not.replacing) then
+ if (iread .eq. 0) then
+ call allparts(line(i1:i2),i2-i1+1)
+ else if (iread .eq. 1) then
+ call allparts('-999',4)
+ else if (iread .eq. 2) then
+ call allparts('1',1)
+ else if (iread .eq. 3) then
+ call allparts('-998',4)
+ else if (iread .eq. 4) then
+ call allparts('20',2)
+ else if (iread .eq. 5) then
+ call allparts('.05',3)
+ else if (iread .ne. -1) then
+ print*,'Error with iread in readin'
+ stop
+ end if
+ end if
+ return
+ end
+ subroutine chkcom(line,goto999)
+ parameter (noimax=24)
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ logical insetup,replacing,clefpend,botv,goto999
+ character*128 line
+c
+c Assume that line has just been read. No need to change iccount since we only
+c process full lines.
+c
+ goto999 = .false.
+1 if (line(1:1) .ne. '%') return
+c
+c If here, line has some sort of comment
+c
+ if (line(2:2) .eq. '%') then
+ if (.not. insetup) then
+c
+c Suck up a line, then flow out of "if" block to get another and loop
+c
+ read(10,'(a)')line
+
+c++VV
+c
+c UNLESS (a) it has a score-only "M" and changes # of inst's.
+c
+ if (index(line,'M') .gt. 0) then
+ idxL = index(line,'L')
+ idxM = index(line,'M')
+ idxn = index(line,'n')
+ idxb = index(line,' ')
+ if (idxL.lt.idxM .and. idxM.lt.idxn .and.
+ * (idxb.eq.0 .or. idxn.lt.idxb)) then
+ noinow = ichar(line(idxn+1:idxn+1))-48
+ clefpend = .true.
+c
+c Next noinow digits are original inst. #'s of new inst. set. Next noinow
+c char's after that are clefs
+c
+ nvnow = 0
+ do 24 j = 1 , noinow
+ iorig(j) = ichar(line(idxn+1+j:idxn+1+j))-48
+ iposc0 = idxn+1+noinow
+ do 25 k = 1 , nvi(iorig(j))
+ nvnow = nvnow+1
+c clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow)
+ instnum(nvnow) = j
+ botv(nvnow) = k.eq.1 .and. j.ne.1
+25 continue
+24 continue
+ end if
+ end if
+c
+c or if it's "h" or "l", need to suck up one more line
+c
+ if ((line(1:1).eq.'h'.and.index('+- ',line(2:2)).gt.0) .or.
+c
+c 4/29/00 check for T string also
+c
+ * line(1:1).eq.'T' .or.
+ * line(1:2).eq.'l ') read(10,'(a)')line
+ else
+c
+c In setup mode. Set flag, flow out and do use following line
+c
+ replacing = .true.
+ end if
+ else if (line(2:2) .eq. '!') then
+c
+c Copy to all parts
+c
+ call allparts(line(3:128),125)
+ else
+c
+c Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise
+cc Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise
+c
+ ivq = index('123456789abcdefghijklmno',line(2:2))
+c
+c Only treat as part-specific pmx line if number .le. noinst
+c
+ if (ivq.lt.1 .or. ivq.gt.noinst) then
+c
+c Simple comment.
+c
+ call allparts(line,128)
+ else
+c
+c Instrument comment, copy only to part
+c
+ lenline = lenstr(line,128)
+ if (lenline .gt. 2) then
+ write(10+ivq,'(a)')line(3:lenline)
+ else
+c
+c Transferring blank line
+c
+ write(10+ivq,'(a)')' '
+ end if
+ end if
+ end if
+ read(10,'(a)',end=2)line
+ call zapbl(line,128)
+ go to 1
+2 continue
+ goto999 = .true.
+ return
+ end
+ subroutine dosetup(iv,line,mtrnum,mtrden)
+ parameter (noimax=24)
+c
+c Transfers setup data from scratch file to real one for one instrument
+c Data may be mixed with comments, but on entry 1st item is a number.
+c Write a comment when encountered, as it comes.
+c Write numbers one per line.
+c Three input data require special handling:
+c If not already replaced, i.e., if negative, then
+c iset(1) (nv) will be replaced with nvi(i)
+c iset(9) (npages) will be replaced with (nsyst-1)/12+1
+c iset(2), if negative, will be followed by extra numbers to be transf.
+c
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ character*128 line
+ logical insetup,replacing,botv
+ iccount = 0
+ do 1 iset = 1 , 12
+ call partnum(iv,iccount,line,xdata)
+ if (iset .eq. 2) then
+ if (xdata .gt. 0) then
+ write(40,'(i5)')int(xdata+.1)
+ else
+ noi = -xdata+.1
+ write(40,'(i5)')noi
+ do 2 ioi = 1 , noi
+ call partnum(iv,iccount,line,xdata)
+ write(40,'(i5)')int(xdata+.1)
+2 continue
+ end if
+c else if (iset.ne.8 .and. xdata.lt.0) then
+ else if (iset.ne.8 .and. iset.ne.5 .and. xdata.lt.0) then
+c
+c Must be either nv or npages
+c
+ if (int(-xdata+.1) .eq. 999) then
+c
+c It's nv
+c
+ write(40,'(i5)')nvi(iv)
+ else
+c
+c npages must be computed
+c
+ write(40,'(i5)')(nsyst-1)/12+1
+ end if
+ else if (iset.ne.7 .and. iset.ne.12) then
+c
+c write integer
+c
+ write(40,'(i5)')nint(xdata)
+ else
+c
+c write floating number
+c
+ write(40,'(f5.2)')xdata
+ end if
+ if (iset .eq. 3) then
+ mtrnum = nint(xdata)
+ else if (iset .eq. 4) then
+ mtrden = nint(xdata)
+ end if
+1 continue
+ return
+ end
+ subroutine partnum(iv,iccount,line,xdata)
+c
+c Simplified number parsing. Only looks for comment lines and numbers.
+c
+ character*128 line
+ character*1 durq
+2 if (iccount .eq. 128) then
+ read(10+iv,'(a)')line
+ if (line(1:1) .eq. '%') then
+ len = lenstr(line,128)
+ write(40,'(a)')line(1:len)
+ go to 2
+ end if
+ iccount = 0
+ end if
+ iccount = iccount+1
+c
+c Find next non-blank or end of line
+c
+ do 4 iccount = iccount , 127
+ if (line(iccount:iccount) .ne. ' ') go to 3
+4 continue
+c
+c If here, iccount=128 and need to get a new line
+c
+ go to 2
+3 continue
+c
+c iccount now points to start of number to read
+c
+ i1 = iccount
+5 call getchar(line,iccount,durq)
+c
+c Remember that getchar first increments iccount, *then* reads a character.
+c
+ if (index('0123456789.-',durq) .gt. 0) go to 5
+ i2 = iccount-1
+ if (i2 .lt. i1) then
+ print*,'Found "'//durq//'" instead of number'
+ stop 1
+ end if
+ icf = i2-i1+49
+ read(line(i1:i2),'(f'//char(icf)//'.0)')xdata
+ return
+ end
+ block data
+ parameter (noimax=24)
+ common /all/ noinow,iorig(noimax),noinst,insetup,replacing,
+ * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow
+ logical insetup,replacing,botv
+ data nvi /noimax*1/, noinst,noinow /2*noimax/
+ data botv /noimax*.false./
+ end
+ subroutine zapbl(string,len)
+ character*(*) string
+ do 1 i = 1 , len
+ if (string(i:i) .eq. ' ')go to 1
+ if (i .eq. 1) return
+ go to 2
+1 continue
+c
+c If line is all blank, leave it alone
+c
+ return
+2 continue
+ string = string(i:len)
+ return
+ end
+ subroutine OddQuotesBefore(lineq,indx,yesodd)
+c
+c This counts number of double quotes in lineq up to position indx-1, then
+c sets yesodd according to whether number is odd or even
+c
+ logical yesodd
+ character*(*) lineq
+ numdqs = 0
+ do 1 i = 1 , indx-1
+ if (lineq(i:i) .eq. '"') numdqs = numdqs+1
+1 continue
+ yesodd = mod(numdqs,2) .eq. 1
+ return
+ end
+
+
+
+
+
diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.mid b/Build/source/utils/pmx/pmx-src/tests/barsant.mid
index fd58f2f8db0..6cc3fcee58d 100644
--- a/Build/source/utils/pmx/pmx-src/tests/barsant.mid
+++ b/Build/source/utils/pmx/pmx-src/tests/barsant.mid
Binary files differ
diff --git a/Build/source/utils/pmx/pmx-src/tests/barsant.pml b/Build/source/utils/pmx/pmx-src/tests/barsant.pml
index 1be48b99ea1..72d72eccc43 100644
--- a/Build/source/utils/pmx/pmx-src/tests/barsant.pml
+++ b/Build/source/utils/pmx/pmx-src/tests/barsant.pml
@@ -1,4 +1,4 @@
-This is PMX, Version 2.94 , 17 Mar 20
+This is PMX, Version 2.98 , 12 Dec 21
Opening barsant.pmx
Starting first PMX pass
@@ -21,4 +21,3 @@ Writing ./barsant.tex
Writing barsant.mid
MIDI instrument 0 is 74
MIDI instrument 1 is 6
- Bytes used: 2126 807 15
diff --git a/Build/source/utils/pmx/pmx-src/version.ac b/Build/source/utils/pmx/pmx-src/version.ac
index 73eb32443e9..c3b931fbd3a 100644
--- a/Build/source/utils/pmx/pmx-src/version.ac
+++ b/Build/source/utils/pmx/pmx-src/version.ac
@@ -8,4 +8,4 @@ dnl
dnl --------------------------------------------------------
dnl
dnl m4-include this file to define the current pmx version
-m4_define([pmx_version], [2.9.4a])
+m4_define([pmx_version], [2.9.8a])
diff --git a/Build/source/utils/pmx/version.ac b/Build/source/utils/pmx/version.ac
index 0984c08a463..981ff2aa84b 100644
--- a/Build/source/utils/pmx/version.ac
+++ b/Build/source/utils/pmx/version.ac
@@ -8,4 +8,4 @@ dnl
dnl --------------------------------------------------------
dnl
dnl m4-include this file to define the current pmx version
-m4_define([pmx_version], [2.9.4a])
+m4_define([pmx_version], [2.9.8a])